Как указать разные цветовые диапазоны для разных уровней? - PullRequest
10 голосов
/ 21 декабря 2011

Я делаю решетку levelplot из x и y факторов, которые варьируются от [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
...

Вот сценарий R, который я использую для создания фигурыиз этих данных:

#!/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();

Работает отлично.Я получаю следующий рисунок:

levelplot

Однако вместо того, чтобы помечать ячейки NA, я бы хотел оставить их как 1.00 значения, но закрасить все ячейки между 10(уровень 0.10) и 79 (уровень 0.79) с colors.Все, что больше 79, окрашивается в тот же цвет, что и то, что применяется к ячейке с ок.уровень 79. Или, предпочтительно, указанные ячейки будут окрашены в черный цвет, без текста внутри них вообще.

Есть ли способ сделать это с помощью levelplot и решетки?


ЗАКЛЮЧИТЕЛЬНОЕ РЕДАКТИРОВАНИЕ

Это не дает большого градиента в цветах, но я достаточно близок, чтобы назначить награду и, возможно, загляну в ggplot2 какальтернатива.Спасибо за всю вашу тяжелую работу над этим.

Вот окончательное редактирование моего скрипта:

#! /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()

Вот levelplot, который делает этот скрипт:

vFinal

Если я увеличу n выше 15, окраска ячейки снова прекратится, вернувшись к диагонали ярко-красного вместо черного (как показано).

1 Ответ

5 голосов
/ 21 декабря 2011

Это ревизия № 3

Вот и мы (снова).:)

Это странно, если я установлю n на значение меньше 15, все будет работать?

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)
        ))
...