在R和plotly中使用plotly_click更新多个信息框

问题描述

如果您请运行脚本，它会为您提供R中的基本Sankey图表以及可绘制的图表以及数据表.此外，顶部还有三个infoBox.当我单击图中的Sankey线时，我会使用plotly_click在数据表中看到该值.我想要一种功能，当我单击任何Sankey Line时，它会在数据表中选择"pointNumber"列值，然后乘以2并放在第一个信息框中，再乘以3在第二个信息框中，然后在第三个信息框中乘以4，如按扣.谢谢，请帮忙.

If you please run the script, it gives you a basic Sankey Chart in R and plotly and a data table besides. Also, there are three infoBoxes on top. When I click on the Sankey lines in the plot, I see the value in the data table using plotly_click. I want a functionality when I click on any Sankey Line, it picks "pointNumber" Column value in the data table and then multiplies by 2 and put in first infobox, by 3 in second infobox, and multiply by 4 in third infobox as in the snap attached. Thanks and please help.

## app.R ##
library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)

ui <- dashboardPage(
dashboardHeader(title = "Multiple hover"),
dashboardSidebar(
width = 0
),
dashboardBody(

infoBox("Multiply by 2", 2 * 2, icon = icon("credit-card")),
infoBox("Multiply by 3", 2 * 3, icon = icon("credit-card")),
infoBox("Multiply by 4", 2 * 4, icon = icon("credit-card")),
tags$br(),

box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader =
T,
plotlyOutput("sankey_plot")),

box( title = "Case Summary", status = "primary", height = "455",solidHeader
= T,
     dataTableOutput("sankey_table"))
)
)
server <- function(input, output)
{
output$sankey_plot <- renderPlotly({
trace1 <- list(
  domain = list(
    x = c(0, 1),
    y = c(0, 1)
  ),
  link = list(
    label = c("Case1", "Case2", "Case3", "Case4", "Case5", "Case6",
  "Case7"),
    source = c(0, 1, 2, 3, 4, 5, 6, 7),
    target = c(11, 12, 7, 10, 13, 9, 8),
    value = c(5, 6, 2, 4, 10, 6, 2)
  ),
  node = list(label = c("R1", "R2", "R3","R4","R5","R6","R7","Blood
  Test","Check Out","Discuss Results",
                        "MRI Scan", "Registration", "Triage and Assessment",
  "X-RAY")),
  type = "sankey"
  )
  data <- list(trace1)
  p <- plot_ly()
  p <- add_trace(p, domain=trace1$domain, link=trace1$link,
  node=trace1$node, type=trace1$type)
  p
  })
  output$sankey_table <- renderDataTable({
  d <- event_data("plotly_click")
  if(is.null(d))
  {
  print("Hello, Please hover to see the result" )
  } else
  d
  })
  }
  shinyApp(ui, server)

推荐答案

考虑event_data()输出一个数据框，下面的代码访问该特定值pointNumber并呈现动态UI.

Considering event_data() outputs a dataframe, the below code access that particular value pointNumber and renders dynamic UI.

代码:

## app.R ##
library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Multiple hover"),
  dashboardSidebar(
    width = 0
  ),
  dashboardBody(

    uiOutput('box1'),
    tags$br(),

    box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader =
          T,
        plotlyOutput("sankey_plot")),

    box( title = "Case Summary", status = "primary", height = "455",solidHeader
         = T,
         dataTableOutput("sankey_table"))
  )
)
server <- function(input, output)
{
  output$sankey_plot <- renderPlotly({
    trace1 <- list(
      domain = list(
        x = c(0, 1),
        y = c(0, 1)
      ),
      link = list(
        label = c("Case1", "Case2", "Case3", "Case4", "Case5", "Case6",
                  "Case7"),
        source = c(0, 1, 2, 3, 4, 5, 6, 7),
        target = c(11, 12, 7, 10, 13, 9, 8),
        value = c(5, 6, 2, 4, 10, 6, 2)
      ),
      node = list(label = c("R1", "R2", "R3","R4","R5","R6","R7","Blood
                            Test","Check Out","Discuss Results",
                            "MRI Scan", "Registration", "Triage and Assessment",
                            "X-RAY")),
      type = "sankey"
    )
    data <- list(trace1)
    p <- plot_ly()
    p <- add_trace(p, domain=trace1$domain, link=trace1$link,
                   node=trace1$node, type=trace1$type)
    p
  })
  output$sankey_table <- renderDataTable({
    d <- event_data("plotly_click")
    if(is.null(d))
    {
      print("Hello, Please hover to see the result" )
    } else
      d
  })

  output$box1 <- renderUI({
   tagList(

     infoBox("Multiply by 2", event_data("plotly_click")$pointNumber * 2, icon = icon("credit-card")),
     infoBox("Multiply by 3", event_data("plotly_click")$pointNumber * 3, icon = icon("credit-card")),
     infoBox("Multiply by 4", event_data("plotly_click")$pointNumber * 4, icon = icon("credit-card"))
   )


  })

}
shinyApp(ui, server)

屏幕截图:

这篇关于在R和plotly中使用plotly_click更新多个信息框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！