On 10/12/2009 01:53 AM, zhijie zhang wrote:
Thanks. I think there may be no easy method to achive it.
library(lattice)
barchart(Titanic, scales = list(x = "free"),auto.key = list(title
="Survived"),layout=c(4,1),horizontal = FALSE)
The above method generates four graphs, two graphs in the left are for
children's male and female,respectively and the right two graphs are for
adult's male and female,respectively .
Actually, i hope to generate two graphs finally. Say the right two graphs
for adult are overlaid with the left two graphs for children,respectively.
Take the "1st of x variable" as an example, in the place of "1st", the
stacked bar for both children and adult should be displayed. Maybe the data
for children and adult should be first shifted certain values to different
directions and then applying the overlay function to get it.
My above ideas to display a data may be bad. Anyway, thanks a lot.
Hi Zhijie,
This looked like an interesting challenge, so I bent the barp function a
bit to do it. The barp3 function attached will accept a 3D array in
which the rows represent groups, the columns subgroups and the files
sub-subgroups. The arrangement of bars is that of the example you gave.
In order to translate the 2D matrix of the example to the 3D array, I
have written a little conversion function df2array. Try this:
clustack<-structure(list(Country = structure(c(3L, 2L, 1L),
.Label = c("Asia","Europe", "N Amer"), class = "factor"),
Q1.pencils = c(16L, 14L,18L), Q1.pens = c(12L, 9L, 14L),
Q2.pencils = c(18L, 15L, 18L), Q2.pens = c(14L, 11L, 15L),
Q3.pencils = c(17L, 11L, 20L), Q3.pens = c(11L, 8L, 15L),
Q4.pencils = c(20L, 14L, 21L), Q4.pens = c(14L, 12L, 16L)),
.Names = c("Country", "Q1.pencils","Q1.pens", "Q2.pencils", "Q2.pens",
"Q3.pencils", "Q3.pens","Q4.pencils", "Q4.pens"),
class = "data.frame", row.names = c(NA,-3L))
# x is the original data frame with the group names in the
# first column and the column names as in the example
# I read it in as a CSV file.
# depth is the length of the "files" (3rd dimension)
df2array<-function(x,depth) {
dimx<-dim(x)
if(dimx[2]%%depth) stop("depth must divide number of columns without
remainder")
column.order<-NULL
for(d in 1:depth)
column.order<-c(column.order,seq(d,dimx[2]-(depth-d),by=depth))
return(array(unlist(x[,column.order]),c(dimx[1],dimx[2]/depth,depth)))
}
# this converts the data frame to the array
pp.array<-df2array(clustack[,2:9],2)
# this function is pretty much the same as barp
barp3<-function(height,width=0.4,names.arg=NULL,
legend.lab=NULL,legend.pos="e",col=NULL,border=par("fg"),
main=NULL,xlab="",ylab="",xlim=NULL,ylim=NULL,
staxx=FALSE,staxy=FALSE,height.at=NULL,
height.lab=NULL,cex.axis=par("cex.axis"),
do.first=NULL) {
if(is.data.frame(height)) its_ok<-is.numeric(unlist(height))
else its_ok<-is.numeric(height)
if(!its_ok) stop("barp3 can only display bars with numeric heights")
hdim<-dim(height)
if(is.null(hdim) || length(hdim) != 3)
stop("barp3 can only plot 3 dimensional arrays")
ngroups<-hdim[1]
if(length(col)==hdim[3])
barcol<-array(rep(col,each=hdim[1]*hdim[2]),hdim)
else barcol<-col
if(is.null(xlim)) xlim<-c(0.4,ngroups+0.6)
if(any(height<0,na.rm=TRUE))
stop("Can't have negative bar heights in barp3")
if(is.null(ylim)) {
maxstack<-0
for(group in 1:hdim[1]) {
for(subgroup in 1:hdim[2]) {
thistack<-sum(height[group,subgroup,],na.rm=TRUE)
if(thistack > maxstack) maxstack<-thistack
}
}
ylim<-c(0,maxstack*1.05)
}
plot(0,type="n",main=main,xlab=xlab,ylab=ylab,
axes=FALSE,xlim=xlim,ylim=ylim,xaxs="i",yaxs="i")
if(!is.null(do.first)) eval(do.first)
if(is.null(names.arg)) names.arg<-1:ngroups
if(staxx) {
axis(1,at=1:ngroups,labels=rep("",ngroups),
cex.axis=cex.axis)
staxlab(1,at=1:ngroups,labels=names.arg,cex=cex.axis)
}
else axis(1,at=1:ngroups,labels=names.arg,cex.axis=cex.axis)
if(is.null(height.at)) height.at<-pretty(ylim)
if(is.null(height.lab)) height.lab<-pretty(ylim)
if(staxy) {
axis(2,at=height.at,labels=rep("",length(height.lab)),
cex.axis=cex.axis)
staxlab(2,at=height.at,labels=height.lab,cex=cex.axis)
}
else axis(2,at=height.at,labels=height.lab,cex.axis=cex.axis)
barwidth<-2*width/hdim[2]
for(group in 1:hdim[1]) {
left<-group-hdim[2]*barwidth/2
for(subgroup in 1:hdim[2]) {
bottom<-0
for(subsub in 1:hdim[3]) {
rect(left,bottom,left+barwidth,
bottom+height[group,subgroup,subsub],
col=barcol[group,subgroup,subsub],border=border)
bottom<-bottom+height[group,subgroup,subsub]
}
left<-left+barwidth
}
}
if(!is.null(legend.lab)) {
xjust<-yjust<-0.5
if(is.null(legend.pos)) {
cat("Click at the lower left corner of the legend\n")
legend.pos<-locator(1)
xjust<-yjust<-0
}
if(legend.pos[1] == "e")
legend.pos<-emptyspace(barpinfo,bars=TRUE)
legend(legend.pos,legend=legend.lab,fill=col,
xjust=xjust,yjust=yjust)
}
box()
}
# the colors should be an array of the same form as the data
barp3(pp.array,col=array(rep(1:8,each=3),c(3,4,2)),
names.arg=clustack[,1])
Have fun.
Jim
______________________________________________
R-help@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.
