изменение цвета фона в xyplot () - PullRequest
Новая
       0

изменение цвета фона в xyplot ()

4 голосов
/ 17 марта 2012

Я пытаюсь изменить цвет фона полос (это матрица 6 на 6, и у меня есть 6 полос, хранящихся в векторе с именем cola). Я пытался объединить вещи, найденные в интернете, но в результате я полностью не в курсе: сейчас все, что я получаю, это то, что вертикальные полосы все желтые, а горизонтальные - красные: (

library(lattice)
library(latticeExtra)
B<-structure(list(ylab = c(0, 0, -1, -1, -1, -1, 0, 0, -1, -1, -1, 
-1, 1, 1, 0, 0, 0, -1, 1, 1, 0, 0, 1, -1, 1, 1, 0, -1, 0, -1, 
1, 1, 1, 1, 1, 0), xlab = c(0, -1.02679909743483, -4.31389840050087, 
-4.72016163070677, -3.82773068058066, -4.95060796675797, 1.02679909743483, 
0, -3.28709930306604, -3.69336253327194, -2.80093158314584, -3.92380886932314, 
4.31389840050087, 3.28709930306604, 0, -0.406263230205904, 0.486167719920203, 
-0.636709566257106, 4.72016163070677, 3.69336253327194, 0.406263230205904, 
0, 0.892430950126108, -0.230446336051202, 3.82773068058066, 2.80093158314584, 
-0.486167719920203, -0.892430950126108, 0, -1.12287728617731, 
4.95060796675797, 3.92380886932314, 0.636709566257106, 0.230446336051202, 
1.12287728617731, 0), zlab = c(1, 0.435981356312883, 1.28746578953454e-08, 
1.64728897189548e-09, 9.04719004157784e-08, 1.22124532708767e-15, 
0.435981356312883, 1, 2.30452944283144e-07, 1.23923277972615e-07, 
1.38063360011209e-06, 7.7715611723761e-16, 1.28746578953454e-08, 
2.30452944283144e-07, 1, 0.654543666603895, 0.608788895482761, 
3.33066907387547e-16, 1.64728897189548e-09, 1.23923277972615e-07, 
0.654543666603895, 1, 0.0429030453016164, 0, 9.04719004157784e-08, 
1.38063360011209e-06, 0.608788895482761, 0.0429030453016164, 
1, 4.22994972382185e-14, 1.22124532708767e-15, 7.7715611723761e-16, 
3.33066907387547e-16, 0, 4.22994972382185e-14, 1), g1 = structure(c(1L, 
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 
4L, 5L, 6L), .Label = c("1", "2", "5", "6", "7", "8"), class = "factor"), 
    g2 = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 
    5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L), .Label = c("1", 
    "2", "5", "6", "7", "8"), class = "factor")), .Names = c("ylab", 
"xlab", "zlab", "g1", "g2"), row.names = c(NA, -36L), class = "data.frame")
mycol<-c("light grey", "light grey", "purple", "purple", "purple", "purple", 
"light grey", "light grey", "purple", "purple", "purple", "purple", 
"light green", "light green", "light grey", "light grey", "light grey", 
"purple", "light green", "light green", "light grey", "light grey", 
"light green", "purple", "light green", "light green", "light grey", 
"purple", "light grey", "purple", "light green", "light green", 
"light green", "light green", "light green", "light grey")

mycola <- rainbow(6)


useOuterStrips(bwplot(~B$ylab|B$g1*B$g2,ylab="",xlab="",as.table=TRUE, par.settings=list(strip.background=list(col=mycola)),panel=function(...,bg){
    panel.fill(col=mycol[panel.number()])
},strip = function(..., bg) {
     strip.fill=col[which.packet()]
   },scale=list(draw=FALSE)))

1 Ответ

4 голосов
/ 17 марта 2012

Этот код (быстро адаптированный из моего ответа на этот ТАК вопрос ) дает вам часть пути к решению.(Мне было бы интересно узнать, можно ли / как адаптировать его также для печати текста на каждой из полос).

Следует отметить, что настраиваемую функцию полосы необходимо передавать непосредственно useOuterStrips(), а не на вложенный вызов bwplot(). 

# Create a function to be passes to "strip=" argument of xyplot
myStripStyle <- function(which.panel, factor.levels, ...) {
    panel.rect(0, 0, 1, 1,
               col = bgColors[which.panel],
               border = 1)
    ## This call to panel.text() commented out because it does not
    ## work as I would have expected/hoped it to
    # panel.text(x = 0.5, y = 0.5,
    #            font=2,
    #            lab = factor.levels[which.panel],
    #            col = "black")
}

mycola <- rainbow(6)
bgColors <- mycola

useOuterStrips(bwplot(~B$ylab|B$g1*B$g2,ylab="",xlab="",as.table=TRUE,
                      panel=function(...,bg){
                          panel.fill(col=mycol[panel.number()])
                      },
                      scale=list(draw=FALSE)),
               strip = myStripStyle,
               strip.left = myStripStyle)

enter image description here

...