以下のスクリプトを実行すると、Rを使用して、インフォボックス内のグループ化された棒グラフの表示がプロットされ、光沢が

Question

、私は2つのグループ化された棒グラフとinfoBoxを取得します。赤いグループのバーをクリックすると、上の情報ボックスにあるそのグループのすべてのバーの合計を取得する必要があります。グリーングループの場合も同様です。つまり、Infoboxには赤と緑の2つの値しかありません。私は脚本を持っていて、スナップもあげます。

library(shiny) 
library(shinydashboard) 
library(ggplot2) 
library(plotly) 

ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"), 
dashboardSidebar(
width = 0 
), 
dashboardBody(
fluidRow(
column(10, 
     uiOutput('box1'), 
     tags$br()), 
    tags$br(), 
    column(10, 


     box(title = "Case Analyses",status = "primary",solidHeader = 
    T,width = 1050,height = 452, 
      plotlyOutput("case_hist")) 
)) 
) 
) 
    server <- function(input, output) 
    { 
    output$case_hist <- renderPlotly(
    { 

    iris$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9)) 
    iris$ID <- factor(1:nrow(iris)) 
    gg <- ggplot(iris, aes(x=ID, y=Sepal.Length, fill=iris_limits)) + 
    geom_bar(stat="identity", position="dodge") + 
    facet_wrap(~iris_limits, scales="free_x", labeller=label_both) + 
    theme_minimal() + xlab("") + ylab("Sepal Length") + 
    theme(axis.text.x=element_blank()) 
    ggplotly(gg) 
    } 
) 
    output$box1 <- renderUI({ 
    tagList(
    infoBox("Total Cases", "a" , icon = icon("fa fa-briefcase")) 
) 
    }) 
    } 
    shinyApp(ui, server) 

Answer 1

あなたはevent_data("plotly_click")を使用して、このような何かを行うことができます。プロットがクリックされたときにカウントが計算できるように

library(shiny) 
library(shinydashboard) 
library(ggplot2) 
library(plotly) 

ui <- dashboardPage(
    dashboardHeader(title = "Sankey Chart"), 
    dashboardSidebar(
    width = 0 
), 
    dashboardBody(
    fluidRow(
     column(10, 
      uiOutput('box1'), 
      tags$br()), 
     tags$br(), 
     column(10, 


      box(title = "Case Analyses",status = "primary",solidHeader = 
        T,width = 1050,height = 452, 
       plotlyOutput("case_hist")) 
    )) 
) 
) 
server <- function(input, output) 
{ 
    dat <- reactiveValues(Val = iris) 

    output$case_hist <- renderPlotly(
    { 
     dat$Val$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9)) 
     dat$Val$ID <- factor(1:nrow(iris)) 
     iris$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9)) 
     iris$ID <- factor(1:nrow(iris)) 
     gg <- ggplot(iris, aes(x=ID, y=Sepal.Length, fill=iris_limits)) + 
     geom_bar(stat="identity", position="dodge") + 
     facet_wrap(~iris_limits, scales="free_x", labeller=label_both) + 
     theme_minimal() + xlab("") + ylab("Sepal Length") + 
     theme(axis.text.x=element_blank()) 
     ggplotly(gg) 
    } 
) 

    output$box1 <- renderUI({ 
    d <- event_data("plotly_click") 
    tc <- c() 
    if(!is.null(d)){ 

     if(d$curveNumber == 0)#pink click 
     { 
     tc <- sum(dat$Val$Sepal.Length[which(dat$Val$iris_limits == "(3,6]")]) 


     }else#green click 
     { 
     tc <- sum(dat$Val$Sepal.Length[which(dat$Val$iris_limits == "(6,9]")]) 
     } 
    } 
     tagList(
     infoBox("Total Cases", tc , icon = icon("fa fa-briefcase")) 
    ) 


    }) 
} 
shinyApp(ui, server) 

HereIはreactiveValueを使用しています。他のオプションは、データを保存する代わりにreactiveValueの内部に値を保存することです。このような何か：

library(shiny) 
library(shinydashboard) 
library(ggplot2) 
library(plotly) 

ui <- dashboardPage(
    dashboardHeader(title = "Sankey Chart"), 
    dashboardSidebar(
    width = 0 
), 
    dashboardBody(
    fluidRow(
     column(10, 
      uiOutput('box1'), 
      tags$br()), 
     tags$br(), 
     column(10, 


      box(title = "Case Analyses",status = "primary",solidHeader = 
        T,width = 1050,height = 452, 
       plotlyOutput("case_hist")) 
    )) 
) 
) 
server <- function(input, output) 
{ 
    dat <- reactiveValues(Val1 = c(), Val2 = c()) 

    output$case_hist <- renderPlotly(
    { 

     iris$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9)) 
     iris$ID <- factor(1:nrow(iris)) 

     dat$Val1 <- sum(iris$Sepal.Length[which(iris$iris_limits == "(3,6]")]) 
     dat$Val2 <- sum(iris$Sepal.Length[which(iris$iris_limits == "(6,9]")]) 
     gg <- ggplot(iris, aes(x=ID, y=Sepal.Length, fill=iris_limits)) + 
     geom_bar(stat="identity", position="dodge") + 
     facet_wrap(~iris_limits, scales="free_x", labeller=label_both) + 
     theme_minimal() + xlab("") + ylab("Sepal Length") + 
     theme(axis.text.x=element_blank()) 
     ggplotly(gg) 
    } 
) 

    output$box1 <- renderUI({ 
    d <- event_data("plotly_click") 
    tc <- c() 
    if(!is.null(d)){ 

     if(d$curveNumber == 0)#pink click 
     { 
     tc <- dat$Val1 


     }else#green click 
     { 
     tc <- dat$Val2 
     } 
    } 
     tagList(
     infoBox("Total Cases", tc , icon = icon("fa fa-briefcase")) 
    ) 


    }) 
} 
shinyApp(ui, server)