e_on on tile and secondary plot

[antoine4ucsd]

Hello I am struggling with e_on. My goal is to have a secondary graph to appear on the side of the primary graph when clicking on the tile corresponding to the 'yes' for example this dataframe

df=data.frame(
                tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
                value = c(5, 3, 4, 2, 6, 1)
        )

I can generate the main pie chart

df%>%
        dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
        dplyr::mutate(
                N = sum(n),
                pct = round(n / N, 2),
                lab_pct = str_c(round(pct * 100), "%"),
                lab_n = str_c(n, " / ", N)
        ) %>%
        e_charts(tx_o2.factor) %>%
        e_pie(pct, radius = c("40%", "70%")) %>%
        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
        e_on("click", htmlwidgets::JS("
        function(params) {
          console.log('Clicked on: ', params.name); // Debugging line
          Shiny.setInputValue('clickedSegment', params.name);
        }"))

and my secondary graph could be for example

df%>%
      filter(tx_o2.factor == "yes") %>%
     e_charts(tx_o2.factor) %>%
     e_bar(value)

but only appears when I click on the yes tile of the pie chart.... ?

and ALL in one (not working at all)

reactive_db <- reactive({
        data.frame(
                tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
                value = c(5, 3, 4, 2, 6, 1)
        )
})

ui <- fluidPage(
        sidebarLayout(
                sidebarPanel(),
                mainPanel(
                        echarts4rOutput("mainChart"),
                        uiOutput("secondaryChartUI")
                )
        )
)

server <- function(input, output, session) {
        output$mainChart <- renderEcharts4r({
                reactive_db() %>%
                        dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
                        dplyr::mutate(
                                N = sum(n),
                                pct = round(n / N, 2),
                                lab_pct = str_c(round(pct * 100), "%"),
                                lab_n = str_c(n, " / ", N)
                        ) %>%
                        e_charts(tx_o2.factor) %>%
                        e_pie(pct, radius = c("40%", "70%")) %>%
                        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
                        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
                        e_toolbox_feature(feature = c("saveAsImage")) %>%
                        e_on("click", htmlwidgets::JS("
        function(params) {
          console.log('Clicked on: ', params.name); // Debugging line
          Shiny.setInputValue('clickedSegment', params.name);
        }"))
        })
        observeEvent(input$clickedSegment, {
                if (input$clickedSegment == "yes") {
                        output$secondaryChartUI <- renderUI({
                                echartOutput("secondaryChart")
                        })
                        output$secondaryChart <- renderEcharts4r({
                                reactive_db() %>%
                                        filter(tx_o2.factor == "yes") %>%
                                        e_charts(tx_o2.factor) %>%
                                        e_bar(value)
                        })
                }
        })
}

shinyApp(ui, server)

does that make sense? any suggestion?

[JohnCoene]

Use name and refer to it in e_on, no need to wrap the handler in htmlwidgets::JS

df%>%
        dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
        dplyr::mutate(
                N = sum(n),
                pct = round(n / N, 2),
                lab_pct = str_c(round(pct * 100), "%"),
                lab_n = str_c(n, " / ", N)
        ) %>%
        e_charts(tx_o2.factor) %>%
        e_pie(pct, radius = c("40%", "70%"), name = "pie") %>% # add name
        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
        e_on(list(seriesName = "pie"), # use name
        "function(params) {
          console.log('Clicked on: ', params);
        }")

[antoine4ucsd]

thank you but nothing happen when I click. sorry ...

reactive_db_sari <- reactive({
        data.frame(
                tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
                value = c(5, 3, 4, 2, 6, 1)
        )
})

ui <- fluidPage(
        useShinyjs(),  # Initialize shinyjs
        titlePanel("Oxygen on Admission Analysis"),
        sidebarLayout(
                sidebarPanel(),
                mainPanel(
                        echarts4rOutput("mainChart"),
                        uiOutput("secondaryChartUI")
                )
        )
)

server <- function(input, output, session) {
        output$mainChart <- renderEcharts4r({
                reactive_db_sari() %>% dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
                        dplyr::mutate(
                                N = sum(n),
                                pct = round(n / N, 2),
                                lab_pct = str_c(round(pct * 100), "%"),
                                lab_n = str_c(n, " / ", N)
                        ) %>%
                        e_charts(tx_o2.factor) %>%
                        e_pie(pct, radius = c("40%", "70%"), name = "pie") %>% # add name
                        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
                        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
                        e_on(list(seriesName = "pie"), # use name
                             "function(params) {
          console.log('Clicked on: ', params);
        }")
        })
        output$secondaryChart <- renderEcharts4r({
                reactive_db_sari() %>%
                        filter(tx_o2.factor == "yes") %>%
                        e_charts(tx_o2.factor) %>%
                        e_bar(value)
        })
        observeEvent(input$selectedLegend, {
                showNotification(paste("Selected legend:", input$selectedLegend))  # Debugging line
                if (input$selectedLegend == "yes") {
                        output$secondaryChartUI <- renderUI({
                                echarts4rOutput("secondaryChart")
                        })
                        output$secondaryChart <- renderEcharts4r({
                                reactive_db_sari() %>%
                                        filter(tx_o2.factor == "yes") %>%
                                        e_charts(tx_o2.factor) %>%
                                        e_bar(value)
                        })
                }
        })
}

shinyApp(ui, server)

[JohnCoene]

I removed the setInputValue in my response, you have to add it back in

[antoine4ucsd]

trying now

[antoine4ucsd]

really sorry. anywhere close?

Sample data

reactive_db <- reactive({
        data.frame(
                tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
                value = c(5, 3, 4, 2, 6, 1)
        )
})

ui <- fluidPage(
        useShinyjs(),  # Initialize shinyjs
        titlePanel("Oxygen on Admission Analysis"),
        sidebarLayout(
                sidebarPanel(),
                mainPanel(
                        echarts4rOutput("mainChart"),
                        uiOutput("secondaryChartUI")
                )
        )
)

server <- function(input, output, session) {
        output$mainChart <- renderEcharts4r({
                reactive_dd() %>% dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
                        dplyr::mutate(
                                N = sum(n),
                                pct = round(n / N, 2),
                                lab_pct = str_c(round(pct * 100), "%"),
                                lab_n = str_c(n, " / ", N)
                        ) %>%
                        e_charts(tx_o2.factor) %>%
                        e_pie(pct, radius = c("40%", "70%"), name = "pie") %>% # add name
                        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
                        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
                        e_on(list(seriesName = "pie"), # use name
                             "function(params) {
          console.log('Clicked on: ', params);
          Shiny.setInputValue('clickedSegment', params.name);
        }")
        })
        output$secondaryChart <- renderEcharts4r({
                reactive_db() %>%
                        filter(tx_o2.factor == "yes") %>%
                        e_charts(tx_o2.factor) %>%
                        e_bar(value)
        })
        observeEvent(input$selectedLegend, {
                showNotification(paste("Selected legend:", input$selectedLegend))  # Debugging line
                if (input$selectedLegend == "yes") {
                        output$secondaryChartUI <- renderUI({
                                echarts4rOutput("secondaryChart")
                        })
                        output$secondaryChart <- renderEcharts4r({
                                reactive_db_sari() %>%
                                        filter(tx_o2.factor == "yes") %>%
                                        e_charts(tx_o2.factor) %>%
                                        e_bar(value)
                        })
                }
        })
}

shinyApp(ui, server)

[antoine4ucsd]

just tried the code below but nothing happen

df%>%
        dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
        dplyr::mutate(
                N = sum(n),
                pct = round(n / N, 2),
                lab_pct = str_c(round(pct * 100), "%"),
                lab_n = str_c(n, " / ", N)
        ) %>%
        e_charts(tx_o2.factor) %>%
        e_pie(pct, radius = c("40%", "70%"), name = "myname") %>% # add name
        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
        e_on(list(seriesName = "myname"), # use name
             "function(params) {
          console.log('Clicked on: ', params);
          Shiny.setInputValue('clickedSegment', params.name);
        }")

I would like to see a secondary plot to appear based on the segment I click on. in that case, If I click on 'yes', I would see

df%>%
      filter(tx_o2.factor == "yes") %>%
     e_charts(tx_o2.factor) %>%
     e_bar(value)

and if I click on no,

df%>%
      filter(tx_o2.factor == "yes") %>%
     e_charts(tx_o2.factor) %>%
     e_bar(value)

the final objective is to have it to run in a shiny app... all suggestions are very welcome

[JohnCoene]

Did you check that params.name does exist?, params change from one callback to another.

[antoine4ucsd]

I thought params.name was coming from e_charts(tx_o2.factor) my df can be reproduced as follow

reactive_df <- reactive({
data.frame(
tx_o2tor.factor = c("yes", "no", "yes", "no", "yes", "no"),
value = c(5, 3, 4, 2, 6, 1)
)
})

[antoine4ucsd]

I confirm params.name exists with the following code,

df=        data.frame(
        tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
        value = c(5, 3, 4, 2, 6, 1)
)

df%>%
        dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
        dplyr::mutate(
                N = sum(n),
                pct = round(n / N, 2),
                lab_pct = str_c(round(pct * 100), "%"),
                lab_n = str_c(n, " / ", N)
        ) %>%
        e_charts(tx_o2.factor) %>%
        e_pie(pct, radius = c("40%", "70%"), name = "pie") %>% # add name
        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
        e_on(list(seriesName = "pie"), # use name
             "function(params) {
          console.log('Clicked on: ', params);
          Shiny.setInputValue('clickedSegment', params.name);
        }")

so params.name corresponds to yes or no. the objective is that when one click on yes, a bar plot show up beside the pie chart and a different bar plot appears when click on no.

[JohnCoene]

I cannot run the code you shared.

[antoine4ucsd]

sorry.

would you mind trying

library(shiny)
library(echarts4r)
library(dplyr)
library(shinyjs)
library(stringr)
# Sample data
reactive_db <- reactive({
        data.frame(
                tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
                value = c(5, 3, 4, 2, 6, 1)
        )
})

ui <- fluidPage(
        useShinyjs(),  # Initialize shinyjs
        titlePanel("Oxygen on Admission Analysis"),
        sidebarLayout(
                sidebarPanel(),
                mainPanel(
                        echarts4rOutput("mainChart"),
                        uiOutput("secondaryChartUI")
                )
        )
)

server <- function(input, output, session) {
        output$mainChart <- renderEcharts4r({
                reactive_db() %>% dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
                        dplyr::mutate(
                                N = sum(n),
                                pct = round(n / N, 2),
                                lab_pct = str_c(round(pct * 100), "%"),
                                lab_n = str_c(n, " / ", N)
                        ) %>%
                        e_charts(tx_o2.factor) %>%
                        e_pie(pct, radius = c("40%", "70%"), name = "pie") %>% # add name
        #                 e_labels(formatter = htmlwidgets::JS("
        # function(params) {
        #   return params.name + ': ' + 100 * params.value + '%'
        # }")) %>%
                        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name}")) %>%
        #                 e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        # function(params) {
        #   return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        # }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
                        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {params.name}"), backgroundColor = "rgba(255,255,255,0.7)") %>%
                        e_on(list(seriesName = "pie"), # use name
                             "function(params) {
          console.log('Clicked on: ', params);
          Shiny.setInputValue('clickedSegment', params.name);
        }")
        })
        output$secondaryChart <- renderEcharts4r({
                reactive_db() %>%
                        filter(tx_o2.factor == "yes") %>%
                        e_charts(tx_o2.factor) %>%
                        e_bar(value)
        })
        observeEvent(input$selectedLegend, {
                showNotification(paste("Selected legend:", input$selectedLegend))  # Debugging line
                if (input$selectedLegend == "yes") {
                        output$secondaryChartUI <- renderUI({
                                echarts4rOutput("secondaryChart")
                        })
                        output$secondaryChart <- renderEcharts4r({
                                reactive_db() %>%
                                        filter(tx_o2.factor == "yes") %>%
                                        e_charts(tx_o2.factor) %>%
                                        e_bar(value)
                        })
                }
        })
}

shinyApp(ui, server)

or outside of rshiny

df=        data.frame(
        tx_o2.factor = c("yes", "no", "yes", "no", "yes", "no"),
        value = c(5, 3, 4, 2, 6, 1)
)

df%>%
        dplyr::summarise(n = n(), .by = tx_o2.factor) %>%
        dplyr::mutate(
                N = sum(n),
                pct = round(n / N, 2),
                lab_pct = str_c(round(pct * 100), "%"),
                lab_n = str_c(n, " / ", N)
        ) %>%
        e_charts(tx_o2.factor) %>%
        e_pie(pct, radius = c("40%", "70%"), name = "pie") %>% # add name
        e_labels(formatter = htmlwidgets::JS("
        function(params) {
          return params.name + ': ' + 100 * params.value + '%'
        }")) %>%
        e_tooltip(trigger = "item", formatter = htmlwidgets::JS("
        function(params) {
          return '<strong>' + params.name + '</strong><br /> ' + 100 * params.value + '%'
        }"), backgroundColor = "rgba(255,255,255,0.7)") %>%
        e_on(list(seriesName = "pie"), # use name
             "function(params) {
          console.log('Clicked on: ', params);
          Shiny.setInputValue('clickedSegment', params.name);
        }")

thank you for your patience and support. really appreciated.