Closed jwildfire closed 4 years ago
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.
@SRenan This is pretty similar to the mock-up here. Going to work on a PR adding the custom event to the renderer now.
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!
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.
The details for this are almost certainly in one of the excellent js/shiny books from @colinfay
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 addShiny.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
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.
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]
);
});
}
"
Hi @samussiah, awesome, this works. Thank you very much for your help.
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 customdata
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: