经过多次反复试验，我弄清楚了如何编辑 coefplot multiplot 函数的源代码。
创建我们的测试数据集。
library(coefplot)
model1 <- lm(price ~ carat + cut, data=diamonds)
model2 <- lm(price ~ carat + cut + color, data=diamonds)
model3 <- lm(price ~ carat + color, data=diamonds)
dflist <- list(buildModelCI(model1), buildModelCI(model2), buildModelCI(model3))
dflist
现在下面是 multiplot 函数的调整代码，它将采用包含系数的 dflist 数据框，而不是模型列表。
#edited version of buildModelCI.default for parsing the dataframes
modelfunc <- function(model, outerCI=2, innerCI=1, intercept=TRUE, numeric=FALSE,
sort=c("natural", "magnitude", "alphabetical"),
decreasing=TRUE, name=NULL, ...)
{
modelCI <- model
sort <- match.arg(sort)
## possible orderings of the coefficients
ordering <- switch(sort,
natural=order(1:nrow(modelCI), decreasing=decreasing), # the way the data came in
magnitude=order(modelCI$Value, decreasing=decreasing), # size order
alphabetical=order(modelCI$Coefficient, decreasing=decreasing), # alphabetical order
order(1:nrow(modelCI)) # default, the way it came in
)
# implement the ordering
modelCI <- modelCI[ordering, ]
modelCI$Coefficient <- factor(modelCI$Coefficient, levels=modelCI$Coefficient)
return(modelCI)
}
#new function for multiplot coeffcient plots
mymultiplot <- function (..., title = "Coefficient Plot", xlab = "Value", ylab = "Coefficient",
innerCI = 1, outerCI = 0, lwdInner = 1, lwdOuter = 0, pointSize = 3,
dodgeHeight = 1, color = "blue", shape = 16, linetype = 1,
cex = 0.8, textAngle = 0, numberAngle = 90, zeroColor = "grey",
zeroLWD = 1, zeroType = 2, single = FALSE, scales = "fixed",
ncol = length(unique(modelCI$Model)), sort = c("natural",
"normal", "magnitude", "size", "alphabetical"), decreasing = TRUE,
names = NULL, numeric = FALSE, fillColor = "grey", alpha = 1/2,
horizontal = FALSE, factors = NULL, only = NULL, shorten = TRUE,
intercept = TRUE, interceptName = "(Intercept)", coefficients = NULL,
predictors = NULL, strict = FALSE, newNames = NULL, plot = TRUE,
drop = FALSE, by = c("Coefficient", "Model"), plot.shapes = FALSE,
plot.linetypes = FALSE, legend.position = "right", secret.weapon = FALSE)
{
if (tryCatch(is.list(...), error = function(e) FALSE)) {
theDots <- list(...)[[1]]
if (is.null(names(theDots))) {
names(theDots) <- sprintf("Model%s", 1:length(theDots))
}
}
else {
theDots <- list(...)
}
theArgs <- unlist(structure(as.list(match.call()[-1]), class = "uneval"))
if (is.null(names(theArgs))) {
theNames <- theArgs
}
else {
theNames <- theArgs[names(theArgs) == ""]
}
if (is.null(names(theDots))) {
names(theDots) <- theNames
}
sort <- match.arg(sort)
by <- match.arg(by)
legend.position <- match.arg(legend.position)
if (secret.weapon) {
by <- "Model"
horizontal <- TRUE
}
if (by == "Model" & length(coefficients) != 1) {
stop("If plotting the model along the axis then exactly one coefficient must be specified for plotting")
}
#new code to parse data frames
modelCI <- plyr:::ldply(theDots, modelfunc, outerCI = outerCI,
innerCI = innerCI, intercept = intercept, numeric = numeric,
sort = sort, decreasing = decreasing, factors = factors,
shorten = shorten, coefficients = coefficients, predictors = predictors,
strict = strict, newNames = newNames)
#oldcode to parse models
#modelCI <- plyr:::ldply(theDots, .fun = buildModelCI, outerCI = outerCI,
# innerCI = innerCI, intercept = intercept, numeric = numeric,
# sort = sort, decreasing = decreasing, factors = factors,
# shorten = shorten, coefficients = coefficients, predictors = predictors,
# strict = strict, newNames = newNames)
modelCI$Model <- modelCI$.id
modelCI$.id <- NULL
if (!is.null(names)) {
names(names) <- theNames
modelCI$Model <- names[modelCI$Model]
}
if (drop) {
notNA <- daply(modelCI, .variables = "Model", function(x) {
!all(is.na(x$Coef))
})
modelCI <- modelCI[modelCI$Model %in% names(which(notNA ==
TRUE)), ]
}
if (!plot) {
return(modelCI)
}
p <- coefplot:::buildPlotting.default(modelCI = modelCI, title = title,
xlab = xlab, ylab = ylab, lwdInner = lwdInner, lwdOuter = lwdOuter,
pointSize = pointSize, dodgeHeight = dodgeHeight, color = color,
shape = shape, linetype = linetype, cex = cex, textAngle = textAngle,
numberAngle = numberAngle, zeroColor = zeroColor, zeroLWD = zeroLWD,
outerCI = outerCI, innerCI = innerCI, zeroType = zeroType,
numeric = numeric, fillColor = fillColor, alpha = alpha,
multi = TRUE, value = "Value", coefficient = by, horizontal = horizontal,
facet = FALSE, scales = "fixed")
theColorScale <- list(Coefficient = scale_colour_discrete("Model"),
Model = scale_color_manual(values = rep(color, length(unique(modelCI$Model))),
guide = FALSE))
theShapeScale <- list(NoShapes = scale_shape_manual(values = rep(shape,
length(unique(modelCI$Model))), guide = FALSE), Shapes = scale_shape_manual(values = 1:length(unique(modelCI$Model))))
theLinetypeScale <- list(NoShapes = scale_linetype_manual(values = rep(linetype,
length(unique(modelCI$Model))), guide = FALSE), Shapes = scale_linetype_manual(values = 1:length(unique(modelCI$Model))))
p + theColorScale[[by]] + theShapeScale[[plot.shapes + 1]] +
theLinetypeScale[[plot.linetypes + 1]] + theme(legend.position = legend.position) +
if (!single)
facet_wrap(~Model, scales = scales, ncol = ncol)
}
现在我们用新函数绘制图形
mymultiplot(dflist)
