rlattice
How to set up labels of stacked bar charts created with lattice in R?
Some time ago I solved to put labels as percentages in stacked bar charts created with the likert function from the HH package, that uses lattice. My data was answers to a Likert-type scale with an even number of levels and the
code works as I expected.
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
| | 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 |
+---+-------------------+-------------------+-------------------+----------------+----------------+----------------+--------------------+
When I tried to use my code with an odd number of levels I noticed an strange issue, the percentages that represents the middle answer are divided into two equal parts, that was not an expected behavior. In the middle section we must see the sum of that two percentages. How to solve this issue?
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
| | 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 |
+---+-------------------+-------------------+----------------------------+----------------+----------------+--------------------+
The data with an even number of levels:
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")
The data with an odd number of levels:
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")
The code:
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()
Solution
## 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))
- Generating Dropdown menu for Plotly charts
- Sum column of rows below which meet a certain criteria
- Importing Excel-tables in R
- Rasterizing a grid of points causes empty raster cells and misalignement between points and raster cells
- R Binance API HMAC SHA256 signed message
- When scaling the plot of ggplot2 the textsize of geom_text() stays the same instead of scaling too
- Can I use geom_text or similar to add group by sum rather than amending original data frame?
- Convert curl code into R via the RCurl package?
- Plotting terra raster with white color set for 0 values
- Color perfect correlation tiles in correlation matrix with ggplot
- Swapping strings or values in grouped data based on condition
- Sum and product over interval in R
- Word cloud comparison for two lists of words
- Turn `magick` object into raw vector
- Should memfrac in terra be adjusted for the number of workers in parallel?
- R parallel inside of function
- Regex pattern to include string while excuding other patterns
- CORS Error when using .page.js, but not .page.server.js to fetch external csv ressource with SvelteKit
- Is there a way to automate generating a table with dplyr?
- Using .keep and .before in dplyr::mutate() While Overwriting a Column Name with the same Name
- Why does converting "year + week number + weekday number" always return January 25 for all weeks and weekdays when using %V?
- Fix legend when using ifelse color fill with ggplot
- ghostscript stubbornly refuses to embed fonts
- Adding leading zeros in the character and numeric mixed column names in R
- marginaleffects::predictions returning closure error
- Fill a column's blank spaces contingent on a second column in R
- Rename function simultaneously in R
- Path diagram in r
- How to calculate the gradient of an n-dimensional array of data in R
- How do I add an alias for magrittr pipe from R in vscode