如何在RSM (R)中填充轮廓颜色并写入轴名称

Question

如何在RSM (R)中填充轮廓颜色并写入轴名称

5

我有以下数据。

ct<-structure(list(Conc = c(50L, 100L, 150L, 50L, 100L, 150L, 50L, 
100L, 150L, 100L, 100L, 100L), kGy = c(10L, 10L, 10L, 15L, 15L, 
15L, 20L, 20L, 20L, 15L, 15L, 15L), CT.Y. = c(75L, 65L, 51L, 
87L, 93L, 89L, 81L, 86L, 78L, 92L, 93L, 92L)), .Names = c("Conc", 
"kGy", "CT.Y."), class = "data.frame", row.names = c(NA, -12L))

我正在使用以下R代码来生成响应曲面：

library(rsm)
ct.rsm<-rsm(CT.Y.~SO(Conc, kGy), data=ct)
persp(ct.rsm, Conc ~ kGy, col=rainbow(50), theta=60,
    phi=0, r = 3, d=1, border = NULL, ltheta = -135, lphi = 0
    , shade = 0.75, zlab="CT",ylab="Concentration %", col.axis=37, font.lab=2,col.lab=33,
    contour=("colors"))

有一个问题是如何在轮廓线中填充颜色？另一个问题是关于坐标轴的标签。对于X和Z轴的标签，我可以进行标注，但当我想包括Y轴的标签时，我收到以下错误。

Error in persp.default(dat$x, dat$y, dat$z, xlab = dat$labs[1], ylab = dat$labs[2],  : 
  formal argument "ylab" matched by multiple actual arguments

希望有人能在这方面帮助我。提前感谢您。响应曲面图

- Iftikhar

我尝试加载数据，但该结构不完整。通常这样的问题是由于软件包作者硬编码了“ylab”，因此您需要修改该函数。我承认这有点奇怪，因为您甚至没有指定ylab，而该函数是persp的默认版本。 - IRTFM

代码中有错误，请检查更新后的代码，其中我已经包含了ylab。响应曲面看起来很好，但我还需要等高线中的颜色。 - Iftikhar

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- IRTFM · Accepted Answer

我整合了一个可工作的示例，展示了您的数据（不包括行名）。从 rsm 函数返回的对象是类 "rsm" "lm"，因此会由 persp.lm 处理。该函数有一个硬编码的 ylab 规范，并且没有提供重新标记的方法。它可以通过颠倒 x 和 ylabs 来修复（这可能很令人困惑）。我将 draw.cont.line 中的 line 函数更改为多边形函数，并且说明需要进一步努力以链接在下面提到的端点。

    persp.lm <- 
function (x, form, at, bounds, zlim, zlab, xlabs, col = "white", xlab=xlab,
    contours = NULL, hook, atpos = 3, theta = -25, phi = 20, 
    r = 4, border = NULL, box = TRUE, ticktype = "detailed", ylab,
    ... ) 
{
    draw.cont.line = function(line) {
        if (cont.varycol) {
            cont.col = col
            if (length(col) > 1) 
                cont.col = col[cut(c(line$level, dat$zlim), length(col))][1]
        }
        polygon(trans3d(line$x, line$y, cont.z, transf), col = cont.col, 
            lwd = cont.lwd)
    }
    plot.data = contour.lm(x, form, at, bounds, zlim, xlabs, 
        atpos = atpos, plot.it = FALSE)
    transf = list()
    if (missing(zlab)) 
        zlab = ""
    facet.col = col
    cont = !is.null(contours)
    if (mode(contours) == "logical") 
        cont = contours
    cont.first = cont
    cont.z = cz = plot.data[[1]]$zlim[1]
    cont.col = 1
    cont.varycol = FALSE
    cont.lwd = 1
    if (is.character(contours)) {
        idx = charmatch(contours, c("top", "bottom", "colors"), 
            0)
        if (idx == 1) {
            cont.first = FALSE
            cont.z = plot.data[[1]]$zlim[2]
        }
        else if (idx == 2) {
        }
        else if (idx == 3) {
            cont.varycol = TRUE
            if (length(col) < 2) 
                col = rainbow(40)
        }
        else cont.col = contours
    }
    else if (is.list(contours)) {
        if (!is.null(contours$z)) 
            cz = contours$z
        if (is.numeric(cz)) 
            cont.z = cz
        else if (cz == "top") {
            cont.first = FALSE
            cont.z = plot.data[[1]]$zlim[2]
        }
        if (!is.null(contours$col)) 
            cont.col = contours$col
        if (!is.null(contours$lwd)) 
            cont.lwd = contours$lwd
        if (charmatch(cont.col, "colors", 0) == 1) {
            cont.varycol = TRUE
            if (length(col) < 2) 
                col = rainbow(40)
        }
    }
    for (i in 1:length(plot.data)) {
        dat = plot.data[[i]]
        cont.lines = NULL
        if (!missing(hook)) 
            if (!is.null(hook$pre.plot)) 
                hook$pre.plot(dat$labs)
        if (cont) 
            cont.lines = contourLines(dat$x, dat$y, dat$z)
        if (cont && cont.first) {
            transf = persp(dat$x, dat$y, dat$z, zlim = dat$zlim, xlab=ylab,
                theta = theta, phi = phi, r = r, col = NA, border = NA, 
                box = FALSE)
            lapply(cont.lines, draw.cont.line)
            par(new = TRUE)
        }
        if (length(col) > 1) {
            nrz = nrow(dat$z)
            ncz = ncol(dat$z)
            zfacet = dat$z[-1, -1] + dat$z[-1, -ncz] + dat$z[-nrz, 
                -1] + dat$z[-nrz, -ncz]
            zfacet = c(zfacet/4, dat$zlim)
            facet.col = cut(zfacet, length(col))
            facet.col = col[facet.col]
        }
        transf = persp(dat$x, dat$y, dat$z, xlab = xlab, 
             zlab = zlab, zlim = dat$zlim, ylab=ylab,
            col = facet.col, border = border, box = box, theta = theta, 
            phi = phi, r = r, ticktype = ticktype)
        if (atpos == 3) 
            title(sub = dat$labs[5])
        if (cont && !cont.first) 
            lapply(cont.lines, draw.cont.line)
        if (!missing(hook)) 
            if (!is.null(hook$post.plot)) 
                hook$post.plot(dat$labs)
        plot.data[[i]]$transf = transf
    }
    invisible(plot.data)
}

persp(ct.rsm, Conc ~ kGy, col=rainbow(50), theta=60, xlab="Something",
    phi=0, r = 3, d=1, border = NULL, ltheta = -135, lphi = 0
    , shade = 0.75, zlab="CT",ylab="Concentration %", col.axis=37, font.lab=2,col.lab=33,
    contour=("colors"))

enter image description here