10

I am making a lattice levelplot from x and y factors that range from [0,1]:

      x     y     level                                                                                                                                                                                                                       
1 m3134 m3134 1.0000000                                                                                                                                                                                                                       
2 m3134 m416B 0.4189057                                                                                                                                                                                                                       
3 m416B m3134 0.2696508                                                                                                                                                                                                                       
4 m3134  mA20 0.3322170                                                                                                                                                                                                                       
5  mA20 m3134 0.2454191                                                                                                                                                                                                                       
6 m3134    mB 0.3176792
...

Here is the R script that I use to make the figure from this data:

#!/foo/bar/bin/Rscript --vanilla                                                                                                                                                                        
args <- commandArgs(TRUE)                                                                                                                                                                                                                     
mtxFn <- args[1]                                                                                                                                                                                                                              
pdfFn <- args[2]                                                                                                                                                                                                                              

mtx <- read.table(mtxFn, col.names=c("x", "y", "level"))                                                                                                                                                                                      
mtx$level[(mtx$level == 1)] <- NA                                                                                                                                                                                                             

library(lattice)                                                                                                                                                                                                                              
trellis.device(dev=pdf, file=pdfFn)                                                                                                                                                                                                           
colors <- colorRampPalette(c('red', 'white'))(256)                                                                                                                                                                                            
fig <- levelplot(level~x*y,                                                                                                                                                                                                                   
                 data=mtx,                                                                                                                                                                                                                    
                 col.regions=colors,                                                                                                                                                                                                          
                 xlab="",                                                                                                                                                                                                                     
                 ylab="",                                                                                                                                                                                                                     
                 aspect="iso",                                                                                                                                                                                                                
                 scales=list(                                                                                                                                                                                                                 
                   x=list(rot=90)                                                                                                                                                                                                             
                   ),                                                                                                                                                                                                                         
                 panel=function(...) {                                                                                                                                                                                                        
                   arg <- list(...)                                                                                                                                                                                                           
                   panel.levelplot(...)                                                                                                                                                                                                       
                   panel.text(mtx$x, mtx$y, round(mtx$level*100,0), cex=0.5)                                                                                                                                                                  
                 }                                                                                                                                                                                                                            
                 )                                                                                                                                                                                                                            
print(fig)                                                                                                                                                                                                                                    
graphics.off();

This works fine. I get the following figure:

levelplot

However, instead of having cells labeled NA, I would like to leave them as 1.00 values, but color all cells between 10 (a level of 0.10) and 79 (a level of 0.79) with colors. Anything greater than 79 gets colored with the same color as what is applied to a cell with the approx. level of 79. Or, preferably, said cells would be colored black, with no text inside them at all.

Is there a way to accomplish this with levelplot and lattice?


FINAL EDIT

This doesn't give much of a gradient in colors, but I'm close enough that I'll award the bounty, and perhaps look into ggplot2 as an alternative. Thanks for all your hard work on this.

Here is the final edit of my script:

#! /foo/bar/bin/Rscript --vanilla
args <- commandArgs(TRUE)
dfFn <- args[1]
pdfFn <- args[2]

df <- read.table(dfFn, 
                 col.names=c("x", "y", "level"), 
                 stringsAsFactors=TRUE, 
                 colClasses=c("factor", "factor", "numeric"))
df$level <- round(df$level*100, 0)

# reorder cell type row-factors (in reverse of given order)
df$y <- factor(df$y, levels=unique(df$y[length(df$y):1]))

lowestValue <- min(df$level)
secondHighestValue <- unique(sort(df$level, decreasing=TRUE))[2]

n <- 10
col.seq <- seq(lowestValue, secondHighestValue, length.out=n)
brks <- c(0, col.seq, Inf)
cuts <- cut(df$level, breaks = brks)
colors <- colorRampPalette(c("white", "red"))(length(levels(cuts))-1)
colors <- c(colors, "black")

cls <- rep(colors, times = table(cuts))

library(lattice)
trellis.device(dev=pdf, file=pdfFn)
fig <- levelplot(cuts~x*y,
                 data = df,
                 cuts = n,
                 col.regions=cls,
                 xlab="",
                 ylab="",
                 aspect="iso",
                 scales=list(
                   x=list(rot=90)
                   ),
                 panel=function(...) {
                   arg <- list(...)
                   panel.levelplot(...)
                   panel.text(df$x, df$y, df$level, cex=0.5)
                 },
                 colorkey=list(col=colorRampPalette(c("white", "red"))(length(col.seq)), at=col.seq)
                 )
print(fig)
graphics.off()

Here is the levelplot that this script makes:

vFinal

If I increase n above 15, the cell coloring breaks once again, returning to a diagonal of bright red, instead of black (as shown).

Alex Reynolds
  • 95,983
  • 54
  • 240
  • 345

1 Answers1

5

This is revision #3

Here we go (again). :)

This is weird, if I set n to anything below 15, things seem to work?

enter image description here

df <- read.table("http://dl.dropbox.com/u/31495717/stackoverflow.overlaps.list.txt",
        sep = "\t", header = FALSE)
names(df) <- c("x", "y", "level")
df$level <- round(df$level*100, 0)

n <- 10
col.seq <- seq(10, 80, length.out = n)
brks <- c(0, seq(10, 80, length.out = n), 100)
cuts <- cut(df$level, breaks = brks)
colors <- colorRampPalette(c("red", "white"))(length(levels(cuts))-1)
colors <- c(colors, "black")

cls <- rep(colors, times = table(cuts))

print(levelplot(cuts~x*y,
                data = df,
                cuts = n,
                col.regions=cls,
                xlab="",
                ylab="",
                aspect="iso",
                scales=list(
                        x=list(rot=90)
                ),
                panel=function(...) {
                    arg <- list(...)
                    panel.levelplot(...)
                    panel.text(df$x, df$y, df$level, cex=0.5)
                },
                colorkey = list(col = colors, at = brks)
        ))
Roman Luštrik
  • 69,533
  • 24
  • 154
  • 197
  • I apologize, but I do not understand this answer. – Alex Reynolds Dec 21 '11 at 10:08
  • This is the code you should run (with minor changes to make it fit your bill) before calling levelplot. I suggest you run R interactively to round the edges and then go into "production mode" through a bash script. – Roman Luštrik Dec 21 '11 at 11:24
  • I do not know how to fit your code into what I have already written, sorry. Where does `kats` get used, why is it called that, etc.? – Alex Reynolds Dec 21 '11 at 18:38
  • Where does `cls` come from, etc.? It is unclear how this answer relates to my particular situation. – Alex Reynolds Dec 21 '11 at 18:40
  • Sorry, cls was from my previous ("offline") code, then I adapted it for your code. `cls` is actually `kats`. I've mended my answer. You put this code before your `colors` variable (it actually replaces your `colors` variable). – Roman Luštrik Dec 22 '11 at 00:21
  • Thanks for your help. Unfortunately, this did not work. I have posted updated code and the image result to the question. If you have any other thoughts, I'd appreciate your advice. – Alex Reynolds Dec 22 '11 at 10:41
  • Thanks again for updated code. Your example works for making your example, but does not work with my data. Ultimately, I don't know what is different between your data frame and mine. Other than data values, the structure is the same: three columns: two factors and a third numeric column. There must be something wrong with the format of my sample data, but it doesn't appear to be any different from your sample data. R is frustrating! – Alex Reynolds Dec 22 '11 at 22:43
  • I think there should be a diagonal line of black cells, not random values throughout the figure. I'll try your code on my side, removing the line of code where you put in `runif` data into the level column. – Alex Reynolds Dec 24 '11 at 21:06
  • It doesn't appear that you are using my data. Your randomly-sampled data (obtained via `runif`) works with your cuts and coloring. My dataset does not work with your cuts and coloring. If I use `class`, `length` and `min` and `max` to determine the type, size and range of the random and real datasets, only the range differs. In theory, the `runif` function should make data equivalent to mine, i.e. within [0,1] so it's not clear why the `cuts` variable bins my real data incorrectly, but it does bin your random `runif` data correctly. – Alex Reynolds Dec 25 '11 at 00:02
  • @AlexReynolds Ah, copy/paste. I've edited my answer. Interesting behavior if I modify `n`. – Roman Luštrik Dec 25 '11 at 08:45