Есть ли способ заставить ячейки тепловой карты geom_tile иметь размер c при создании сетки тепловых карт (с использованием facet_wrap)? - PullRequest
4 голосов
/ 05 мая 2020

В моем приложении для оценки качества данных Shiny пользователи загружают наборы данных и могут создавать отчеты с помощью RMarkdown. Один из этих отчетов представляет собой визуальную сводку набора данных, оценивающую каждую переменную набора данных по трем показателям:% соответствия (насколько хорошо данные соответствуют модели данных),% Logi c (дата смерти позже даты рождения?), и% полноты. Каждый пациент в наборе данных принадлежит ГРУППЕ, а показатели сообщаются GROUP. Каждый набор данных включает несколько таблиц данных, поэтому для каждой таблицы данных создается отдельная сетка тепловых карт (на отдельной странице). У одних пользователей в данных много ГРУПП, у других - всего несколько. Точно так же меняется количество переменных в таблице.

Как я могу стандартизировать вид этих многогранных тепловых карт в этих различных обстоятельствах? Я ищу способ указать высоту и ширину в см для каждой ячейки тепловой карты, но не нашел хорошее решение. Два графика ниже иллюстрируют проблему.
1. Фасетная тепловая карта с небольшим количеством групп пациентов в наборе данных (ячейки слишком большие!): Small number of groups resulting in huge cells

Фасетная тепловая карта с большим количеством групп пациентов в наборе данных: Large number of groups and variables resulting in small cells

Использование coord_fixed() не устраняет проблему, как и coord_equal(). Это по-прежнему приводит к большим ячейкам для первого сценария и еще более крошечным для второго. (например, makeWrappedHeatmaps(numGroups = 20, numVars = 5) создаст фасетный набор из 20 тепловых карт, суммирующих показатели для 5 переменных)

library(tidyverse)
library(data.table)

createFakeVariableMetrics <- function(varName, numGroups){
  tibble(GROUP = paste("Group", LETTERS[1:numGroups]), 
         Variable = rep(varName, numGroups),
         Compliant = round(runif(numGroups, 20, 100), 0), 
         Logic = round(runif(numGroups, 0, 100), 0), 
         Complete = round(runif(numGroups, 25, 100), 0) 
         )
}

# example possible variable names
variableNames <- c("PATIENT", "BIRTH_D", "MED_CODE", "DROP_Y", "DX_D", "VIS_D", "DX_CODE", "RS_CODE", "LAB_V")

makeWrappedHeatmaps <- function(numGroups, numVars){
  if (numVars > length(variableNames)) return("Specify a number of variables less than 10")
  varNames <- variableNames[1:numVars]
  dfList <- lapply(varNames, createFakeVariableMetrics, numGroups)
  metricdf <- rbindlist(dfList)
  forHeatmap <- gather(metricdf, c("Compliant", "Logic", "Complete"), key = "Metric", value = "percent")

  ggplot(data = forHeatmap, aes(x = Metric, y = Variable)) +
    geom_tile(aes(fill = percent), colour = "white", size = 0.01) +
    facet_wrap("GROUP") +
    labs(x="",y="") +
    geom_text(aes(label = percent), size = 3) +
    scale_y_discrete(expand=c(0,0))+
    scale_x_discrete(expand=c(0,0), position = "top") +
    theme(
      axis.text.x = element_text(size = 8),
      plot.background = element_blank(),
      axis.ticks.y = element_blank(),
      axis.ticks.x = element_blank(),
      panel.border = element_blank(),
      legend.position = "none")
}

Спасибо!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...