CODEWITHSUNDEEP
rcolorslinelattice
user918967
user918967

Reputation: 2167

How to change colors of lines in an R chart made with Dotplot

I am using Dotplot to show the Upper/Lower and Mean of a series of data. Instead of the lines connecting the Upper/Lower being all the same color, I would like to change them to have three colors matching three tests of PSQ, MODS, and LPA.

I have tried adding groups=Test but that changes the colors of the dots, not the lines. I have tried changing the plot.line to read par.settings=list(dot.symbol=list(col="red"), plot.line=list(col="black"))))c("black", "green", "yellow") but that appears to do nothing.

Where is that fine control found ? I must admit that my review of all the documentation has left me completely confused!

library(lattice)
library(Hmisc)
library(latticeExtra)
df3 <- data.frame (Center=c(0.939096267,0.996441281,0.959493671,0.97,0.986899563,0.975308642,0.952554745,0.961038961,0.955070603,0.966527197,0.978851964,0.971569839,0.995642702,0.977777778,0.989026063,0.938496583,0.990990991,0.95612708,0.867924528,1,0.989583333,0.9,0.995447648,0.986282579,0.835616438,0.993131868,0.978776529,0.862745098,0.996779388,0.986607143,0.850746269,0.993957704,0.98079561,0.842857143,0.990424077,0.97752809,0.479166667,1,0.925595238,0.618644068,0.998363339,0.936899863,0.504132231,0.992647059,0.918851436,0.95473251,0.98997996,0.978436658,0.978417266,0.971046771,0.973865199,0.9375,0.983050847,0.966397849,0.959016393,0.993975904,0.982479784,0.982332155,0.979820628,0.98079561,0.941818182,0.991489362,0.973154362),
Lower95=c(0.913721501,0.977214764,0.942646509,0.949873385,0.959047884,0.96047959,0.930325646,0.924883712,0.937420013,0.945052276,0.955010789,0.95696795,0.982586611,0.949905896,0.977597259,0.9106776,0.964346872,0.936824251,0.740467462,0.992310928,0.977667054,0.79897089,0.985589893,0.974057008,0.726511974,0.983074825,0.965515713,0.731276464,0.987098305,0.973782151,0.737989738,0.983497602,0.967175385,0.731947886,0.979457041,0.964003246,0.37701062,0.991740763,0.902414021,0.524297048,0.989439738,0.916087186,0.412290545,0.981888477,0.897194717,0.918220108,0.97538158,0.964437118,0.951322012,0.949720369,0.958715474,0.900010728,0.965534012,0.950076233,0.923645134,0.980972436,0.969416444,0.956905801,0.960656542,0.967175385,0.905411484,0.976821949,0.958094682),
Upper95=c(0.957586629,0.999814212,0.971692002,0.982495167,0.996610635,0.984859048,0.968166084,0.980868932,0.968060604,0.980094808,0.99070216,0.981478773,0.999244937,0.990934934,0.994888595,0.958329294,0.998438069,0.969907638,0.940863624,1,0.99542805,0.955466392,0.998823583,0.993014472,0.908580205,0.997468782,0.987188883,0.938490331,0.999441979,0.993450192,0.922307277,0.998062689,0.989039583,0.915246243,0.995797617,0.986224356,0.583007853,1,0.943758562,0.705153863,0.999914563,0.952955984,0.595707992,0.997289904,0.936378766,0.97602415,0.996305355,0.987199157,0.991196692,0.983827825,0.983745192,0.962046972,0.992098025,0.977683872,0.979040058,0.998442942,0.990230713,0.993477661,0.990120709,0.989039583,0.965275249,0.997270272,0.983085371),
Drug=c("INH","INH","INH","INH","INH","INH","INH","INH","INH","RIF","RIF","RIF","RIF","RIF","RIF","RIF","RIF","RIF","AMK","AMK","AMK","AMK","AMK","AMK","AMK","AMK","AMK","CAP","CAP","CAP","CAP","CAP","CAP","CAP","CAP","CAP","KAN","KAN","KAN","KAN","KAN","KAN","KAN","KAN","KAN","MOX","MOX","MOX","MOX","MOX","MOX","MOX","MOX","MOX","OFX","OFX","OFX","OFX","OFX","OFX","OFX","OFX","OFX"),
Test=c("LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ","LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ","LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ","LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ","LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ","LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ","LPA","LPA","LPA","MODS","MODS","MODS","PSQ","PSQ","PSQ"),
Measure=c("Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree","Sensitivity","Specificity","Agree")
)

foo <- useOuterStrips(Dotplot(Test~Cbind(Center,Lower95,Upper95) | Measure+Drug, 
    df3, xlim=c(0.9,1), 
    as.table=TRUE, 
    par.settings=list(dot.symbol=list(col="red"), plot.line=list(col="black"))))
foo

Thanks !

Upvotes: 1

Views: 554

Answers (1)

MrFlick
MrFlick

Reputation: 206167

I see no easy way to fix this with the current panel.Dotplot implementation. So I copied it and made a few changes. Here:

panel.Dotplot2 <- function (x, y, groups = NULL, pch = dot.symbol$pch, 
    col = dot.symbol$col, cex = dot.symbol$cex, font = dot.symbol$font, abline, 
    superpose.line=TRUE, superpose.symbol=FALSE, ...) 
{
    gfun <- ordGridFun(TRUE)
    segmnts <- gfun$segments
    y <- as.numeric(y)
    gp <- length(groups)>0
    dot.symbol <- trellis.par.get(if (gp && superpose.symbol) 
        "superpose.symbol"
    else "dot.symbol")
    dot.line <- trellis.par.get("dot.line")
    plot.line <- trellis.par.get(if (gp && superpose.line) 
        "superpose.line"
    else "plot.line")
    gfun$abline(h = unique(y), lwd = dot.line$lwd, lty = dot.line$lty, 
        col = dot.line$col)
    if (!missing(abline)) {
        if (length(names(abline))) 
            do.call("panel.abline", abline)
        else for (i in 1:length(abline)) do.call("panel.abline", 
            abline[[i]])
    }
    other <- attr(x, "other")
    x <- unclass(x)
    attr(x, "other") <- NULL
    if (length(other)) {
        nc <- ncol(other)
        if (gp && superpose.line) {
            panel.superpose(other[,1], y, xend=other[, nc], groups = as.numeric(groups), 
                col = plot.line$col, lty = plot.line$lty, lwd=plot.line$lwd, font = font,
                panel.groups=function(x,y, group.number, xend, ...) {
                    panel.segments(x, y, xend[group.number], y, ...)
                }, 
                ...)            
        } else {
          segmnts(other[, 1], y, other[, nc], y, lwd = plot.line$lwd[1], 
              lty = plot.line$lty[1], col = plot.line$col[1])
          if (nc == 4) {
              segmnts(other[, 2], y, other[, 3], y, lwd = 2 * plot.line$lwd[1], 
                  lty = plot.line$lty[1], col = dot.symbol$col[1])
              gfun$points(other[, 2], y, pch = 3, cex = cex, col = col, 
                  font = font)
              gfun$points(other[, 3], y, pch = 3, cex = cex, col = col, 
                  font = font)
          }
        }
        if (gp && superpose.symbol) 
            panel.superpose(x, y, groups = as.numeric(groups), 
               pch = pch, col = col, cex = cex, font = font, 
               ...)
        else gfun$points(x, y, pch = pch[1], cex = cex, col = col, 
            font = font)
    }
    else {
        if (gp && superpose.symbol) 
            panel.superpose(x, y, groups = as.numeric(groups), 
                pch = pch, col = col, cex = cex, font = font, 
                ...)
        else panel.dotplot(x, y, pch = pch, col = col, cex = cex, 
            font = font, ...)
    }
    if (gp) {
        Key <- function(x = 0, y = 1, lev, cex, col, font, pch, 
            other) {
            if (!length(x)) 
                x <- 0.05
            if (!length(y)) 
                y <- 0.95
            rlegendg(x, y, legend = lev, cex = cex, col = col, 
                pch = pch, other = other)
            invisible()
        }
        lev <- levels(as.factor(groups))
        ng <- length(lev)
        formals(Key) <- list(x = NULL, y = NULL, lev = lev, cex = cex[1:ng], 
            col = col[1:ng], font = font[1:ng], pch = pch[1:ng], 
            other = NULL)
        .setKey(Key)
    }
}
environment(panel.Dotplot2)<-asNamespace("Hmisc")

I added parameters for superpose.line and superpose.symbol. These you can set to TRUE/FALSE to indicate if you would like the lines or symbols be colored in the plot. So you can use it on your sample data with

foo <- useOuterStrips(Dotplot(Test~Cbind(Center,Lower95,Upper95) | Measure+Drug, 
    df3, xlim=c(0.9,1), groups=Test, 
    as.table=TRUE, panel=panel.Dotplot2, 
    par.settings=list(dot.symbol=list(col="red"))))
foo

to get

enter image description here

Upvotes: 1

Related Questions