在R Shiny中更改d3heatmapOutput（）的高度

Question

我正在使用R的d3heatmap庫構建一個熱圖： https ://cran.r-project.org/web/packages/d3heatmap/d3heatmap.pdf

我希望能夠允許用戶自由地（通過UI）調整d3heatmapOutput()函數中的height =參數。

比較以下兩個代碼片段（只需將它們直接復制/粘貼到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") 。 不幸的是，這些選項都不起作用，這使我想知道我是否忽略了一個更簡單，更優雅的選擇。

Answer 1

在此示例中，您可以使用滑塊控制繪圖的高度。 這個想法是在服務器端渲染地圖，並使用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)