如何设置在R中用晶格创建的堆积条形图的标签?

时间:2015-02-26 13:52:32

标签: r lattice

前段时我solved将标签作为使用likert包中使用HH功能的lattice函数创建的堆积条形图中的百分比。我的数据是具有偶数级别的Likert类型量表的答案 代码按我的预期工作。

+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
|   | Strongly Disagree | Moderate Disagree | Slightly Disagree | Slightly Agree | Moderate Agree | Strongly Agree | Group              |
+===+===================+===================+===================+================+================+================+====================+
| 1 | 2.00              | 1.00              | 3.00              | 1.00           | 4.00           | 9.00           | Experimental group |
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
| 2 | 1.00              | 2.00              | 1.00              | 5.00           | 5.00           | 6.00           | Control group      |
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+

enter image description here 当我尝试使用奇数级别的代码时,我注意到一个奇怪的问题,代表中间答案的百分比分为两个相等的部分,这不是预期的行为。在中间部分,我们必须看到这两个百分比的总和。如何解决这个问题?

+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
|   | Strongly Disagree | Moderate Disagree | Neither Agree nor Disagree | Moderate Agree | Strongly Agree | Group              |
+===+===================+===================+============================+================+================+====================+
| 1 | 0.00              | 0.00              | 9.00                       | 10.00          | 1.00           | Experimental Group |
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
| 2 | 1.00              | 5.00              | 10.00                      | 4.00           | 0.00           | Control Group      |
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+

enter image description here

偶数级别的数据:

data.freq <- structure(list(`Strongly Disagree` = c(2L, 1L), `Moderate Disagree` = 1:2, `Slightly Disagree` = c(3L, 1L), `Slightly Agree` = c(1L, 5L), `Moderate Agree` = 4:5, `Strongly Agree` = c(9L, 6L), Group = c("Experimental group", "Control group")), .Names = c("Strongly Disagree", "Moderate Disagree", "Slightly Disagree", "Slightly Agree", "Moderate Agree", "Strongly Agree", "Group"), row.names = c("1", "2"), class = "data.frame")

奇数级别的数据:

data.freq <- structure(list(`Strongly Disagree` = 0:1, `Moderate Disagree` = c(0L, 5L), `Neither Agree nor Disagree.` = 9:10, `Moderate Agree` = c(10L, 4L), `Strongly Agree` = c(1L, 0L), Group = c("Experimental Group", "Control Group")), .Names = c("Strongly Disagree", "Moderate Disagree", "Neither Agree nor Disagree", "Moderate Agree", "Strongly Agree", "Group"), row.names = c("1", "2"), class = "data.frame")

代码:

library(HH)
ppi <- 150
jpeg("ssb_%02d.jpg", width=7*ppi, height=4*ppi, res=ppi)
scales.lab <- seq(-100, 100, by = 20)

plot_obj <- likert(Group ~ . | Group, data = data.freq, as.percent = TRUE, positive.order = TRUE,
    main="", xlab="",
    ylab="", ylab.right = list("Subjects per group", cex=1.1),
    scales = list(y = list(relation = "free", labels=""), cex=1.1, 
        x = list(at=scales.lab, labels=paste(abs(scales.lab), "%", sep = "")), cex = 0.8),
    layout = c(1, 2), auto.key=list(space="bottom", columns=3, cex.title=1.1, title="Levels", cex=1.1, size = 1, between.columns=0.5))

plot_obj <- plot_obj +
    layer({
        id = which(x > 0)
        xx = 0.5 * (cumsum(x[id]) + cumsum(c(0, x[id][-length(id)])))
        keep = x[id] >= 5
        panel.text(xx[keep], y[id][keep], labels = paste(x[id][keep], "%", sep = ""), cex = 0.8, srt = 45)
        id = which(x < 0)
        xx = 0.5 * (cumsum(x[id]) + cumsum(c(0, x[id][-length(id)])))
        keep = x[id] <= -5
        panel.text(xx[keep], y[id][keep], labels = paste(-x[id][keep], "%", sep = ""), cex = 0.8, srt = 45)
    })

print(plot_obj)

dev.off()

1 个答案:

答案 0 :(得分:1)

## even
data.freq.even <- structure(list(`Strongly Disagree` = c(2L, 1L),
`Moderate Disagree` = 1:2, `Slightly Disagree` = c(3L, 1L),
`Slightly Agree` = c(1L, 5L), `Moderate Agree` = 4:5, `Strongly Agree`
= c(9L, 6L), Group = c("Experimental group", "Control group")), .Names
= c("Strongly Disagree", "Moderate Disagree", "Slightly Disagree",
"Slightly Agree", "Moderate Agree", "Strongly Agree", "Group"),
row.names = c("1", "2"), class = "data.frame")

legend.labels.even <- c("Strongly\nDisagree", "Moderate\nDisagree", "Slightly\nDisagree",
"Slightly\nAgree", "Moderate\nAgree", "Strongly\nAgree")

## odd
data.freq.odd <- structure(list(`Strongly Disagree` = 0:1,
`Moderate Disagree` = c(0L, 5L), `Neither Agree nor Disagree.` = 9:10,
`Moderate Agree` = c(10L, 4L), `Strongly Agree` = c(1L, 0L), Group =
c("Experimental Group", "Control Group")), .Names =
c("Strongly Disagree", "Moderate Disagree",
"Neither Agree nor Disagree", "Moderate Agree", "Strongly Agree",
"Group"), row.names = c("1", "2"), class = "data.frame")

legend.labels.odd <- c("Strongly\nDisagree", "Moderate\nDisagree",
"Neither Agree\nnor Disagree", "Moderate\nAgree", "Strongly\nAgree")

library(HH)

scales.lab <- seq(-100, 100, by = 20)

MalaiPlot <- function(data.freq, legend.labels, legend.columns,
                      data.columns=c(left=3, middle=1, right=3), ## Assumption: 7 columns with three left, one middle, and three right.
                      ...) {

  plot_obj <- likert(Group ~ . | Group, data = data.freq, as.percent = TRUE, positive.order = TRUE,
                     main="", xlab="",
                     ylab="", ylab.right = list("Subjects per group", cex=1.1),
                     scales = list(y = list(relation = "free", labels=""), cex=1.1,
                       x = list(at=scales.lab, labels=paste(abs(scales.lab), "%", sep = "")), cex = 0.8),
                     layout = c(1, 2),
                     auto.key=list(
                       space="bottom", columns=3, cex.title=1.1,
                       title="Levels", cex=1.1, size = 1, between.columns=0.5),
                     data.columns=data.columns,
                     ...)

  plot_obj <- plot_obj +
    layer({
      if (data.columns["middle"] == 0) { ## even

        left <- seq(from=1, length=data.columns["left"])
        middle <- integer(0)
        right <- seq(from=data.columns["left"]+1, length=data.columns["right"])

        xx <- 0.5 * (cumsum(x[right]) + cumsum(c(0, x[right][-length(right)])))
        keep <- x[right] >= 5
        panel.text(xx[keep], y[right][keep], labels = paste(x[right][keep], "%", sep = ""), cex = 0.8, srt = 45)

        xx = 0.5 * (cumsum(x[left]) + cumsum(c(0, x[left][-length(left)])))
        keep = x[left] <= -5
        panel.text(xx[keep], y[left][keep], labels = paste(-x[left][keep], "%", sep = ""), cex = 0.8, srt = 45)
      } else { ## odd

        left <- seq(from=2, length=data.columns["left"])
        middle <- c(1, data.columns["left"]+2)
        right <- seq(data.columns["left"]+3, length=data.columns["right"])

        xx <- (0.5 * (cumsum(x[c(middle[2], right)]) + cumsum(c(0, x[c(middle[2], right[-length(right)])]))))[-1]
        keep <- x[right] >= 5
        panel.text(xx[keep], y[right][keep], labels = paste(x[right][keep], "%", sep = ""), cex = 0.8, srt = 45)

        xx <- 0
        keep <- sum(abs(x)[middle]) >= 5
        panel.text(xx[keep], y[middle][keep], labels = paste(sum(abs(x)[middle])[keep], "%", sep = ""), cex = 0.8, srt = 45)


       xx <- (0.5 * (cumsum(abs(x)[c(middle[1], left)]) + cumsum(c(0, abs(x)[c(middle[1], left[-length(left)])]))))[-1]
        keep = x[left] <= -5
        panel.text(-xx[keep], y[left][keep], labels = paste(-x[left][keep], "%", sep = ""), cex = 0.8, srt = 45)
      }
    }, data=list(data.columns=data.columns))

  if (!missing(legend.labels))
    plot_obj$legend$bottom$args$text <- legend.labels
  if (!missing(legend.columns))
    plot_obj$legend$bottom$args$columns <- legend.columns

plot_obj
}

MalaiPlot(data.freq.odd, legend.labels=legend.labels.odd, legend.columns=5, data.columns=c(left=2, middle=1, right=2))

MalaiPlot(data.freq.even, legend.labels=legend.labels.even, legend.columns=6, data.columns=c(left=3, middle=0, right=3))