如果您运行该脚本,它会为您提供R中的基本Sankey图表和图表以及数据表。此外,顶部有三个infoBoxes。当我单击绘图中的Sankey线时,我使用plotly_click查看数据表中的值。当我点击任何Sankey Line时,我想要一个功能,它选择" pointNumber"数据表中的列值然后乘以2并放入第一个信息框,第二个信息框放置3,并在第三个信息框中乘以4,如同附加的快照一样。谢谢,请帮助。
## 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)
答案 0 :(得分:0)
考虑event_data()
输出数据框,下面的代码访问该特定值pointNumber
并呈现动态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)
截图: