sankeyNetwork через renderUI исчезает при применении JScode для удаления окна просмотра с помощью htmlwidgets :: onRender () - PullRequest
Новая
       65

sankeyNetwork через renderUI исчезает при применении JScode для удаления окна просмотра с помощью htmlwidgets :: onRender ()

0 голосов
/ 16 октября 2019

У меня есть приложение Shiny, которое создает sankeyNetwork из пакета networkD3, который принимает входные данные для обновления данных, используемых для сети, а также изменяет свой размер в зависимости от количества присутствующих узлов. На прошлой неделе я опубликовал вопрос и получил помощь, необходимую для применения аргумента реактивной высоты.

Ранее я нашел этот вопрос , чтобы решить проблему, при которой вывод был крошечным при просмотре только из Firefox. Я прочитал их страницы с вопросами, и это все еще кажется открытым.

Моя проблема, к которой я обращаюсь, заключается в том, что, когда я соединяю эти два решения, приложение не работает должным образом. В моем реальном приложении, когда я обновляю один из входов, высота обновляется, но данные, используемые для создания диаграммы, совпадают. После повторного обновления ввода диаграмма исчезает и исчезает до тех пор, пока приложение не будет закрыто.

Я воссоздал здесь игрушечный пример. Этот ведет себя немного по-другому в том, что после получения обновленных входных данных данные и размер обновляются (в моем фактическом случае обновляется только размер), но исчезающий акт действительно присутствует. Я не смог воссоздать данные без обновления, но я надеюсь, что исправление для этого решит другую проблему. 

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

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

  uiOutput("diagram_dynamic")
)

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))

  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
    ) %>%
      htmlwidgets::onRender('document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')  
      # commenting out the above line (and the pipe above that) allows the app to work as expected
  })

  output$diagram_dynamic <- renderUI({
      height_val <- as.character(100*nrow(nodes()))
      sankeyNetworkOutput("diagram", height = height_val)
  })

}

shinyApp(ui = ui, server = server)

Удаление вызова htmlwidgets :: onRender () из связанного вопроса позволяет приложению работать так, как ожидается, с обновлением данных и размера на основе входных данных. Оставьте его, и оба обновятся, но после второго переключения диаграмма исчезнет.

1 Ответ

1 голос
/ 26 октября 2019

Попробуйте использовать это ...

htmlwidgets::onRender('function(el) { el.getElementsByTagName("svg")[0].removeAttribute("viewBox") }')

Технически, JS, который вы передаете htmlwidgets::onRender ", должен быть допустимым выражением JavaScript, которое возвращает функцию" в соответствии с документацией(хотя код JS выполняется в любом случае, так что вы видите эффект), и это, кажется, вызывает ошибку «Двойная привязка для диаграммы ID» от Shiny, которая, кажется, и является причиной исчезновения графиков. Вы можете продемонстрировать ту же ошибку / проблему с htmlwidgets::onRender('console.log("test")')

Я также изменил ее, чтобы получать только элементы в узле виджета, чтобы с большей вероятностью получить правильный SVG (например, если у вас более одного SVG настраницы), и я использовал removeAttribute("viewBox") вместо setAttribute("viewBox", ""), что кажется немного более прямым из подхода.

...