Я пытаюсь построить таблицу нагрева с помощью пакета 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')

Вывод

Preview

Вопрос

Как я могу нарисовать первый столбец «Среднее (SD)» белым и жирным шрифтом вместо серого и потенциально настроить отступ / поле между границей графика и равными элементами (левый + правый кажется больше, чем верхний и нижний отступы) ?

Заранее спасибо!

0
Christopher 10 Май 2021 в 22:46

1 ответ

Лучший ответ

Тепловой график - это просто построение итогового кадра данных. Функция likert.heat.plot присваивает значение -100, поэтому вы получаете серый результат в столбце Среднее (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')

Вместо использования стандартных функций вы можете написать свой собственный код и делать красивые графики.

enter image description here

1
aashish 10 Май 2021 в 20:45