[R] (no subject)

[Jim Lemon]

On Wednesday 12 November 2003 10:24 pm, Stefan Wagner wrote:
> Hi all,
>
> I am looking for a clever way to create the following graph using R:
>
> I got information on the shares of some subgroups over time (summing up
> to 1 in each year). The graph I want to create should display the
> development of the individual shares over time by shading rectangulars
> for each share in a different color.
>
> Is there a clever of doing this?
>

I don't know whether this will help, but here is a function that draws a 
rectangle specified by the position arguments with a color gradient 
specified by either endpoints for red, green and blue, or vectors of red, 
green and blue values in either 0-1 or 0-255. The gradient will be a 
linear sequence if only the extremes of the bar are specified, or can be
explicitly specified by passing a vector of x values for horizontal
shading or y values for vertical shading. Useful for doing barplots where 
you would like to illustrate critical areas (e.g. risk levels of a 
concentration - I've included a fake example) in a series of observed 
values. It's a bit messy, as there isn't a lot of error checking, but it 
may be useful.

Jim
-------------- next part --------------
rgb.to.hex<-function(rgb) {
 if(length(rgb) != 3) stop("rgb must be an rgb triplet")
 if(any(rgb < 0) || any(rgb > 255)) stop("all rgb must be between 0 and 255")
 # if it looks like a 0-1 value, get the 0-255 equivalent
 if(all(rgb <= 1)) rgb<-rgb*255 
 hexdigit<-c(0:9,letters[1:6])
 return(paste("#",hexdigit[rgb[1]%/%16+1],hexdigit[rgb[1]%%16+1],
  hexdigit[rgb[2]%/%16+1],hexdigit[rgb[2]%%16+1],
  hexdigit[rgb[3]%/%16+1],hexdigit[rgb[3]%%16+1],
  sep="",collapse=""))
}

gradient.rect<-function(xleft,ybottom,xright,ytop,reds,greens,blues,
 nslices=20,gradient="x") {
 maxncol<-max(c(length(reds),length(greens),length(blues)))
 if(maxncol < 2) stop("Must specify at least two values for one color")
 if(maxncol > 2 || maxncol > nslices) nslices<-maxncol
 if(length(reds) == 2) {
  # assume they are endpoints and calculate linear gradient
  if(reds[1] < 0 || reds[2] > 1) {
   reds[1]<-ifelse(reds[1] < 0,0,reds[1])
   reds[2]<-ifelse(reds[2] > 1,1,reds[2])
  }
  reds<-seq(reds[1],reds[2],length=nslices)
 }
 if(length(greens) == 2) {
  # assume they are endpoints and calculate linear gradient
  if(greens[1] < 0 || greens[2] > 1) {
   greens[1]<-ifelse(greens[1] < 0,0,greens[1])
   greens[2]<-ifelse(greens[2] > 1,1,greens[2])
  }
  greens<-seq(greens[1],greens[2],length=nslices)
 }
 if(length(blues) == 2) {
  # assume they are endpoints and calculate linear gradient
  if(blues[1] < 0 || blues[2] > 1) {
   blues[1]<-ifelse(blues[1] < 0,0,blues[1])
   blues[2]<-ifelse(blues[2] > 1,1,blues[2])
  }
  blues<-seq(blues[1],blues[2],length=nslices)
 }
 colormatrix<-cbind(reds,greens,blues)
 colvec<-apply(colormatrix,1,rgb.to.hex)
 if(gradient == "x") {
  if(length(xleft) == 1) {
   xinc<-(xright-xleft)/(nslices-1)
   xlefts<-seq(xleft,xright-xinc,length=nslices)
   xrights<-xlefts+xinc
  }
  else {
   xlefts<-xleft
   xrights<-xright
  }
  rect(xlefts,ybottom,xrights,ytop,col=colvec,lty=0)
 }
 else {
  if(length(ybottom) == 1) {
   yinc<-(ytop-ybottom)/(nslices-1)
   ybottoms<-seq(ybottom,ytop-yinc,length=nslices)
   ytops<-ybottoms+yinc
  }
  else {
   ybottoms<-ybottom
   ytops<-ytop
  }
  rect(xleft,ybottoms,xright,ytops,col=colvec,lty=0)
 }
}
-------------- next part --------------
arsenic.red<-c(seq(0,1,length=50),rep(1,50))
arsenic.green<-c(seq(1,0,length=50),rep(0,50))
arsenic.blue<-rep(0,100)
dioxin.red<-c(seq(0,1,length=20),rep(1,80))
dioxin.green<-c(seq(1,0,length=20),rep(0,80))
dioxin.blue<-rep(0,100)
plot(0:5,seq(0,100,by=20),axes=F,type="n",main="Cancer risk",xlab="Carcinogen",
 ylab="Concentration (ppb)")
box()
axis(2)
mtext(c("Arsenic","Dioxin"),1,at=c(1.5,3.5))
gradient.rect(1,-5,2,105,arsenic.red,arsenic.green,arsenic.blue,gradient="y")
gradient.rect(3,-5,4,105,dioxin.red,dioxin.green,dioxin.blue,gradient="y")
legend(4.1,50,legend=c("High","Low"),fill=c("red","green"))