在 R Shiny 中更改 d3heatmapOutput() 的高度

Changing height of d3heatmapOutput() in R Shiny

我正在使用 R 的 d3heatmap 库构建热图:https://cran.r-project.org/web/packages/d3heatmap/d3heatmap.pdf

我希望能够允许用户自由调整(通过 UI)d3heatmapOutput() 函数中的 height = 参数。

比较以下两个代码片段(只是 copy/paste 它们直接进入 R Studio),它们之间的唯一区别是 d3heatmapOutput() 中的 height = 参数的值:

library(d3heatmap)
library(shiny)
ui <- fluidPage(
  h1("A heatmap demo"),
  selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
  checkboxInput("cluster", "Apply clustering"),
  d3heatmapOutput("heatmap", height = "400px")
  )
server <- function(input, output, session) {
  output$heatmap <- renderD3heatmap({
    d3heatmap(
      scale(mtcars),
      colors = input$palette,
      dendrogram = if (input$cluster) "both" else "none"
) })
    }
    shinyApp(ui, server)

VS.

library(d3heatmap)
library(shiny)
ui <- fluidPage(
  h1("A heatmap demo"),
  selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
  checkboxInput("cluster", "Apply clustering"),
  d3heatmapOutput("heatmap", height = "1000px")
  )
server <- function(input, output, session) {
  output$heatmap <- renderD3heatmap({
    d3heatmap(
      scale(mtcars),
      colors = input$palette,
      dendrogram = if (input$cluster) "both" else "none"
) })
    }
    shinyApp(ui, server)

我想让用户自己选择 height = 这个值。但是,因为 "400px" 是一个非数字参数,所以 UI 工具(例如 numericInput() )不起作用。同样,selectInput() 也不起作用,例如:

selectInput("foo", "Bar:", c("400px", "700px", "1000px"))

其中 d3heatmapOutput("heatmap", height = "foo")。不幸的是,这些选项都不起作用,这让我想知道我是否忽略了一个更简单、更优雅的选项。

在此示例中,您可以使用滑块控制绘图的高度。这个想法是在服务器端渲染地图并使用 paste0 函数以像素为单位设置所需的大小。

library(d3heatmap)
library(shiny)
ui <- fluidPage(
  h1("A heatmap demo"),


  sliderInput("pixels", "size", value = 400, min = 100, max = 1000),

  selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
  checkboxInput("cluster", "Apply clustering"),
  uiOutput("dynamic")
)
server <- function(input, output, session) {
  output$heatmap <- renderD3heatmap({
    d3heatmap(
      scale(mtcars),
      colors = input$palette,
      dendrogram = if (input$cluster) "both" else "none"
    ) })

  output$dynamic <- renderUI({

    d3heatmapOutput("heatmap", height = paste0(input$pixels, "px"))
  })

}
shinyApp(ui, server)