[R] ggplot / reshape: basic usage

baptiste Auguié ba208 at exeter.ac.uk
Tue Feb 5 10:55:41 CET 2008


Sorry i realize my example was silly. I've played a bit more and i  
now have a working example using base graphics and the plotCI  
function from the plotrix package (reproduced for self-consistency).

I start with some scatterplot, and I want to group the data in say 4  
arbitrary intervals along x. For each of these subgroups I now  
compute the mean x and y values, and the associated deviations.  
Finally, I plot these 4 points with errorbars and shaded rectangles  
displaying where the cuts occurred.

It looked to me this whole process would be straight forward with  
reshape and ggplot2, but my previous attempts at understanding "cast"  
failed.

Thanks for any tips,

baptiste

Here is the code,

>
>
> #require(plotrix)
> plotCI<-function (x, y = NULL, uiw, liw = uiw, ui = NULL, li = NULL,
>     err = "y", sfrac = 0.01, gap = 0, slty = par("lty"), add = FALSE,
>     scol = NULL, pt.bg = par("bg"), ...)
> {
>     arglist <- list(...)
>     if (is.list(x)) {
>         y <- x$y
>         x <- x$x
>     }
>     if (is.null(y)) {
>         if (is.null(x))
>             stop("both x and y NULL")
>         y <- as.numeric(x)
>         x <- seq(along = x)
>     }
>     if (missing(uiw) && (is.null(ui) || is.null(li)))
>         stop("must specify either relative limits or both lower and  
> upper limits")
>     if (!missing(uiw)) {
>         if (err == "y")
>             z <- y
>         else z <- x
>         ui <- z + uiw
>         li <- z - liw
>     }
>     if (is.null(arglist$xlab))
>         arglist$xlab <- deparse(substitute(x))
>     if (is.null(arglist$ylab))
>         arglist$ylab <- deparse(substitute(y))
>     if (err == "y" && is.null(arglist$ylim))
>         arglist$ylim <- range(c(y, ui, li), na.rm = TRUE)
>     if (err == "x" && is.null(arglist$xlim))
>         arglist$xlim <- range(c(x, ui, li), na.rm = TRUE)
>     if (missing(scol)) {
>         if (!is.null(arglist$col))
>             scol <- arglist$col
>         else scol <- par("col")
>     }
>     plotpoints <- TRUE
>     if (!is.null(arglist$pch) && is.na(arglist$pch)) {
>         arglist$pch <- 1
>         plotpoints <- FALSE
>     }
>     if (!add)
>         do.call("plot", c(list(x, y, type = "n"), clean.args(arglist,
>             plot)))
>     if (gap == TRUE)
>         gap <- 0.01
>     ul <- c(li, ui)
>     if (err == "y") {
>         gap <- rep(gap, length(x)) * diff(par("usr")[3:4])
>         smidge <- par("fin")[1] * sfrac
>         arrow.args <- c(list(lty = slty, angle = 90, length = smidge,
>             code = 1, col = scol), clean.args(arglist, arrows,
>             exclude.other = c("col", "lty")))
>         do.call("arrows", c(list(x, li, x, pmax(y - gap, li)),
>             arrow.args))
>         do.call("arrows", c(list(x, ui, x, pmin(y + gap, ui)),
>             arrow.args))
>     }
>     else if (err == "x") {
>         gap <- rep(gap, length(x)) * diff(par("usr")[1:2])
>         smidge <- par("fin")[2] * sfrac
>         arrow.args <- c(list(lty = slty, angle = 90, length = smidge,
>             code = 1), clean.args(arglist, arrows, exclude.other = c 
> ("col",
>             "lty")))
>         do.call("arrows", c(list(li, y, pmax(x - gap, li), y),
>             arrow.args))
>         do.call("arrows", c(list(ui, y, pmin(x + gap, ui), y),
>             arrow.args))
>     }
>     if (plotpoints)
>         do.call("points", c(list(x, y, bg = pt.bg), clean.args 
> (arglist,
>             points, exclude.other = c("xlab", "ylab", "xlim",
>                 "ylim", "axes"))))
>     invisible(list(x = x, y = y))
> }
> xx<-seq(0,10,length=500)
> yy<-jitter(cos(10*xx)+cos(10*(xx*1.1)),amount=0.5) # some beating +  
> random noise
>
> data<-as.data.frame(list(xx=xx,yy=yy))
>
> lev<-seq(range(data$xx)[1],range(data$xx)[2],length=5) # levels for  
> binning
> g <- cut(data$xx,lev ) # factors for binning
>
> se <- function(x) sd(x)/sqrt(length(x)) # standard error
> test<-sapply(split(data,g),function(d) list(meanx=mean(d 
> $xx),meany=mean(d$yy),stdx=se(d$xx),stdy=se(d$yy)))
> as.data.frame(t(test))->test
>
> plot(xx,yy)
> plotCI(as.numeric(test$meanx),as.numeric(test$meany),2*as.numeric 
> (test$stdy),lwd=2,col=1,scol=2,add=TRUE) # y errorbars
> plotCI(as.numeric(test$meanx),as.numeric(test$meany),2*as.numeric 
> (test$stdx),lwd=2,col=3,err="x",scol=5,add=TRUE) # x errorbars
>
> rect(lev[seq(1,length(lev)-1,by=1)], min(yy),lev[seq(2,length 
> (lev),by=1)], max(yy),col =c(rgb(.8,.8,.8,.1),rgb(.6,.6,.6,.1)),  
> border = NA) # show bins




On 24 Jan 2008, at 01:34, hadley wickham wrote:

> On Jan 23, 2008 10:44 AM, baptiste Auguié <ba208 at exeter.ac.uk> wrote:
>> Hi,
>>
>> I've been trying to do the following simple thing: given a  
>> data.frame,
>>
>>> library(reshape)
>>> library(ggplot2)
>>>
>>> df <- data.frame(x=c(1:10),y=sin(1:10),z=cos(1:10))
>>> dfm<-melt(df, id=c("x"), measured=c("y","z"))
>>
>>
>> i want to plot  y and z against x, and add vertical errorbars to the
>> points corresponding to the standard deviation of y and z  
>> respectively.
>>
>> I tried the following, inspired by some previous post in the list,
>>
>>> se <- function(x) sd(x)/sqrt(length(x))
>>> means <- cast(dfm, variable~., function(x) c(se = se(x)))
>>>
>>> qplot(value,x, data=means, colour=variable, min = value - se, max =
>>>  value + se, geom=c("point","errorbar"))
>>
>>
>> but this fails, as I obviously don't get the philosophy behind the
>> "cast" function.
>
> Could you explain a little more what you are trying to do?  There is
> one s.e. for y and one z, but what are you trying to plot them
> against?
>
> Hadley
>
>
> -- 
> http://had.co.nz/

_____________________________

Baptiste Auguié

Physics Department
University of Exeter
Stocker Road,
Exeter, Devon,
EX4 4QL, UK

Phone: +44 1392 264187

http://newton.ex.ac.uk/research/emag
http://projects.ex.ac.uk/atto



More information about the R-help mailing list