R-Индивидуальная подсказка в сети D3 :: sankeyNetwork

1

Мы создали диаграмму sankey, чтобы показать поток между различными городами через networkD3::sankeyNetwork() в R. Мы получили требование клиента отображать "состояние", соответствующее городу, в подсказке/зависании узла sankey.

В следующем коде мы хотим показать значение состояния на подсказке (наведении) узла

    library(shiny)
    library(networkD3)
    library(shinydashboard)
    value <-  c(12,21,41,12,81)
    source <- c(4,1,5,2,1)
    target <- c(0,0,1,3,3)

    edges2 <- data.frame(cbind(value,source,target))

    names(edges2) <- c("value","source","target")
    indx  <- c(0,1,2,3,4,5)
    ID    <- c('CITY1','CITY2','CITY3','CITY4','CITY5','CITY6')
    State <- c( 'IL','CA','FL','NW','GL','TX')
    nodes <-data.frame(cbind(ID,indx,State))

    ui <- dashboardPage(
      dashboardHeader(
      ),
      dashboardSidebar(disable = TRUE),
      dashboardBody(
        fluidPage(
          sankeyNetworkOutput("simple")
        )
      )
    )

    server <- function(input, output,session) {


      output$simple <- renderSankeyNetwork({
        sankeyNetwork(Links = edges2, Nodes = nodes,
                      Source = "source", Target = "target",
                      Value = "value",  NodeID = "ID" 
                      ,units = " " )
      })
    }
    shinyApp(ui = ui, server = server)

Поскольку пакет networkD3 не предоставляет настраиваемую всплывающую подсказку, предложите, как это можно сделать с помощью javascript или каким-либо другим способом в networkD3::sankeyNetwork().

  • 0
    Не могли бы вы привести воспроизводимый пример?
  • 0
    Воспроизводимый код уже упоминался выше в описании, переменная «State» должна отображаться во всплывающей подсказке. Можете ли вы проверить и предложить какой-либо способ достижения результатов?
Показать ещё 6 комментариев
Теги:
shiny
sankey-diagram
networkd3

1 ответ

2

Вы можете использовать технику, подобную этому ответу "Переполнение стека". Сохраните вывод функции sankeyNetwork, затем добавьте обратно в данные, которые htmlwidgets::onRender, затем используйте htmlwidgets::onRender чтобы добавить JavaScript для изменения текста всплывающей подсказки узлов...

library(shiny)
library(networkD3)
library(shinydashboard)
value <-  c(12,21,41,12,81)
source <- c(4,1,5,2,1)
target <- c(0,0,1,3,3)

edges2 <- data.frame(cbind(value,source,target))

names(edges2) <- c("value","source","target")
indx  <- c(0,1,2,3,4,5)
ID    <- c('CITY1','CITY2','CITY3','CITY4','CITY5','CITY6')
State <- c( 'IL','CA','FL','NW','GL','TX')
nodes <-data.frame(cbind(ID,indx,State))

ui <- dashboardPage(
    dashboardHeader(
    ),
    dashboardSidebar(disable = TRUE),
    dashboardBody(
        fluidPage(
            sankeyNetworkOutput("simple")
        )
    )
)

server <- function(input, output,session) {


    output$simple <- renderSankeyNetwork({
        sn <- sankeyNetwork(Links = edges2, Nodes = nodes,
                      Source = "source", Target = "target",
                      Value = "value",  NodeID = "ID" 
                      ,units = " " )

        # add the states back into the nodes data because sankeyNetwork strips it out
        sn$x$nodes$State <- nodes$State

        # add onRender JavaScript to set the title to the value of 'State' for each node
        sn <- htmlwidgets::onRender(
            sn,
            '
            function(el, x) {
                d3.selectAll(".node").select("title foreignObject body pre")
                .text(function(d) { return d.State; });
            }
            '
        )

        # return the result
        sn
    })
}
shinyApp(ui = ui, server = server)
  • 0
    Спасибо за отличное решение !!. Это сработало именно так, как я хотел, однако я заменил «title foreignObject body pre» на «title», чтобы оно работало.

Ещё вопросы

Сообщество Overcoder
Наверх
Меню