修改PlotSlope输出(pequod包)

时间:2014-11-30 10:11:31

标签: r ggplot2

我使用了R中PlotSlope包中的pequod函数制作了这个图: enter image description here

这张图几乎就在我之后,除了我想要(1)去掉端点标记和(2)使其中一条线点缀。鉴于如何构建PlotSlope函数,我无法弄清楚这是否可行。

PlotSlope建立在ggplot函数之上。 pequod包中的所有详细信息均为here,根据此链接,PlotSlope函数定义为:

function(object, namemod = "default", 
namex = "default", namey = "default", limitx = "default", 
limity = "default") {

pmatr <- object$Points
nomY <- object$nomY
nomX <- object$nomX
X_1L <- object$X_1L
X_1H <- object$X_1H

if (object$orde == 2) {
nam <- dimnames(object$simple_slope)[1]
nam <- nam[[1]]
r1 <- nam[1]
r2 <- nam[2]

xini <- rep(X_1L, 4)
xend <- rep(X_1H, 4)
fact <- c(5, 6)
mat <- cbind(fact, xini, pmatr[, 1], xend, pmatr[, 2])
mat <- as.data.frame(mat)
names(mat) <- c("fact", "xini", "yini", "xend", "yend")
p <- ggplot(mat, aes(x = xini, y = yini))
p1 <- p + geom_segment(aes(xend = xend, yend = yend))
p1 <- p1 + scale_x_continuous(nomX) + scale_y_continuous(nomY)
p1 <- p1 + geom_point(size = 3, aes(shape = factor(fact))) + 
geom_point(aes(x = xend, y = yend, shape = factor(fact)), 
size = 3)

if (length(namemod) == 1) {
p1 <- p1 + scale_shape(name = "Moderator", breaks = c(5, 
6), labels = c(r1, r2))
  }
if (length(namemod) > 1) {
if (length(namemod) != 2) {
stop("length of namemod vector must be = 2")
  }
p1 <- p1 + scale_shape(name = "Moderator", breaks = c(5, 
6), labels = namemod)
  }

if (namex != "default") {
if (length(limitx) == 2) {
p1 <- p1 + scale_x_continuous(namex, limits = limitx)
  }
else {
p1 <- p1 + scale_x_continuous(namex)
  }

  }

if (namey != "default") {
if (length(limity) == 2) {
p1 <- p1 + scale_y_continuous(namey, limits = limity)
  }
else {
p1 <- p1 + scale_y_continuous(namey)
  }
  }

return(p1)
  }

这是我的数据:

structure(list(rf1 = c(-0.25, 1, 1.5, -0.5, -0.75, 1.25, 0.25, 
0.75, 0.25, 1, -0.25, -0.5, 0.25, 2.75, 1.5, 1.5, 0, 0.75, 0, 
0.25, 0, -2, 0, 0.5, 0.75, -0.75, 2, -1.25, 1.5, 1, -0.5, 0.5, 
-0.75, 2, -0.75, -0.5, 0, 2.5, -0.75, 0.5, 1, 1.75, -1.5, 1, 
-0.25, -0.75, -1.5, -0.25, 1, 0.75, 1, 1.25, 1.75, -0.75, 1.5, 
-0.25, -0.5, 0.25, 0, NA, 1.75, 0, 1.25, -2.75, 0, -0.5, 1, 0.5, 
-0.25, -0.25, 1.5, -0.25, 0.25, 1, 1.5, 1.75, -1, 1.5, 0, -0.25, 
0, 0, -0.25, -0.5, -1.25, 0.75, 0.5, -0.5, 0, 0.75, 1.25, 2, 
0.75, -1.25, 0, NA, -0.25, 1.5, 2, 1.25, 0.25, 0.5, 1.25, 0, 
0.5, -0.75, 0, -0.75, 0.75, -1.25, 2.5, 0.5, NA, -1.25, 0.25, 
0.5, 0, 0, 1, 0, 1.25, 0.5, 0.25, 1, -0.75, 0.5, -0.5, -0.25, 
0.25, 0, -1.25, -0.5, 1.75, -0.75, -1.5, -0.5, -0.5, 0, -0.25, 
1, 1.25, 0, 1, 0, 1.5, -0.25, 0, 1.25, -0.25, NA, -0.25, -0.5, 
0.5, -1, 0.25, 0.25, 0.75, 0.5, -0.5, -2.25, 1.75, 1.25, -0.75, 
1.75, NA, -0.75, 1.75, -0.5, 0, -0.25, 1.5, -0.25, 0, -0.25, 
-0.25, 0, 0, 0.5, -0.25, 1, -0.5, 0, 0, 0.75, 0.75, 0, 0, 0.25, 
1, NA, 1, -0.75, -0.75, NA, -1, -0.5, 1.25, 0.25, 0.5, -4.25, 
0, 0.5), rf2 = c(-1.5, -0.25, 0, -0.75, -1.25, 2.5, NA, 1.5, 
-1.25, 1.25, 0.5, -0.5, 1, 2.25, -0.25, 2, -0.75, 1, 0.5, 1, 
0.5, 0, 0, 0.5, 1.25, -0.25, 1.25, -1.25, 1, 0, 0, -0.25, 0, 
2, -0.25, 0.25, -0.25, 0.5, NA, 0.75, 0.5, NA, -1.5, 0, 0.25, 
2.25, 1.5, -0.5, 1, 1, 0.75, 1.75, 1.5, -1.5, 0, -0.5, 0.5, 1, 
0.25, -0.5, NA, 0.75, 2.5, 0, -0.25, 0.75, -1.5, 0.75, 0.25, 
-1, NA, 0.5, -1.5, 1.25, NA, -0.75, 0.25, NA, 0.5, 0, NA, -0.25, 
0.25, 0.5, 0.5, 2.5, 1.5, 1, NA, -1.5, 0.75, -1.25, -0.25, 1, 
1.5, 0.5, 0.75, 0.75, 2.5, 1, 1.25, -1, 0.25, -0.75, 0.25, 0, 
-0.75, -2, 0.25, -0.75, 1.25, 1.5, 0.75, 0, 0.75, 0, 0.25, 1, 
1, NA, 0.5, 0.5, 0, 1.25, -1.25, -0.25, 1.75, -1.25, 0.25, 0.25, 
NA, 0.25, 0, 1.75, -0.25, 2.5, 0.75, 0.25, -0.25, 0.75, 0.25, 
0, -0.5, 0.5, 0, 0, 0, 0.25, 0.25, -0.75, 0.25, 0.5, NA, -1.25, 
-0.5, 0.25, 0, 0.75, 0.25, 1, -0.5, 2.5, -0.75, 0.75, 0, 1.5, 
0.25, 0, 0, -1, 1.75, -0.75, 2, -0.5, 0.25, 0.25, -1.25, 0.5, 
0.5, -0.25, -1.25, 0.25, 0.5, 1.5, 2.5, 0.75, 0.5, 0.5, -0.5, 
-0.25, -0.5, 0.25, -0.5, -0.25, -1, -1, NA, -0.5, 0.25, -2.5, 
-0.5, 1), integration = c(5L, 6L, 6L, 4L, 5L, 4L, 5L, 6L, 2L, 
6L, 2L, 5L, 4L, 5L, 6L, 4L, 3L, 6L, 5L, 6L, 5L, 2L, 5L, 6L, 4L, 
4L, 4L, 2L, 6L, 3L, 6L, 3L, 5L, 3L, 6L, 3L, 5L, 3L, 4L, 4L, 5L, 
5L, 6L, 3L, 2L, 5L, 3L, 6L, 5L, 3L, 4L, 6L, 6L, 5L, 6L, 3L, 6L, 
4L, 4L, 5L, 4L, 5L, 6L, 5L, 2L, 5L, 5L, 4L, 5L, 4L, 3L, 4L, 3L, 
4L, 5L, 5L, 2L, 4L, 4L, 4L, 6L, 3L, 4L, 4L, 4L, 3L, 6L, 3L, 2L, 
4L, 6L, 2L, 4L, 6L, 6L, 2L, 4L, 6L, 6L, 3L, 5L, 5L, 4L, 3L, 4L, 
6L, 2L, 4L, 5L, 6L, 6L, 4L, 5L, 2L, 4L, 6L, 4L, 5L, 4L, 6L, 5L, 
6L, 6L, 3L, 4L, 4L, 6L, 4L, 5L, 6L, 3L, 5L, 5L, 4L, 4L, 3L, 5L, 
5L, 6L, 5L, 2L, 4L, 4L, 6L, 6L, 6L, 4L, 4L, 5L, 5L, 4L, 6L, 2L, 
6L, 4L, 5L, 4L, 5L, 4L, 5L, 3L, 5L, 5L, 4L, 5L, 6L, 5L, 5L, 6L, 
6L, 6L, 5L, 6L, 6L, 4L, 4L, 5L, 5L, 5L, 4L, 4L, 4L, 5L, 5L, 4L, 
4L, 6L, 6L, 4L, 5L, 3L, 6L, 4L, 5L, 4L, 3L, 2L, 2L, 6L, 5L, 6L, 
6L)), .Names = c("v3", "v2", "v1"), row.names = c(NA, 
-202L), class = "data.frame")

我的情节代码:

regress <- lmres(v3 ~ v1 * v2, mydata)
ss <- simpleSlope(regress, pred="v2", mod1="v1")

ss.plot <- PlotSlope(ss, namemod=c("Low v1", "High v1"), namex="v2", namey="v3", limitx=c(-1, 1.5), limity=c(-0.5, 1)) +
  theme_bw(base_family = "Arial", base_size = 16) +
  theme(legend.position = c(.15,.92)) +
  theme(legend.key = element_blank()) +
  theme(axis.title.x = element_text(vjust=-0.3)) +
  theme(axis.title.y = element_text(vjust=1)) +
  theme(panel.grid.minor = element_blank()) +
  theme(panel.grid.major = element_blank()) +
  theme(panel.border = element_blank()) +
  theme(axis.line = element_line(color = 'black')) +
  theme(legend.title=element_blank())
ss.plot

1 个答案:

答案 0 :(得分:1)

使用从PlotSlope修改的此函数

Plotsl <- function (object, namemod = "default", namex = "default", namey = "default", 
                    limitx = "default", limity = "default") 
{
  yini <- yend <- NULL
  pmatr <- object$Points
  nomY <- object$nomY
  nomX <- object$nomX
  X_1L <- object$X_1L
  X_1H <- object$X_1H
  if (object$orde == 2) {
    nam <- dimnames(object$simple_slope)[1]
    nam <- nam[[1]]
    r1 <- nam[1]
    r2 <- nam[2]
    xini <- rep(X_1L, 4)
    xend <- rep(X_1H, 4)
    fact <- c(5, 6)
    mat <- cbind(fact, xini, pmatr[, 1], xend, pmatr[, 2])
    mat <- as.data.frame(mat)
    names(mat) <- c("fact", "xini", "yini", "xend", "yend")
    print(mat)
    p <- ggplot(mat, aes(x = xini, y = yini))
    p1 <- p + geom_segment(aes(xend = xend, yend = yend, linetype=factor(fact)))
    p1 <- p1 + scale_x_continuous(nomX) + scale_y_continuous(nomY)
    #p1 <- p1 + geom_point(size = 3, aes(shape = factor(fact))) + 
    #  geom_point(aes(x = xend, y = yend, shape = factor(fact)), 
    #             size = 3)
    if (length(namemod) == 1) {
      print(namemod)
     p1 <- p1 + scale_linetype(name = "Moderator", breaks = c(5, 
                                                           6), labels = c(r1, r2))
    }
    if (length(namemod) > 1) {
      if (length(namemod) != 2) {
        stop("length of namemod vector must be = 2")
      }
      print(namemod)
      p1 <- p1 + scale_shape(name = "Moderator", breaks = c(5, 
                                                            6), labels = namemod)
    }
    if (namex != "default") {
      if (length(limitx) == 2) {
        p1 <- p1 + scale_x_continuous(namex, limits = limitx)
      }
      else {
        p1 <- p1 + scale_x_continuous(namex)
      }
    }
    if (namey != "default") {
      if (length(limity) == 2) {
        p1 <- p1 + scale_y_continuous(namey, limits = limity)
      }
      else {
        p1 <- p1 + scale_y_continuous(namey)
      }
    }
    return(p1)
  }
  if (object$orde == 3) {
    nam <- dimnames(object$simple_slope)[1]
    nam <- nam[[1]]
    r1 <- nam[1]
    r2 <- nam[2]
    r3 <- nam[3]
    r4 <- nam[4]
    xini <- rep(X_1L, 4)
    xend <- rep(X_1H, 4)
    fact <- c(5, 6, 7, 8)
    mat <- cbind(fact, xini, pmatr[, 1], xend, pmatr[, 2])
    mat <- as.data.frame(mat)
    names(mat) <- c("fact", "xini", "yini", "xend", "yend")
    p <- ggplot(mat, aes(x = xini, y = yini))
    p1 <- p + geom_segment(aes(xend = xend, yend = yend))
    p1 <- p1 + scale_x_continuous(nomX) + scale_y_continuous(nomY)
    p1 <- p1 + geom_point(size = 3, aes(shape = factor(fact))) + 
      geom_point(aes(x = xend, y = yend, shape = factor(fact)), 
                 size = 3)
    if (length(namemod) == 1) {
      p1 <- p1 + scale_shape(name = "Moderators Combination", 
                             breaks = c(5, 6, 7, 8), labels = c(r1, r2, r3, 
                                                                r4))
    }
    if (length(namemod) > 1) {
      if (length(namemod) != 4) {
        stop("length of namemod vector must be = 4")
      }
      p1 <- p1 + scale_shape(name = "Moderators Combination", 
                             breaks = c(5, 6, 7, 8), labels = namemod)
    }
    p2 <- p1
    if (namex != "default") {
      if (length(limitx) == 2) {
        p2 <- p2 + scale_x_continuous(namex, limits = limitx)
      }
      else {
        p2 <- p2 + scale_x_continuous(namex)
      }
    }
    if (namey != "default") {
      if (length(limity) == 2) {
        p2 <- p2 + scale_y_continuous(namey, limits = limity)
      }
      else {
        p2 <- p2 + scale_y_continuous(namey)
      }
    }
    return(p2)
  }
}

example of the modified Plot version

相关问题