position_stacking

[sf]

Hi,

I needed more fine control for overdrawing of dots, so I wrote a
position_stacking routine. It essentially permits to horizontally or
vertically stack points instead of overwriting them.

Any comments on it? I'm sure that the core of the routine could be
sped up.

Sebastian

-----------

library(ggplot2)

df <- data.frame(a=sample(1:100,200,replace=T),b=1)

PositionStacking <- proto(Position, {
adjust <- function(., data, scales) {
if (empty(data)) return(data.frame())
check_required_aesthetics(c("x", "y"), names(data),
"position_stacking")

if (is.null(.$height)) .$height <- resolution(data$x) * 0.4
if (is.null(.$width)) .$width <- resolution(data$y) * 0.4

data$offset.y <- 0
data$offset.x <- 0

cat(system.time(
if(nrow(data)>1) {
for (i in 1:(nrow(data)-1)) {
if(i<1) next
for (j in (i+1):nrow(data)) {
if(j>nrow(data)) next
if( sum(data[i,c("x","y")] ==
data[j,c("x","y")]) == 2 ) {
data[j,"offset.y"] <- data[j,"offset.y"]+.
$height
data[j,"offset.x"] <- data[j,"offset.x"]+.
$width
}
}
}
}))


data$y <- data$y+data$offset.y
data$x <- data$x+data$offset.x
return(data)
}
objname <- "stacking"
desc <- "stacking points to avoid overplotting"

examples <- function(.) {
qplot(am, vs, data=mtcars)

# Default amount of jittering will generally be too much for
# small datasets:
qplot(am, vs, data=mtcars, position="stacking")
# Control the amount as follows
qplot(am, vs, data=mtcars, position=position_stacking(w=0.0,
h=0.1))
qplot(am, vs, data=mtcars, position=position_stacking(w=0.1,
h=0.0))
}
})

position_stacking <- PositionStacking$build_accessor()

ggplot(df,aes(x=a,y=b,)) +
geom_point(,position=position_stacking(w=0.0,h=1))

[Ben Bolker]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

On 07/28/2011 01:48 PM, sf wrote:
> Hi,
>
> I needed more fine control for overdrawing of dots, so I wrote a
> position_stacking routine. It essentially permits to horizontally or
> vertically stack points instead of overwriting them.
>
> Any comments on it? I'm sure that the core of the routine could be
> sped up.
>
> Sebastian

This sounds like something I've wanted for a while.
There was originally something sort of special-purpose here
http://biostat.mc.vanderbilt.edu/wiki/Main/TatsukiRcode but it appears
to do something a little different -- "jitter if necessary".

If/when I get a chance to try it I will see if I can think of ways to
streamline the guts. duplicated() is a good way to identify duplicated
points in a data frame ...

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.10 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/

iEUEARECAAYFAk4xpi8ACgkQc5UpGjwzenOTigCWONnS+gEGQhUg8ZvokoTgFfiZ
YgCgkwI1ypOTYn0qvBtzEgjo/IAmC4I=
=BlTr
-----END PGP SIGNATURE-----

[Aaron Mackey]

we use the beeswarm package for this, which does not require points to be exactly identical (just that their glyphs might overlap) to be nudged (with various options on which points to nudge first and in what direction).  If people are interested, we can post some code on our blog.

-Aaron

--
You received this message because you are subscribed to the ggplot2 mailing list.
Please provide a reproducible example: http://gist.github.com/270442

To post: email ggp...@googlegroups.com
To unsubscribe: email ggplot2+u...@googlegroups.com
More options: http://groups.google.com/group/ggplot2

[Dennis Murphy]

I for one would be interested in this; I like the concept behind
beeswarm. If it plays nice with related geoms like boxplot, errorbar
or linerange, for example, it would be a useful contribution IMO.

Dennis

[sf]

Beeswarm looks nice, but I was looking for that does simple stacking
(horizontal or vertical). Nevertheless to have something like
'position_beeswarm' for sure would come in handy.

Thanks for the pointer to duplicated(). It improves the performance by
a factor of 1000 !

Here's the latest version:

----------------------

library(ggplot2)

df <- data.frame(a=sample(1:500,1000,replace=T),b=1)

PositionStacking <- proto(Position, {
adjust <- function(., data, scales) {
if (empty(data)) return(data.frame())
check_required_aesthetics(c("x", "y"), names(data),
"position_stacking")

if (is.null(.$height)) .$height <- resolution(data$x) * 0.4
if (is.null(.$width)) .$width <- resolution(data$y) * 0.4

data$offset.y <- 0
data$offset.x <- 0

dups <- (1:nrow(data))[duplicated(data)]
cat(system.time(for (i in dups) {
ddups <- (data$x==data$x[i]) & (data$y==data$y[i])
ddups[1:i] <- FALSE
data$offset.y[ddups] <- data$offset.y[ddups]+.$height
data$offset.x[ddups] <- data$offset.x[ddups]+.$width

[Aaron Mackey]

We use beeswarm() with do.plot=F to get the nudged values for numerically-assigned groups (factors); YMMV.

express <- data.frame(strain, as.numeric(intensity), leptin)

colnames(express)[2:3] <- c("Intensity", "fac")

express <- express[order(strain, leptin),]

express <- within(express, fac <- factor(fac, levels=unique(express$fac), ordered=is.ordered(fac)))

express <- data.frame(express, as.numeric(express$fac))

colnames(express)[4] <- "facN"

signal <- beeswarm(Intensity ~ facN, data=express, method="smile", spacing=8, do.plot=F)[,c(1,2,6)]

colnames(signal) <- c("Leptin", "Intensity", "facN")

expression <- merge(express, signal)

 

p <- ggplot(expression, aes(Leptin, Intensity, colour=strain, label=strain)) + geom_text() +

                facet_grid(. ~ fac, scales="free_x", space="free") +

                scale_x_continuous(breaks=c(1:2), labels=c("MinusLeptin","PlusLeptin"), expand=c(0, 0.5)) +

                opts(legend.position = "none")

--
Aaron J. Mackey, PhD
Assistant Professor
Center for Public Health Genomics
University of Virginia
ama...@virginia.edu
http://www.cphg.virginia.edu/mackey