Skip to content

Instantly share code, notes, and snippets.

@davidgohel
Created Oct 16, 2016
Embed
What would you like to do?
library(ggiraph)
library(maps)
shinyServer(function(input, output, session) {
selected_car <- reactive({
if( is.null(input$plot_selected)){
character(0)
} else input$plot_selected
})
output$plot_ <- renderggiraph({
data <- mtcars
data$label <- gsub(pattern = "'", " ", row.names(data) )
data$onclick <- paste0("set_search_val(`", data$label, "`);")
p <- ggplot(aes(x=wt, y=mpg, tooltip = label, data_id = label, onclick = onclick ),data=data) +
geom_point_interactive(size = 3) + theme_minimal()
ggiraph(code = print(p),width = .5,
hover_css = "fill:red;cursor:pointer;",
selection_type = "none",
selected_css = "fill:red;")
})
output$dt_ <- DT::renderDataTable({
mtcars
})
})
// https://plainjs.com/javascript/events/trigger-an-event-11/
function triggerEvent(el, type){
if ('createEvent' in document) {
// modern browsers, IE9+
var e = document.createEvent('HTMLEvents');
e.initEvent(type, false, true);
el.dispatchEvent(e);
} else {
// IE 8
var e = document.createEventObject();
e.eventType = type;
el.fireEvent('on'+e.eventType, e);
}
}
function set_search_val( value ) {
var el = document.querySelector('#DataTables_Table_0_filter > label > input[type="search"]');
el.value = value;
triggerEvent(el, 'keyup');
}
library(ggiraph)
library(htmltools)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
includeScript(path = "set_search_val.js"),
textInput("title", label = "Title"),
div(id = "log")
),
mainPanel(
ggiraphOutput("plot_"),
DT::dataTableOutput("dt_")
)
)
))
@elliotpannaman
Copy link

elliotpannaman commented May 14, 2018

This is great! One question though - having included it in my Shiny Dashboard, it works well until other filters on the page are used, after which the link set by the javascript function seems to be broken. Any idea how to fix this?

Cheers,
Elliot

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment