Sonntag, 15. Februar 2009

Säulendiagramm mit gestapelten und überlappenden Säulen




















# Prepare and organize some data
d.blue <- data.frame( grp1=c(5,4,3,5), grp2=c(3,3,2,1) )
rownames(d.blue) <- c( "t1","t2","t3","t4" )
set.seed(181)
d.red <- d.blue * runif(n=5)

# Barplot expects matrix instead of data.frame

m.blue <- t( as.matrix( d.blue ) )
m.red <- t( as.matrix( d.red ) )

# We need a function to prepare background of the barplot

mygrid <- function(){
  par(xpd=FALSE)     # barplot paints over the whole figure region by default  

  rect(xleft=-1, xright=199  # set background white, when bg has another col
  , ybottom=-99, ytop=99, col="white")
  grid(nx=NA, ny=NULL)       # horiz grid only
  par(xpd=TRUE)
  box()
}

# Set parameters

osp <- 0.5 # overlapping part in %
sp <- 1 # spacing between the bars
par( bg="grey90")            # set outer background

nbars <- dim(m.blue)[2]   # how many bars do we have?

# Create first barplot

b <- barplot( m.blue, col=c("lightblue","blue")
  , beside=FALSE, ylim=c(0,10)
  , axisnames=FALSE
  , main="My main title"
  , xlim=c(0, nbars*2-osp )      # enlarge x-Axis
  , space=c(0, rep(sp,nbars-1) ) # set spacing=1, starting with 0
  , panel.first=mygrid())

# Draw the red series
barplot( m.red, col=c("salmon","red"), beside=FALSE
  , space=c(1-osp, rep(1, nbars-1)) # shift to right by 1-osp
  , axisnames=FALSE, add=TRUE)

# Create axis separately, such that labels can be shifted to the left

axis(1, at=b+(1-osp)/2, labels=FALSE, tick=FALSE, las=1)

# Now draw the rotated textual axis labels

text( b+(1-osp)/2, par("usr")[3] - 0.2
  , labels = rownames(d.blue), srt = 45, pos = 1, xpd = TRUE)


# Add some other rotated text

text( x=b, y=1, labels="some text", srt=45 )

# Add legend

legend("topright", inset=0.05, bg="ivory1", cex=0.8
  , legend=c("A-grp 1","A-grp 2","B-gpr 1", "B-grp 2")
  , col=c("lightblue","blue","salmon","red"), pch=15, pt.cex=1.5
  , y.intersp=1.2, x.intersp=1 , ncol=2 )

Keine Kommentare: