4

在我的 Shiny 数据质量评估应用程序中，用户上传数据集并可以使用 RMarkdown 生成报告。其中一份报告是数据集的可视化摘要，根据三个指标对数据集的每个变量进行评分：合规性百分比（数据与数据模型的匹配程度）、逻辑百分比（死亡日期是否在出生日期之后？）和完整性百分比. 数据集中的每个患者都属于一个 GROUP，指标由 GROUP 报告。每个数据集都包含多个数据表，因此会为每个数据表创建一个单独的热图网格（在单独的页面上）。一些用户的数据中有很多 GROUP，而另一些用户只有几个。同样，表中的变量数量也不同。

如何在这些不同情况下标准化这些多面热图的外观？我正在寻找一种方法来指定每个热图单元的高度和宽度（以厘米为单位），但还没有找到一个好的解决方案。下面的两张图说明了这个问题。
1. 数据集中有少量患者组的分面热图（单元格太大！）： 少数群体导致巨大的细胞

  1. 数据集中具有大量患者组的分面热图： 大量组和变量导致小细胞

使用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")
}

谢谢！

4

0 回答 0