1##============================================================================== 2## 3## Spheres/Cylindres/Ellipses/Arrows 4## Karline Soetaert 5## 6##============================================================================== 7 8##============================================================================== 9## INTERNAL FUNCTION 10##============================================================================== 11 12val2col <- function (values,zlim,col) { 13 14 if (! is.null(values)) { # a matrix of radius, z-values 15 16 if (min(values[,1])<0) 17 stop ("cannot draw shape: radiusses in first column of *values* are not positive") 18 values <- values [sort(values[,1],index=TRUE)$ix,] # sort on first column (radiusses) 19 20 if (is.null(zlim)) { 21 zlim<-range(values[,2]) 22 } else { 23 values[,2]<-pmin(values[,2],zlim[2]) 24 values[,2]<-pmax(values[,2],zlim[1]) 25 } 26 27 x.to <- (values[,2]-zlim[1])/(diff(zlim)) 28 Col <- intpalette (inputcol=col,x.to = x.to) 29 nrad <- nrow(values) 30 values[,1] <- values[,1]/values[nrad,1] 31 intrad <- c(0,values[,1]) 32 } else { 33 Col <- col 34 nrad <- length(Col) 35 intrad <- c(0, 1:nrad)/nrad 36 37 ncol <- length(col) 38 if (ncol < nrad) 39 Col <- intpalette(col, nrad) 40 } 41 return(list(Col=Col,intrad=intrad,nrad=nrad)) 42} 43