Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
762 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 Answer

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


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...