diff --git a/R/plot_with_settings.R b/R/plot_with_settings.R index 2a681065..2bf18978 100644 --- a/R/plot_with_settings.R +++ b/R/plot_with_settings.R @@ -242,6 +242,7 @@ plot_with_settings_ui <- function(id) { #' plot_with_settings_srv <- function(id, plot_r, + gg2plotly = TRUE, height = c(600, 200, 2000), width = NULL, show_hide_signal = reactive(TRUE), @@ -296,7 +297,10 @@ plot_with_settings_srv <- function(id, } plot_type <- reactive({ - if (inherits(plot_r(), "ggplot")) { + req(plot_suppress(plot_r())) + if (inherits(plot_r(), "ggplot") && gg2plotly) { + "ggplotly" + } else if (inherits(plot_r(), "ggplot")) { "gg" } else if (inherits(plot_r(), "trellis")) { "trel" @@ -373,17 +377,55 @@ plot_with_settings_srv <- function(id, p_height <- reactive(`if`(!is.null(input$height), input$height, height[1])) p_width <- reactive(`if`(!is.null(input$width), input$width, default_slider_width()[1])) - output$plot_main <- renderPlot( - apply_plot_modifications( - plot_obj = plot_suppress(plot_r()), - plot_type = plot_suppress(plot_type()), - dblclicking = dblclicking, - ranges = ranges - ), - res = get_plot_dpi(), - height = p_height, - width = p_width - ) + + observeEvent(plot_type(), ignoreNULL = TRUE, once = TRUE, { + output$plot_main <- if (identical(plot_type(), "ggplotly")) { + plotly::renderPlotly({ + plotly::event_register( + plotly::layout( + plotly::ggplotly(plot_r(), layerData = 1, height = p_height()), + dragmode = "select" + ), + "plotly_selected" + ) + }) + } else { + renderPlot( + { + apply_plot_modifications( + plot_obj = plot_suppress(plot_r()), + plot_type = plot_suppress(plot_type()), + dblclicking = dblclicking, + ranges = ranges + ) + }, + res = get_plot_dpi(), + height = p_height, + width = p_width + ) + } + }) + + + + plotly_brush <- reactive({ + req(plot_suppress(plot_r())) + # layer_data(plot_r(), 3) + # ggplot_build(plot_r())$plot$data + bbox <- plotly::event_data("plotly_selected") + if (is.null(bbox)) { + return(NULL) + } + list( + mapping = list( + x = rlang::as_label(plot_r()$mapping$x), + y = rlang::as_label(plot_r()$mapping$y) + ), + xmin = min(bbox$x), xmax = max(bbox$x), + ymin = min(bbox$y), ymax = max(bbox$y), + direction = "xy" + ) + }) output$plot_modal <- renderPlot( apply_plot_modifications( @@ -399,17 +441,21 @@ plot_with_settings_srv <- function(id, output$plot_out_main <- renderUI({ req(plot_suppress(plot_r())) - tags$div( - align = graph_align, - plotOutput( - ns("plot_main"), - height = "100%", - brush = `if`(brushing, brushOpts(ns("plot_brush"), resetOnNew = FALSE), NULL), - click = `if`(clicking, clickOpts(ns("plot_click")), NULL), - dblclick = `if`(dblclicking, dblclickOpts(ns("plot_dblclick")), NULL), - hover = `if`(hovering, hoverOpts(ns("plot_hover")), NULL) + if (identical(plot_type(), "ggplotly")) { + plotly::plotlyOutput(ns("plot_main"), height = "100%") + } else { + tags$div( + align = graph_align, + plotOutput( + ns("plot_main"), + height = "100%", + brush = `if`(brushing, brushOpts(ns("plot_brush"), resetOnNew = FALSE), NULL), + click = `if`(clicking, clickOpts(ns("plot_click")), NULL), + dblclick = `if`(dblclicking, dblclickOpts(ns("plot_dblclick")), NULL), + hover = `if`(hovering, hoverOpts(ns("plot_hover")), NULL) + ) ) - ) + } }) output$width_warning <- renderUI({ @@ -500,25 +546,28 @@ plot_with_settings_srv <- function(id, return( list( brush = reactive({ - # refresh brush data on the main plot size change - input$height - input$width - input$plot_brush + if (identical(plot_type(), "ggplotly")) { + plotly_brush() + } else { + input$height + input$width + input$plot_brush + } }), click = reactive({ - # refresh click data on the main plot size change + # # refresh click data on the main plot size change input$height input$width input$plot_click }), dblclick = reactive({ - # refresh double click data on the main plot size change + # # refresh double click data on the main plot size change input$height input$width input$plot_dblclick }), hover = reactive({ - # refresh hover data on the main plot size change + # # refresh hover data on the main plot size change input$height input$width input$plot_hover @@ -603,7 +652,7 @@ type_download_srv <- function(id, plot_reactive, plot_type, plot_w, default_w, p #' x = "AGE", #' y = "BMRKR1" #' ), -#' xmin = 30, xmax = 40, +#' xmin = 30.1, xmax = 40, #' ymin = 0.7, ymax = 10, #' direction = "xy" #' ) diff --git a/man/clean_brushedPoints.Rd b/man/clean_brushedPoints.Rd index 36980fe0..e0bfb12a 100644 --- a/man/clean_brushedPoints.Rd +++ b/man/clean_brushedPoints.Rd @@ -27,7 +27,7 @@ brush <- list( x = "AGE", y = "BMRKR1" ), - xmin = 30, xmax = 40, + xmin = 30.1, xmax = 40, ymin = 0.7, ymax = 10, direction = "xy" ) diff --git a/man/plot_with_settings.Rd b/man/plot_with_settings.Rd index b508a5d1..348827e6 100644 --- a/man/plot_with_settings.Rd +++ b/man/plot_with_settings.Rd @@ -11,6 +11,7 @@ plot_with_settings_ui(id) plot_with_settings_srv( id, plot_r, + gg2plotly = TRUE, height = c(600, 200, 2000), width = NULL, show_hide_signal = reactive(TRUE),