| 10 | 11 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,376 @@ |
| 1 |
+library(shiny) |
|
| 2 |
+library(datamods) |
|
| 3 |
+library(shinyWidgets) |
|
| 4 |
+library(DT) |
|
| 5 |
+library(ggplot2) |
|
| 6 |
+ |
|
| 7 |
+.modal_warning_data <- function() {
|
|
| 8 |
+ confirmSweetAlert( |
|
| 9 |
+ inputId = "data_override_warn", |
|
| 10 |
+ title = "Warning", |
|
| 11 |
+ text = paste( |
|
| 12 |
+ "Importing another data set will override the current one.", |
|
| 13 |
+ "Unsaved plots will be lost. Are you sure?" |
|
| 14 |
+ ), |
|
| 15 |
+ type = "warning", |
|
| 16 |
+ btn_labels = c("No", "Yes")
|
|
| 17 |
+ ) |
|
| 18 |
+} |
|
| 19 |
+ |
|
| 20 |
+.save_plot_alert <- function() {
|
|
| 21 |
+ |
|
| 22 |
+} |
|
| 23 |
+ |
|
| 24 |
+server <- shinyServer(function(input, output, session) {
|
|
| 25 |
+ values <- reactiveValues( |
|
| 26 |
+ loaded_data = NULL, |
|
| 27 |
+ new_data = NULL, |
|
| 28 |
+ plotted = NULL |
|
| 29 |
+ ) |
|
| 30 |
+ imported_env <- import_globalenv_server("global_env_input")
|
|
| 31 |
+ imported_file <- import_file_server("file_input",
|
|
| 32 |
+ trigger_return = "button", |
|
| 33 |
+ return_class = "data.table" |
|
| 34 |
+ ) |
|
| 35 |
+ observeEvent(input$data_override_warn, {
|
|
| 36 |
+ if (isTRUE(input$data_override_warn)) {
|
|
| 37 |
+ values$loaded_data <- values$new_data |
|
| 38 |
+ sendSweetAlert( |
|
| 39 |
+ title = "Success", |
|
| 40 |
+ text = "Data changed", |
|
| 41 |
+ type = "success" |
|
| 42 |
+ ) |
|
| 43 |
+ } |
|
| 44 |
+ closeSweetAlert() |
|
| 45 |
+ }) |
|
| 46 |
+ observeEvent(imported_env$data(), {
|
|
| 47 |
+ values$new_data <- imported_env$data() |
|
| 48 |
+ if (!is.null(values$loaded_data)) {
|
|
| 49 |
+ .modal_warning_data() |
|
| 50 |
+ } else {
|
|
| 51 |
+ values$loaded_data <- values$new_data |
|
| 52 |
+ sendSweetAlert( |
|
| 53 |
+ title = "Success", |
|
| 54 |
+ text = "Data changed", |
|
| 55 |
+ type = "success" |
|
| 56 |
+ ) |
|
| 57 |
+ } |
|
| 58 |
+ }) |
|
| 59 |
+ observeEvent(imported_file$data(), {
|
|
| 60 |
+ values$new_data <- imported_file$data() |
|
| 61 |
+ if (!is.null(values$loaded_data)) {
|
|
| 62 |
+ .modal_warning_data() |
|
| 63 |
+ } else {
|
|
| 64 |
+ values$loaded_data <- values$new_data |
|
| 65 |
+ sendSweetAlert( |
|
| 66 |
+ title = "Success", |
|
| 67 |
+ text = "Data changed", |
|
| 68 |
+ type = "success" |
|
| 69 |
+ ) |
|
| 70 |
+ } |
|
| 71 |
+ }) |
|
| 72 |
+ output$loaded_data <- renderDT({
|
|
| 73 |
+ datatable(values$loaded_data, |
|
| 74 |
+ options = list( |
|
| 75 |
+ autoWidth = TRUE, |
|
| 76 |
+ class = "stripe", |
|
| 77 |
+ scrollX = TRUE |
|
| 78 |
+ ), |
|
| 79 |
+ filter = "top" |
|
| 80 |
+ ) |
|
| 81 |
+ }) |
|
| 82 |
+ observeEvent(input$geom, {
|
|
| 83 |
+ function_name <- paste0("geom_", input$geom)
|
|
| 84 |
+ values$main_geom <- rlang::as_function(function_name) |
|
| 85 |
+ }) |
|
| 86 |
+ observeEvent(input$theme, {
|
|
| 87 |
+ fun_name <- paste0("theme_", input$theme)
|
|
| 88 |
+ values$main_theme <- rlang::as_function(fun_name) |
|
| 89 |
+ }) |
|
| 90 |
+ observeEvent(input$clear_color, {
|
|
| 91 |
+ updatePickerInput( |
|
| 92 |
+ session = session, |
|
| 93 |
+ inputId = "color", |
|
| 94 |
+ selected = "" |
|
| 95 |
+ ) |
|
| 96 |
+ }) |
|
| 97 |
+ observeEvent(input$clear_fill, {
|
|
| 98 |
+ updatePickerInput( |
|
| 99 |
+ session = session, |
|
| 100 |
+ inputId = "fill", |
|
| 101 |
+ selected = "" |
|
| 102 |
+ ) |
|
| 103 |
+ }) |
|
| 104 |
+ observeEvent(c( |
|
| 105 |
+ values$loaded_data, |
|
| 106 |
+ input$plot_x, |
|
| 107 |
+ input$plot_y, |
|
| 108 |
+ values$main_geom, |
|
| 109 |
+ input$color, |
|
| 110 |
+ input$fill, |
|
| 111 |
+ input$alpha, |
|
| 112 |
+ values$main_theme, |
|
| 113 |
+ input$plot_title, |
|
| 114 |
+ input$x_lab, |
|
| 115 |
+ input$y_lab |
|
| 116 |
+ ), {
|
|
| 117 |
+ req(values$loaded_data, input$plot_x, input$plot_y) |
|
| 118 |
+ color_aes <- if (input$color == "") {
|
|
| 119 |
+ NULL |
|
| 120 |
+ } else {
|
|
| 121 |
+ rlang::expr(.data[[input$color]]) |
|
| 122 |
+ } |
|
| 123 |
+ fill_aes <- if (input$fill == "") {
|
|
| 124 |
+ NULL |
|
| 125 |
+ } else {
|
|
| 126 |
+ rlang::expr(.data[[input$fill]]) |
|
| 127 |
+ } |
|
| 128 |
+ alpha_aes <- if (input$alpha == "") {
|
|
| 129 |
+ NULL |
|
| 130 |
+ } else {
|
|
| 131 |
+ rlang::expr(.data[[input$alpha]]) |
|
| 132 |
+ } |
|
| 133 |
+ base_plot <- ggplot( |
|
| 134 |
+ data = values$loaded_data, |
|
| 135 |
+ mapping = aes( |
|
| 136 |
+ x = .data[[input$plot_x]], |
|
| 137 |
+ y = .data[[input$plot_y]], |
|
| 138 |
+ color = eval(color_aes), |
|
| 139 |
+ fill = eval(fill_aes), |
|
| 140 |
+ alpha = eval(alpha_aes) |
|
| 141 |
+ ) |
|
| 142 |
+ ) |
|
| 143 |
+ values$plotted <- base_plot + |
|
| 144 |
+ values$main_geom() + |
|
| 145 |
+ values$main_theme() + |
|
| 146 |
+ labs( |
|
| 147 |
+ title = input$plot_title, x = input$x_lab, y = input$y_lab, |
|
| 148 |
+ color = input$color, fill = input$fill, alpha = input$alpha |
|
| 149 |
+ ) |
|
| 150 |
+ }) |
|
| 151 |
+ observeEvent(c(input$facet_1, input$facet_2), {
|
|
| 152 |
+ if (!is.null(values$plotted)) {
|
|
| 153 |
+ non_null1 <- input$facet_1 != "" |
|
| 154 |
+ non_null2 <- input$facet_2 != "" |
|
| 155 |
+ if (non_null1 & non_null2) {
|
|
| 156 |
+ values$plotted <- values$plotted + |
|
| 157 |
+ facet_grid(get(input$facet_1) ~ get(input$facet_2)) |
|
| 158 |
+ } else if (non_null1) {
|
|
| 159 |
+ values$plotted <- values$plotted + |
|
| 160 |
+ facet_wrap(~ get(input$facet_1)) |
|
| 161 |
+ } else if (non_null2) {
|
|
| 162 |
+ values$plotted <- values$plotted + |
|
| 163 |
+ facet_wrap(~ get(input$facet_2)) |
|
| 164 |
+ } |
|
| 165 |
+ } |
|
| 166 |
+ }) |
|
| 167 |
+ output$plotted <- renderPlot({
|
|
| 168 |
+ values$plotted |
|
| 169 |
+ }) |
|
| 170 |
+ output$plot_tab <- renderUI({
|
|
| 171 |
+ plot_sidebar <- sidebarPanel( |
|
| 172 |
+ pickerInput( |
|
| 173 |
+ inputId = "plot_x", |
|
| 174 |
+ label = "Plot on x axis", |
|
| 175 |
+ choices = colnames(values$loaded_data), |
|
| 176 |
+ options = list( |
|
| 177 |
+ `live-search` = TRUE, |
|
| 178 |
+ title = "Select a column" |
|
| 179 |
+ ) |
|
| 180 |
+ ), |
|
| 181 |
+ pickerInput( |
|
| 182 |
+ inputId = "plot_y", |
|
| 183 |
+ label = "Plot on y axis", |
|
| 184 |
+ choices = colnames(values$loaded_data), |
|
| 185 |
+ options = list( |
|
| 186 |
+ `live-search` = TRUE, |
|
| 187 |
+ title = "Select a column" |
|
| 188 |
+ ) |
|
| 189 |
+ ), |
|
| 190 |
+ pickerInput( |
|
| 191 |
+ inputId = "geom", |
|
| 192 |
+ label = "Geom type", |
|
| 193 |
+ choices = c("point", "line", "col")
|
|
| 194 |
+ ), |
|
| 195 |
+ span("Color by"),
|
|
| 196 |
+ fluidRow( |
|
| 197 |
+ column( |
|
| 198 |
+ width = 10, |
|
| 199 |
+ pickerInput( |
|
| 200 |
+ inputId = "color", |
|
| 201 |
+ label = "", |
|
| 202 |
+ choices = colnames(values$loaded_data), |
|
| 203 |
+ options = list( |
|
| 204 |
+ `live-search` = TRUE, |
|
| 205 |
+ title = "Select a column" |
|
| 206 |
+ ) |
|
| 207 |
+ ) |
|
| 208 |
+ ), |
|
| 209 |
+ column( |
|
| 210 |
+ width = 2, |
|
| 211 |
+ class = "align-self-center", |
|
| 212 |
+ actionLink( |
|
| 213 |
+ inputId = "clear_color", label = "", |
|
| 214 |
+ icon = icon(name = "times-circle") |
|
| 215 |
+ ) |
|
| 216 |
+ ) |
|
| 217 |
+ ), |
|
| 218 |
+ span("Fill by"),
|
|
| 219 |
+ fluidRow( |
|
| 220 |
+ column( |
|
| 221 |
+ width = 10, |
|
| 222 |
+ pickerInput( |
|
| 223 |
+ inputId = "fill", |
|
| 224 |
+ label = "", |
|
| 225 |
+ choices = colnames(values$loaded_data), |
|
| 226 |
+ options = list( |
|
| 227 |
+ `live-search` = TRUE, |
|
| 228 |
+ title = "Select a column" |
|
| 229 |
+ ) |
|
| 230 |
+ ) |
|
| 231 |
+ ), |
|
| 232 |
+ column( |
|
| 233 |
+ width = 2, |
|
| 234 |
+ class = "align-self-center", |
|
| 235 |
+ actionLink( |
|
| 236 |
+ inputId = "clear_fill", label = "", |
|
| 237 |
+ icon = icon(name = "times-circle") |
|
| 238 |
+ ) |
|
| 239 |
+ ) |
|
| 240 |
+ ), |
|
| 241 |
+ span("Alpha by"),
|
|
| 242 |
+ fluidRow( |
|
| 243 |
+ column( |
|
| 244 |
+ width = 10, |
|
| 245 |
+ pickerInput( |
|
| 246 |
+ inputId = "alpha", |
|
| 247 |
+ label = "", |
|
| 248 |
+ choices = colnames(values$loaded_data), |
|
| 249 |
+ options = list( |
|
| 250 |
+ `live-search` = TRUE, |
|
| 251 |
+ title = "Select a column" |
|
| 252 |
+ ) |
|
| 253 |
+ ) |
|
| 254 |
+ ), |
|
| 255 |
+ column( |
|
| 256 |
+ width = 2, |
|
| 257 |
+ class = "align-self-center", |
|
| 258 |
+ actionLink( |
|
| 259 |
+ inputId = "clear_alpha", label = "", |
|
| 260 |
+ icon = icon(name = "times-circle") |
|
| 261 |
+ ) |
|
| 262 |
+ ) |
|
| 263 |
+ ), |
|
| 264 |
+ pickerInput( |
|
| 265 |
+ inputId = "theme", |
|
| 266 |
+ label = "Theme", |
|
| 267 |
+ choices = c( |
|
| 268 |
+ "classic", "grey", "bw", "linedraw", "light", |
|
| 269 |
+ "dark", "minimal", "void" |
|
| 270 |
+ ) |
|
| 271 |
+ ), |
|
| 272 |
+ span("Faceting"),
|
|
| 273 |
+ fluidRow( |
|
| 274 |
+ column( |
|
| 275 |
+ width = 6, |
|
| 276 |
+ pickerInput( |
|
| 277 |
+ inputId = "facet_1", |
|
| 278 |
+ label = "", |
|
| 279 |
+ choices = colnames(values$loaded_data), |
|
| 280 |
+ options = list( |
|
| 281 |
+ `live-search` = TRUE, |
|
| 282 |
+ title = "Select a column" |
|
| 283 |
+ ) |
|
| 284 |
+ ) |
|
| 285 |
+ ), |
|
| 286 |
+ column( |
|
| 287 |
+ width = 6, |
|
| 288 |
+ pickerInput( |
|
| 289 |
+ inputId = "facet_2", |
|
| 290 |
+ label = "", |
|
| 291 |
+ choices = colnames(values$loaded_data), |
|
| 292 |
+ options = list( |
|
| 293 |
+ `live-search` = TRUE, |
|
| 294 |
+ title = "Select a column" |
|
| 295 |
+ ) |
|
| 296 |
+ ) |
|
| 297 |
+ ) |
|
| 298 |
+ ), |
|
| 299 |
+ textInput("plot_title", label = "Plot title"),
|
|
| 300 |
+ textInput("x_lab", label = "X axis title"),
|
|
| 301 |
+ textInput("y_lab", label = "Y axis title"),
|
|
| 302 |
+ fluidRow( |
|
| 303 |
+ column( |
|
| 304 |
+ width = 12, |
|
| 305 |
+ dropdownButton( |
|
| 306 |
+ pickerInput("device", "Device",
|
|
| 307 |
+ choices = c( |
|
| 308 |
+ "pdf", "jpeg", "tiff", "png", |
|
| 309 |
+ "bmp", "svg", "eps", "ps", "tex" |
|
| 310 |
+ ) |
|
| 311 |
+ ), |
|
| 312 |
+ numericInputIcon("plot_file_width",
|
|
| 313 |
+ label = "Width", |
|
| 314 |
+ value = 8, |
|
| 315 |
+ min = 1, icon = icon("arrows-alt-h")
|
|
| 316 |
+ ), |
|
| 317 |
+ numericInputIcon("plot_file_height",
|
|
| 318 |
+ label = "Height", |
|
| 319 |
+ value = 8, |
|
| 320 |
+ min = 1, icon = icon("arrows-alt-v")
|
|
| 321 |
+ ), |
|
| 322 |
+ pickerInput("units", "Units",
|
|
| 323 |
+ choices = c("", "in", "cm", "mm", "px")
|
|
| 324 |
+ ), |
|
| 325 |
+ numericInputIcon("plot_file_res",
|
|
| 326 |
+ label = "Resolution (dpi)", |
|
| 327 |
+ value = 300, |
|
| 328 |
+ min = 72, icon = icon("desktop")
|
|
| 329 |
+ ), |
|
| 330 |
+ downloadButton("save_plot",
|
|
| 331 |
+ label = "Save", |
|
| 332 |
+ icon = NULL |
|
| 333 |
+ ), |
|
| 334 |
+ circle = FALSE, |
|
| 335 |
+ status = "default", |
|
| 336 |
+ icon = icon("download")
|
|
| 337 |
+ ), |
|
| 338 |
+ align = "center" |
|
| 339 |
+ ) |
|
| 340 |
+ ) |
|
| 341 |
+ ) |
|
| 342 |
+ plot_main <- mainPanel( |
|
| 343 |
+ plotOutput("plotted", height = "100%")
|
|
| 344 |
+ ) |
|
| 345 |
+ sidebarLayout( |
|
| 346 |
+ plot_sidebar, |
|
| 347 |
+ plot_main, |
|
| 348 |
+ position = "right" |
|
| 349 |
+ ) |
|
| 350 |
+ }) |
|
| 351 |
+ output$save_plot <- downloadHandler( |
|
| 352 |
+ filename = function() {
|
|
| 353 |
+ paste0(lubridate::today(), "_output-plot.", input$device) |
|
| 354 |
+ }, |
|
| 355 |
+ content = function(file) {
|
|
| 356 |
+ if (input$units == "") {
|
|
| 357 |
+ ggsave( |
|
| 358 |
+ plot = values$plotted, filename = file, |
|
| 359 |
+ width = input$plot_file_width, |
|
| 360 |
+ height = input$plot_file_height, |
|
| 361 |
+ dpi = input$plot_file_res, |
|
| 362 |
+ device = input$device |
|
| 363 |
+ ) |
|
| 364 |
+ } else {
|
|
| 365 |
+ ggsave( |
|
| 366 |
+ plot = values$plotted, filename = file, |
|
| 367 |
+ width = input$plot_file_width, |
|
| 368 |
+ height = input$plot_file_height, |
|
| 369 |
+ dpi = input$plot_file_res, |
|
| 370 |
+ device = input$device, |
|
| 371 |
+ units = input$units |
|
| 372 |
+ ) |
|
| 373 |
+ } |
|
| 374 |
+ } |
|
| 375 |
+ ) |
|
| 376 |
+}) |
| 0 | 377 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,63 @@ |
| 1 |
+library(shiny) |
|
| 2 |
+library(shinyWidgets) |
|
| 3 |
+library(datamods) |
|
| 4 |
+library(bslib) |
|
| 5 |
+library(DT) |
|
| 6 |
+ |
|
| 7 |
+# Define UI for application that draws a histogram |
|
| 8 |
+ui <- shinyUI(fluidPage( |
|
| 9 |
+ useSweetAlert(), |
|
| 10 |
+ ### --- Top level navbar |
|
| 11 |
+ navbarPage( |
|
| 12 |
+ "NGSdataExplorer", |
|
| 13 |
+ theme = bs_theme( |
|
| 14 |
+ bootswatch = "cosmo", |
|
| 15 |
+ primary = "#23687A", |
|
| 16 |
+ version = 4, |
|
| 17 |
+ "navbar-bg" = "#23687A" |
|
| 18 |
+ ), |
|
| 19 |
+ collapsible = TRUE, |
|
| 20 |
+ ### --- First nav element |
|
| 21 |
+ tabPanel("Home", {
|
|
| 22 |
+ ### --- Lateral bar + tabs |
|
| 23 |
+ navlistPanel( |
|
| 24 |
+ "Load data", |
|
| 25 |
+ tabPanel( |
|
| 26 |
+ "From R environment", |
|
| 27 |
+ fluidRow( |
|
| 28 |
+ column( |
|
| 29 |
+ width = 12, |
|
| 30 |
+ import_globalenv_ui("global_env_input")
|
|
| 31 |
+ ) |
|
| 32 |
+ ) |
|
| 33 |
+ ), |
|
| 34 |
+ tabPanel( |
|
| 35 |
+ "From file", |
|
| 36 |
+ fluidRow( |
|
| 37 |
+ column( |
|
| 38 |
+ width = 12, |
|
| 39 |
+ import_file_ui("file_input")
|
|
| 40 |
+ ) |
|
| 41 |
+ ) |
|
| 42 |
+ ) |
|
| 43 |
+ ) |
|
| 44 |
+ }), |
|
| 45 |
+ ### --- Second nav element |
|
| 46 |
+ tabPanel( |
|
| 47 |
+ "Explore", |
|
| 48 |
+ navs_pill( |
|
| 49 |
+ id = "explore_pills", |
|
| 50 |
+ nav( |
|
| 51 |
+ title = "Explore loaded data", |
|
| 52 |
+ DTOutput("loaded_data"),
|
|
| 53 |
+ class = "p-3 border rounded" |
|
| 54 |
+ ), |
|
| 55 |
+ nav( |
|
| 56 |
+ title = "Plotting", |
|
| 57 |
+ class = "p-3 border rounded", |
|
| 58 |
+ uiOutput("plot_tab")
|
|
| 59 |
+ ) |
|
| 60 |
+ ) |
|
| 61 |
+ ) |
|
| 62 |
+ ) |
|
| 63 |
+)) |
| ... | ... |
@@ -250,3 +250,26 @@ unzip_file_system <- function(zipfile, name) {
|
| 250 | 250 |
root_folder <- gsub('"', "", gsub("\\\\", "/", root_folder))
|
| 251 | 251 |
root_folder |
| 252 | 252 |
} |
| 253 |
+ |
|
| 254 |
+ |
|
| 255 |
+#' Launch the shiny application NGSdataExplorer. |
|
| 256 |
+#' |
|
| 257 |
+#' @return Nothing |
|
| 258 |
+#' @export |
|
| 259 |
+#' |
|
| 260 |
+#' @examples |
|
| 261 |
+#' \dontrun{
|
|
| 262 |
+#' NGSdataExplorer() |
|
| 263 |
+#' } |
|
| 264 |
+NGSdataExplorer <- function() {
|
|
| 265 |
+ required_pkgs <- c("shiny", "shinyWidgets", "datamods", "DT", "bslib")
|
|
| 266 |
+ installed <- purrr::map_lgl( |
|
| 267 |
+ required_pkgs, |
|
| 268 |
+ ~ requireNamespace(.x, quietly = TRUE) |
|
| 269 |
+ ) |
|
| 270 |
+ if (any(installed == FALSE)) {
|
|
| 271 |
+ rlang::abort(.missing_pkg_error(required_pkgs[!installed])) |
|
| 272 |
+ } |
|
| 273 |
+ app <- shiny::shinyApp(ui = ui, server = server) |
|
| 274 |
+ shiny::runApp(app) |
|
| 275 |
+} |
| 253 | 276 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,17 @@ |
| 1 |
+% Generated by roxygen2: do not edit by hand |
|
| 2 |
+% Please edit documentation in R/utility-functions.R |
|
| 3 |
+\name{NGSdataExplorer}
|
|
| 4 |
+\alias{NGSdataExplorer}
|
|
| 5 |
+\title{Launch the shiny application NGSdataExplorer.}
|
|
| 6 |
+\usage{
|
|
| 7 |
+NGSdataExplorer() |
|
| 8 |
+} |
|
| 9 |
+\value{
|
|
| 10 |
+Nothing |
|
| 11 |
+} |
|
| 12 |
+\description{
|
|
| 13 |
+Launch the shiny application NGSdataExplorer. |
|
| 14 |
+} |
|
| 15 |
+\examples{
|
|
| 16 |
+\dontrun{NGSdataExplorer()}
|
|
| 17 |
+} |
