Shiny 来自networkD3的sankeyNetworkOutput的反应高度

我有一个闪亮的仪表板，显示networkD3包中的sankeyNetwork。我正在服务器上的renderSankeyNetwork函数中创建sankeyNetwork，然后使用sankeyNetworkOutput在ui上调用它。我希望创建的sankeynetwork的高度取决于我创建的高度值

我尝试使用renderUI和uiOutput在服务器上运行sankeyNetworkOutput，但它似乎不起作用。仪表板可以正常工作，但sankeynetwork应该在什么地方都没有。我相信这可能与uiOutput不能很好地与renderSankeyNetwork一起工作这一事实有关

下面是两段代码，它们都应该是正确的reprex。第一个显示了仪表板如何在没有动态高度的情况下工作。后者是我使用renderUI+uiOutput的尝试。我研究了一些其他的方法，但是没有找到任何有用的方法

有什么想法吗？提前谢谢

工作版本：

library(shiny)

ui <- fluidPage(
    selectInput(inputId = "plot",
                label   = "plot",
                choices = c("plota", "plotb")),

    sankeyNetworkOutput("diagram")
    # uiOutput("diagram")
)

server <- function(input, output) {

    dat <- data.frame(plot   = c("plota", "plota", "plotb", "plotb", "plotb"),
                      start  = c("a", "b", "a", "b", "c"),
                      finish = c("x", "x", "y", "y", "z"),
                      count  = c(12, 4, 5, 80, 10),
                      height = c("200px", "200px", "400px", "400px", "400px"))

    temp_dat <- reactive({
        filter(dat, plot == input$plot)
    })

    links <- reactive({
        temp_dat <- temp_dat()
        data.frame(source = temp_dat$start,
                   target = temp_dat$finish,
                   value  = temp_dat$count)
    })

    nodes <- reactive({
        temp_links_1 <- links()
        data.frame(name = c(as.character(temp_links_1$source),
                            as.character(temp_links_1$target))#,
        ) %>%
            unique()
    })

    links2 <- reactive({
        temp_links <- links()
        temp_nodes <- nodes()
        temp_links$IDsource <- match(temp_links$source, temp_nodes$name) - 1
        temp_links$IDtarget <- match(temp_links$target, temp_nodes$name) - 1
        temp_links
    })

    output$diagram <- renderSankeyNetwork({
        sankeyNetwork(
            Links       = links2(),
            Nodes       = nodes(),
            Source      = "IDsource",
            Target      = "IDtarget",
            Value       = "value",
            NodeID      = "name",
            sinksRight  = FALSE,
            fontSize    = 13
        )
    })

    # output$diagram <- renderUI({
    #     temp <- temp_dat()
    #     sankeyNetworkOutput("diagram", height = c(unique(temp$height)[1]))
    # })

}

shinyApp(ui = ui, server = server)

库（闪亮）
ui你就快到了：

您必须为网络和
renderUI
输出定义单独的输出名称，并且必须以字符形式提供
height
参数：

library(shiny)
library(networkD3)
library(dplyr)

ui <- fluidPage(
  selectInput(inputId = "plot",
              label   = "plot",
              choices = c("plota", "plotb")),
  # sankeyNetworkOutput("diagram")
  uiOutput("diagram")
)

server <- function(input, output) {

  dat <- data.frame(plot   = c("plota", "plota", "plotb", "plotb", "plotb"),
                    start  = c("a", "b", "a", "b", "c"),
                    finish = c("x", "x", "y", "y", "z"),
                    count  = c(12, 4, 5, 80, 10),
                    height = c("200px", "200px", "400px", "400px", "400px"))

  temp_dat <- reactive({
    filter(dat, plot == input$plot)
  })

  links <- reactive({
    temp_dat <- req(temp_dat())
    data.frame(source = temp_dat$start,
               target = temp_dat$finish,
               value  = temp_dat$count)
  })

  nodes <- reactive({
    temp_links_1 <- req(links())
    data.frame(name = c(as.character(temp_links_1$source),
                        as.character(temp_links_1$target))#,
    ) %>%
      unique()
  })

  links2 <- reactive({
    temp_links <- req(links())
    temp_nodes <- req(nodes())
    temp_links$IDsource <- match(temp_links$source, temp_nodes$name) - 1
    temp_links$IDtarget <- match(temp_links$target, temp_nodes$name) - 1
    temp_links
  })

  output$mySankeyNetwork <- renderSankeyNetwork({
    sankeyNetwork(
      Links       = links2(),
      Nodes       = nodes(),
      Source      = "IDsource",
      Target      = "IDtarget",
      Value       = "value",
      NodeID      = "name",
      sinksRight  = FALSE,
      fontSize    = 13
    )
  })

  output$diagram <- renderUI({
      temp <- temp_dat()
      sankeyNetworkOutput("mySankeyNetwork", height = as.character(unique(temp$height)[1]))
  })

}

shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（网络3）
图书馆（dplyr）
用户界面
library(shiny)
library(networkD3)
library(dplyr)

ui <- fluidPage(
  selectInput(inputId = "plot",
              label   = "plot",
              choices = c("plota", "plotb")),
  # sankeyNetworkOutput("diagram")
  uiOutput("diagram")
)

server <- function(input, output) {

  dat <- data.frame(plot   = c("plota", "plota", "plotb", "plotb", "plotb"),
                    start  = c("a", "b", "a", "b", "c"),
                    finish = c("x", "x", "y", "y", "z"),
                    count  = c(12, 4, 5, 80, 10),
                    height = c("200px", "200px", "400px", "400px", "400px"))

  temp_dat <- reactive({
    filter(dat, plot == input$plot)
  })

  links <- reactive({
    temp_dat <- req(temp_dat())
    data.frame(source = temp_dat$start,
               target = temp_dat$finish,
               value  = temp_dat$count)
  })

  nodes <- reactive({
    temp_links_1 <- req(links())
    data.frame(name = c(as.character(temp_links_1$source),
                        as.character(temp_links_1$target))#,
    ) %>%
      unique()
  })

  links2 <- reactive({
    temp_links <- req(links())
    temp_nodes <- req(nodes())
    temp_links$IDsource <- match(temp_links$source, temp_nodes$name) - 1
    temp_links$IDtarget <- match(temp_links$target, temp_nodes$name) - 1
    temp_links
  })

  output$mySankeyNetwork <- renderSankeyNetwork({
    sankeyNetwork(
      Links       = links2(),
      Nodes       = nodes(),
      Source      = "IDsource",
      Target      = "IDtarget",
      Value       = "value",
      NodeID      = "name",
      sinksRight  = FALSE,
      fontSize    = 13
    )
  })

  output$diagram <- renderUI({
      temp <- temp_dat()
      sankeyNetworkOutput("mySankeyNetwork", height = as.character(unique(temp$height)[1]))
  })

}

shinyApp(ui = ui, server = server)