Create a custom "participantsSelected" event

[jwildfire]

Fire a custom js event whenever a participant is selected or deselected. The ids for selected participants (N=1 in this case) are saved as chart.participantsSelected, and also passed using a custom data property on the js event object. Note that this object is an array of strings event when N=1.

Note that this approach will be implemented across multiple webcharts renderers where participants are selected including:

• ae-timeline
• safety-outlier-explorer
• paneled-outlier-explorer
• safety-shift-plot

[jwildfire]

A few relevant references for @SRenan:

• https://plot.ly/r/shinyapp-plotly-events/
• https://plotly-r.com/linking-views-with-shiny.html
• https://shiny.rstudio.com/articles/js-events.html
• https://shiny.rstudio.com/articles/communicating-with-js.html

[SRenan]

packages injecting Shiny.onInputChange into their code: rAmCharts, sigmaNet

shinyjs onevent only supports mouse/keyboard events but can maybe be mimicked

[SRenan]

Using plotly and htmlwidgets::onRender we can select a participant on click and set an input in the participant profile module.

    p <- p %>% onRender("
      function(el){
        el.on('plotly_click', function(d){
          selsub = d.points[0].data.key[d.points[0].pointNumber];
          Shiny.onInputChange('patient_js', selsub);
        })
      }
    ")

Although it still requires knowing a pre-specified binding, this is the most flexible option I found so far.

[jwildfire]

@SRenan This is pretty similar to the mock-up here. Going to work on a PR adding the custom event to the renderer now.

[paulinebaur]

Hello everybody,

I am programming an R Shiny App that contains the Hepatic Safety Explorer. Once a participant is clicked, I would like to display some additional plots specifically for the selected patient that I programmed using ggplot and plotly. Thus, I would like to have the ID of a participant that I selected in the hepExplorer widget available in R.

While programming, I stumbled across @SRenan's comment on how to do this with Shiny.onInputChange. I think this would solve my problem, but since I’m new to both Shiny and Java Script, my code does not work yet. Therefore, I hope this is the right place to ask how to use Shiny.onInputChange in combination with the Hepatic Safety Explorer.

A simplified version of my app’s code is below. When clicking the action button on top of the app, a patient ID should be printed into the console. I would be very thankful for any advice you have.

library(shiny)
library(shinyjs)
library(htmlwidgets)
library(shinyWidgets)
library(safetyCharts)
library(dplyr)

##Use mapping from hepExplorer function
mapping <- list(
  measure_col = "PARAM", 
  measure_values = list(
    ALT = "Alanine Aminotransferase (U/L)", 
    AST = "Aspartate Aminotransferase (U/L)", 
    TB = "Bilirubin (umol/L)",
    ALP = "Alkaline Phosphatase (U/L)"
  ), 
  id_col = "USUBJID", 
  value_col = "AVAL", normal_col_low = "A1LO", normal_col_high = "A1HI", 
  studyday_col = "ADY", visit_col = "VISIT", visitn_col = "VISITNUM"
)   

#Functions for creating output and render functions for the HTML widget
#The code is mostly taken from ?htmlwidgets::shinyWidgetOutput
hepOutput <- function(outputId, width = "100%", height = "400px") {
  shinyWidgetOutput(outputId, "hepExplorer", width, height, package = "safetyCharts")
}

renderHep <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  shinyRenderWidget(expr, hepOutput, env, quoted = TRUE)
}

### ui ###
ui = shinyUI(fluidPage(
  useShinyjs(),
  mainPanel(
    #Action Button to test if the addition to the Java Script Code worked
    actionButton("testJsConnection", "Display Patient ID"), 
    #Include Hepatic Safety Explorer Widget
    hepOutput("hepExp")
  ),
))

### server ###
server = function(input, output) {
  #use render_widget from safetyCharts package to render the hepExplorer
  #with example data from safetyData package
  p <-  render_widget("hepExplorer", data = safetyData::adam_adlbc, mapping)
  #code taken from SRenan, however it does not work yet 
  p <- p %>% onRender("
      function(el){
        el.on('plotly_click', function(this){
          selsub = this.chart.participantsSelected[0];
          Shiny.onInputChange('patient_js', selsub);
       })
      }
    ")
  #create output
  output$hepExp <-  renderHep(p)
  #when action button is clicked, the value of input$patients_js will be 
  #printed into the console (this will later be exchanged for some additional plots)
  observeEvent(input$testJsConnection, print("the patient Id is", input$patients_js))
}

### start app ###
shinyApp(ui = ui, server = server)

Thanks again for your help!

[jwildfire]

Hi @paulinebaur - This is something we're thinking of implementing in safetyGraphics later this year - see https://github.com/SafetyGraphics/safetyGraphics/issues/339. We had a prototype working in Shiny way back in v1 of the app, but I can't seem to track it down ...

hep-explorer (and a few other js widgets) already fires a custom "ParticipantsSelected" event whenever a point is clicked, so no updates are needed in hep-explorer. We just need to tell Shiny to listen to that event and take action when it is fired. I don't remember the exact implementation in Shiny though. Pretty sure we want to add Shiny.setInputValue("ParticipantsSelected", event.ids, {priority : "event"}) in the widget ... or maybe make a custom js function for it ... or just call the js inline from server.R.

@xni7 @bzkrouse @pburnsdata Anyone have recent experience with this? If not, @samussiah or I can try to put together a quick reprex based on your code.

[jwildfire]

The details for this are almost certainly in one of the excellent js/shiny books from @colinfay

• https://engineering-shiny.org/index.html
• http://connect.thinkr.fr/js4shinyfieldnotes/

[xni7]

Hi @paulinebaur - This is something we're thinking of implementing in safetyGraphics later this year - see SafetyGraphics/safetyGraphics#339. We had a prototype working in Shiny way back in v1 of the app, but I can't seem to track it down ...

hep-explorer (and a few other js widgets) already fires a custom "ParticipantsSelected" event whenever a point is clicked, so no updates are needed in hep-explorer. We just need to tell Shiny to listen to that event and take action when it is fired. I don't remember the exact implementation in Shiny though. Pretty sure we want to add Shiny.setInputValue("ParticipantsSelected", event.ids, {priority : "event"}) in the widget ... or maybe make a custom js function for it ... or just call the js inline from server.R.

@xni7 @bzkrouse @pburnsdata Anyone have recent experience with this? If not, @samussiah or I can try to put together a quick reprex based on your code.

@jwildfire @paulinebaur Here is a working prototype app that implemented this. In the {patprofile} pkg that @SRenan developed, you can find the source code of Shiny server code

• js snippet https://github.com/Novartis/patprofile/blob/214c9838362cbf4374302ac2f78faa323686bb18/inst/shiny-examples/patprofile/server.R#L2
• linking shift plot js widget with patient profiles (shiny visualizations) https://github.com/Novartis/patprofile/blob/214c9838362cbf4374302ac2f78faa323686bb18/inst/shiny-examples/patprofile/server.R#L308
• linking a generic plotly plot with patient profiles https://github.com/Novartis/patprofile/blob/214c9838362cbf4374302ac2f78faa323686bb18/inst/shiny-examples/patprofile/server.R#L147

[paulinebaur]

Thanks a lot for your responses, @xni7 and @jwildfire . I used the code js snippet and the code of the partprofile package @xni7 provided and it worked:

library(shiny)
library(shinyjs)
library(htmlwidgets)
library(shinyWidgets)
library(safetyCharts)
library(dplyr)
library(safetyexploreR)

jsCode_edish <-  "
function(el, params) {
el.chart.chart.wrap.on('participantsSelected', function(chart) {
console.log('Participant Selected!! You clicked participant: '+chart.participantsSelected)
Shiny.setInputValue('pp_module1-patient_js', chart.participantsSelected[0]);
});
}
"

##Use mapping from hepExplorer function
mapping <- list(
  measure_col = "PARAM",
  measure_values = list(
    ALT = "Alanine Aminotransferase (U/L)",
    AST = "Aspartate Aminotransferase (U/L)",
    TB = "Bilirubin (umol/L)",
    ALP = "Alkaline Phosphatase (U/L)"
  ),
  id_col = "USUBJID",
  value_col = "AVAL", normal_col_low = "A1LO", normal_col_high = "A1HI",
  studyday_col = "ADY", visit_col = "VISIT", visitn_col = "VISITNUM"
)

#Functions for creating output and render functions for the HTML widget
#The code is mostly taken from ?htmlwidgets::shinyWidgetOutput
hepOutput <- function(outputId, width = "100%", height = "400px") {
  shinyWidgetOutput(outputId, "eDISH", width, height, package = "safetyexploreR")
}

renderHep <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  shinyRenderWidget(expr, hepOutput, env, quoted = TRUE)
}

### ui ###
ui = shinyUI(fluidPage(
  useShinyjs(),
  mainPanel(
    #Action Button to test if the addition to the Java Script Code worked
    actionButton("testJsConnection", "Display Patient ID"),
    #Include Hepatic Safety Explorer Widget
    hepOutput("hepExp")
  ),
))

### server ###
server = function(input, output, session) {
  #use render_widget from safetyCharts package to render the hepExplorer
  #with example data from safetyData package
  output$hepExp <-  renderHep({
    render_widget(widgetName = "hepExplorer", data = safetyData::adam_adlbc, mapping) %>%
      onRender(jsCode = jsCode_edish)})
  #when action button is clicked, the value of input$patients_js will be
  #printed into the console (this will later be exchanged for some additional plots)
  observeEvent(input$testJsConnection, {
    print(input[["pp_module1-patient_js"]])
  })
}
### start app ###
shinyApp(ui = ui, server = server)

I have one last question, though: The app above takes the hepatic safety explorer from the safetyexploreR package. If I use the widget from the safetyCharts package by using the following rendering function

hepOutput <- function(outputId, width = "100%", height = "400px") {
  shinyWidgetOutput(outputId, "hepExplorer", width, height, package = "safetyCharts")
}

the hepatic safety explorer widget is still included into the Shiny app, but the participant selection does not work. I could not figure out why this is the case. Do you have an idea, @jwildfire and @xni7 ?

Again, thanks for your help.

[samussiah]

Hi @paulinebaur, {safetyexploreR} and {safetyCharts} do not have the same JavaScript binding for hepexplorer and jsCode_edish was written with safetyexploreR in mind. Here's an updated jsCode_edish that works with both packages:

jsCode_edish <- "
    function(el, params) {
        // Access chart object via property of its containing element.
        const chart = d3.select(el)
            .select('.wc-chart')
            .datum();

        // Listen for 'participantsSelected' event.
        chart.wrap.on('participantsSelected', function(event) {
            console.log(
                'Participant Selected! You clicked participant: ' + event.participantsSelected
            );

            // Update Shiny input.
            Shiny.setInputValue(
                'pp_module1-patient_js',
                event.participantsSelected[0]
            );
        });
    }
"

[paulinebaur]

Hi @samussiah, awesome, this works. Thank you very much for your help.