# Re: [R] Graphing question (multiple line graphs arranged spatially)

From: Jim Lemon <jim_at_bitwrit.com.au>
Date: Wed, 12 Mar 2008 22:08:38 +1100

stephen sefick wrote:
> station month bas
> 190 5 0.000
> 190 7 1.563
> 190 10 0.000
> 190 11 0.000
> 202 4 18.750
> 202 5 18.750
> 202 7 6.250
> 202 10 4.800
> 202 11 3.125
> 198 4 18.750
> 198 5 31.250
> 198 7 3.125
> 198 10 3.200
> 198 11 12.500
> 205 4 0.000
> 205 5 0.000
> 205 7 0.000
> 205 10 0.000
> 205 11 0.000
>

> x<-subset(c, station=="190")
> plot(x\$bas~x\$month, type="b")
> y<-subset(c, station=="198")
> plot(y\$bas~y\$month, type="b")
> z<-subset(c, station=="202")
> plot(z\$bas~z\$month, type="b")
> zz<-subset(c, station=="205")
> plot(zz\$bas~zz\$month, type="b")
>
> I would like to put all of the all of these individual line graphs
> into one 3d graph organized by descending station (205-190). Does
> anyone know how to do this?

Hi Stephen,

One way may be with brkdn.plot (slightly modified and this isn't 3D):

library(plotrix)
# get the modification for one observation per point # this will be in the next version of brkdn.plot source("brkdn.plot.R")
brkdn.plot("bas","station","month",ss.df,xaxlab=c(4,5,7,10,11),   dispbar=FALSE,md=NA,pch=1:5,lty=1:5,xlab="Month") legend(8,25,unique(ss.df\$station),pch=1:5,lty=1:5)

Thanks for this - I hadn't thought about using this function with one datum per point. The modified function follows.

Jim

dispbars<-function(x,y,ulim,llim=ulim,arrow.cap=0.01,arrow.gap=NA,...) {

length<-arrow.cap*par("pin")[1]
npoints<-length(x)

``` if(is.na(arrow.gap)) arrow.gap<-strheight("O")/1.5
for(i in 1:npoints) {
if(!is.na(ulim[i])) {
```

if(arrow.gap >= ulim[i] * 0.9 || arrow.gap >= llim[i] * 0.9) {
```    x0<-rep(x[i]-length,2)
x1<-rep(x[i]+length,2)
y0<-rep(c(y[i]-llim[i],y[i]+ulim[i]),2)
y1<-rep(c(y[i]-llim[i],y[i]+ulim[i]),2)
```
segments(x0,y0,x1,y1,...)
}
else {
```    x0<-x1<-rep(x[i],2)
y0<-c(y[i]+arrow.gap,y[i]-arrow.gap)
y1<-c(y[i]+ulim[i],y[i]-llim[i])
```

arrows(x0,y0,x1,y1,length=length,angle=90,...)    }
}
}
}

brkdn.plot<-function(vars,groups=NA,obs=NA,data,mct="mean",md="std.error",  stagger=NA,dispbar=TRUE,main="Breakdown plot",xlab=NA,ylab=NA,xaxlab=NA,  ylim=NA,type="b",pch=1,lty=1,col=par("fg"),staxx=FALSE,...) {

if(is.na(obs)) {
if(is.na(groups))
stop("Must have at least one factor to subset data")   bygroup<-as.factor(data[[groups]])
grouplevels<-levels(bygroup)
ngroups<-length(grouplevels)
nobs<-length(vars)
obs.pos<-1:nobs
obslevels<-1:nobs
}
else {
if(is.numeric(data[[obs]])) obs.pos<-obslevels<-sort(unique(data[[obs]]))   else {
byobs<-as.factor(data[[obs]])
obslevels<-levels(byobs)
obs.pos<-1:nobs
}
nobs<-length(obslevels)
if(is.na(groups)) {
ngroups<-length(vars)
grouplevels<-1:ngroups
}
else {
bygroup<-as.factor(data[[groups]])
grouplevels<-levels(bygroup)
ngroups<-length(grouplevels)
if(length(vars) > 1) {
warning("Group and observation factors are present, only vars[1] is plotted")     vars<-vars[1]
}
}
}
brkdn<-list(matrix(NA,nrow=ngroups,ncol=nobs),   matrix(NA,nrow=ngroups,ncol=nobs))
if(is.na(groups)) {
if(is.na(xlab)) xlab<-"Observation"
xat<-1:nobs
if(is.na(xaxlab[1])) xaxlab<-obslevels   for(group in 1:ngroups) {
for(ob in 1:nobs) {
thisbit<-unlist(subset(data[[vars[group]]],      data[[obs]] == obslevels[ob],vars[[group]]))     if(length(thisbit)) {

```     if(length(thisbit) > 1) {
brkdn[[1]][group,ob]<-do.call(mct,list(thisbit,na.rm=TRUE))
if(!is.na(md))
brkdn[[2]][group,ob]<-do.call(md,list(thisbit,na.rm=TRUE))
}
else brkdn[[1]][group.ob]<-thisbit
```

}
}
}
}
else {
if(is.na(obs)) {
if(is.na(xlab)) xlab<-"Variable"
xat<-1:length(vars)
if(is.na(xaxlab[1])) xaxlab<-vars
for(group in 1:ngroups) {
for(ob in 1:nobs) {
```     thisbit<-unlist(subset(data[[vars[ob]]],
data[[groups]] == grouplevels[group],vars[ob]))
if(length(thisbit)) {
if(length(thisbit) > 1) {
brkdn[[1]][group,ob]<-do.call(mct,list(thisbit,na.rm=TRUE))
if(!is.na(md))
brkdn[[2]][group,ob]<-do.call(md,list(thisbit,na.rm=TRUE))
}
else brkdn[[1]][group.ob]<-thisbit
}
```

}
}
}
else {
if(is.na(xlab)) xlab<-"Observation"
xat<-obs.pos
if(is.na(xaxlab[1])) xaxlab<-obslevels    for(group in 1:ngroups) {
for(ob in 1:nobs) {
```     thisbit<-unlist(subset(data,data[[groups]] == grouplevels[group] &
data[[obs]] == obslevels[ob],vars))
if(length(thisbit)) {
if(length(thisbit) > 1) {
brkdn[[1]][group,ob]<-do.call(mct,list(thisbit,na.rm=TRUE))
if(!is.na(md))
brkdn[[2]][group,ob]<-do.call(md,list(thisbit,na.rm=TRUE))
}
else brkdn[[1]][group,ob]<-thisbit
}
```

}
}
}
}
if(is.na(ylim[1])) {
ylim<-range(brkdn[[1]],na.rm=TRUE)
if(!is.na(md)) {
dlim<-c(min(brkdn[[1]]-brkdn[[2]],na.rm=TRUE),      max(brkdn[[1]]+brkdn[[2]],na.rm=TRUE))    ylim<-c(min(c(ylim[1],dlim[1])),max(c(ylim[2],dlim[2])))   }
}
groupdiv<-ifelse(ngroups < 3,1,ngroups-2)  if(is.na(stagger)) stagger<-0.025-groupdiv*0.0025  if(is.na(ylab)) {
if(length(vars) == 1) ylab<-vars[1]
else ylab<-paste(vars,collapse=" and ")  }
plot(0,xlim=c(obs.pos[1]-0.5,obs.pos[nobs]+0.5),main=main,   xlab=xlab,ylab=ylab,ylim=ylim,type="n",axes=FALSE,...)  box()
if(staxx) staxlab(at=xat,labels=xaxlab)  else axis(1,at=xat,labels=xaxlab)
axis(2)
``` if(length(pch) < ngroups) pch<-rep(pch,length.out=ngroups)
if(length(col) < ngroups) col<-rep(col,length.out=ngroups)
if(length(lty) < ngroups) lty<-rep(lty,length.out=ngroups)
```
offinc<-stagger*diff(par("usr")[c(1,2)])  offset<-0
arrow.cap<-0.01-(groupdiv*0.001)
for(group in 1:ngroups) {
points(obs.pos+offset,brkdn[[1]][group,],type=type,col=col[group],    pch=pch[group],lty=lty[group])
if(dispbar)
dispbars(obs.pos+offset,brkdn[[1]][group,],brkdn[[2]][group,],     arrow.cap=arrow.cap,col=col[group])
offset<-ifelse(offset<0,-offset,-offset-offinc)  }
names(brkdn)<-c(mct,md)
return(brkdn)
}

R-help_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code. Received on Wed 12 Mar 2008 - 11:06:03 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Wed 12 Mar 2008 - 11:30:20 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.