如何设置在 R 中用格子创建的堆叠条形图的标签？
How to set up labels of stacked bar charts created with lattice in R?
不久前，我 将标签作为百分比放置在使用 HH 包中的 likert 函数创建的堆积条形图中，该函数使用 lattice。我的数据是 偶数水平 的李克特量表的答案，
代码按预期工作。
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
| | 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 |
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
当我尝试将我的代码与 奇数级别 一起使用时，我注意到一个奇怪的问题，代表中间答案的百分比被分成两个相等的部分，这不是预期的行为。在中间部分，我们必须看到这两个百分比的总和。如何解决这个问题？
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
| | 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 |
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
偶层数的数据：
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()
## 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))
不久前，我 HH 包中的 likert 函数创建的堆积条形图中，该函数使用 lattice。我的数据是 偶数水平 的李克特量表的答案，
代码按预期工作。
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
| | 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 |
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
| | 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 |
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
偶层数的数据：
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()
## 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))