Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
767 views
in Technique[技术] by (71.8m points)

r - changing background color in xyplot()

I'm trying to get the background colors of the strips to change (it is a 6 by 6 matrix and i have 6 strip colors stocked in a vector named cola). I've tried to combine things found on the internet, but the result i get i completely off the mark: for now all i get is that the vertical strips are all yellow and the horizontal ones all red :(

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)))
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

This code (quickly adapted from my answer to this SO question) gets you part of the way to a solution. (I'd be interested to learn whether/how it can be adapted to also print text in the each of the strips).

One thing to note is that the customized strip function need to be passed directly to useOuterStrips(), rather than to the nested call to 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


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...