Question

我正在尝试使用 likert 包绘制热表。可以复现以下代码：

library("likert")
data("pisaitems")
title <- "How often do you read these materials because you want to?"
items29 <- pisaitems[,substr(names(pisaitems), 1,5) == 'ST25Q']
names(items29) = c("Magazines", "Comic books", "Fiction", "Non-fiction books", "Newspapers")
l29 <-  likert(items29)
l29s <- likert(summary = l29$results)

plot(l29s, type = 'heat') + ggtitle(title) + theme(legend.position = 'none')

输出

问题

如何绘制第一列“Mean (SD)”白色和粗体文本，而不是灰色，并可能调整绘图边框和项目之间的填充/边距相等（左+右似乎大于顶部和底部填充）？

提前致谢！

Answer 1

热图只是绘制汇总数据框。 likert.heat.plot 函数分配值 -100，因此您在 Mean(SD) 列中获得灰色输出。您可以将其设为零并将第一列设为白色。由于固定函数不接受此参数，因此您可以定义一个新函数并绘制所需的输出。

library("likert")[![enter image description here][1]][1]
data("pisaitems")
title <- "How often do you read these materials because you want to?"
items29 <- pisaitems[,substr(names(pisaitems), 1,5) == 'ST25Q']
names(items29) = c("Magazines", "Comic books", "Fiction", "Non-fiction books", "Newspapers")
l29 <-  likert(items29)
l29s <- likert(summary = l29$results)

lplot = function (likert, low.color = "white", high.color = "blue", 
            text.color = "black", text.size = 4, wrap = 50, ...) 
  {
    if (!is.null(likert$grouping)) {
      stop("heat plots with grouping are not supported.")
    }
    lsum <- summary(likert)
    results = reshape2::melt(likert$results, id.vars = "Item")
    results$variable = as.character(results$variable)
    results$label = paste(format(results$value, digits = 2, drop0trailing = FALSE), 
                          "%", sep = "")
    tmp = data.frame(Item = lsum$Item, variable = rep("Mean (SD)", 
                                                      nrow(lsum)), value = rep(0, nrow(lsum)), label = paste(format(lsum$mean, 
                                                                                                                       digits = 3, drop0trailing = FALSE), " (", format(lsum$sd, 
                                                                                                                                                                        digits = 2, drop0trailing = FALSE), ")", sep = ""), 
                     stringsAsFactors = FALSE)
    results = rbind(tmp, results)
    p = ggplot(results, aes(x = Item, y = variable, fill = value, 
                            label = label)) + scale_y_discrete(limits = c("Mean (SD)", 
                                                                          names(likert$results)[2:ncol(likert$results)])) + geom_tile() + 
      geom_text(size = text.size, colour = text.color) + coord_flip() + 
      scale_fill_gradient2("Percent", low = "white", 
                           mid = low.color, high = high.color, limits = c(0, 
                                                                          100)) + xlab("") + ylab("") + theme(panel.grid.major = element_blank(), 
                                                                                                              panel.grid.minor = element_blank(), axis.ticks = element_blank(), 
                                                                                                              panel.background = element_blank()) + scale_x_discrete(breaks = likert$results$Item
                                                                                                                                                                     #, labels = label_wrap_mod(likert$results$Item, width = wrap)
                                                                                                                                                                     )
    class(p) <- c("likert.heat.plot", class(p))
    return(p)
}


lplot(l29s, type = 'heat') + ggtitle(title) + theme(legend.position = 'none')

您可以编写自己的代码并制作精美的绘图，而不是使用固定函数。

更改likert() 绘图颜色

1 个答案: