From b6243ec5edde5cf725bf569006f3f8861bb405c1 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 21 Dec 2017 09:03:41 +0100 Subject: [PATCH 1/9] scatterPlot: repel max.iter 10000 -> 1000 --- R/function.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/function.R b/R/function.R index 0296f9f..c193ab6 100644 --- a/R/function.R +++ b/R/function.R @@ -178,13 +178,13 @@ create_scatterplot <- function(data, transparency = 1, pointsize = 1, labelsize # set repelling point labels if(!is.null(highlight.labels)) { - plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 10000, point.padding = grid::unit(0.1, "lines"), label.size = NA, alpha = 0.5, seed = seed) - plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 10000, point.padding = grid::unit(0.1, "lines"), label.size = NA, fill = NA, seed = seed) + plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 1000, point.padding = grid::unit(0.1, "lines"), label.size = NA, alpha = 0.5, seed = seed) + plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 1000, point.padding = grid::unit(0.1, "lines"), label.size = NA, fill = NA, seed = seed) } # set repelling labels (for only highlighted points shown) } else if(!is.null(highlight.labels) & length(highlight.labels) == nrow(data)) { - plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 10000, point.padding = grid::unit(0.1, "lines"), label.size = NA, alpha = 0.5, seed = seed) - plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 10000, point.padding = grid::unit(0.1, "lines"), label.size = NA, fill = NA, seed = seed) + plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 1000, point.padding = grid::unit(0.1, "lines"), label.size = NA, alpha = 0.5, seed = seed) + plot <- plot + ggrepel::geom_label_repel(data = highlight.data, mapping = ggplot2::aes(label = highlight.labels), size = labelsize, color = "black", segment.color = "gray65", force = 2, max.iter = 1000, point.padding = grid::unit(0.1, "lines"), label.size = NA, fill = NA, seed = seed) } } From d3952a33f803857636b95b0caa667d40c0d21e2e Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 21 Dec 2017 09:25:41 +0100 Subject: [PATCH 2/9] scatterPlot: restrict labels to be 100 or less --- R/scatterPlot.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/R/scatterPlot.R b/R/scatterPlot.R index 1fc2a8b..b577b39 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -266,7 +266,16 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma result$highlight.color <- markerReac()$color if(markerReac()$highlight != "Disabled" & nrow(features.r()) > 0){ - result$highlight.labels <- markerReac()$label + # restrict label to 100 or less + if(length(markerReac()$label) <= 100) { + result$highlight.labels <- markerReac()$label + } else { + shiny::showNotification( + paste("Warning! Label restricted to 100 or less labels. Currently selected:", length(markerReac()$label)), + duration = 10, + type = "warning" + ) + } } if(markerReac()$highlight == "Highlight" & nrow(features.r()) > 0){ From 26c04f50a00f8537e8c2c42d7a2eb3e35f7155aa Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 21 Dec 2017 13:26:42 +0100 Subject: [PATCH 3/9] scatterPlot: use external css file --- R/scatterPlot.R | 5 ++++- inst/www/styles.css | 13 +++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 inst/www/styles.css diff --git a/R/scatterPlot.R b/R/scatterPlot.R index b577b39..9acbd5a 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -9,6 +9,7 @@ scatterPlotUI <- function(id) { ns <- shiny::NS(id) shiny::tagList(shiny::fluidPage( + shiny::singleton(shiny::tags$head(shiny::tags$link(rel = "stylesheet", type = "text/css", href = "wilson_www/styles.css"))), shiny::fluidRow(shinydashboard::box( width = 12, shiny::div(style = "overflow-y: scroll; overflow-x: scroll; height: 800px; text-align: center", @@ -271,10 +272,12 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma result$highlight.labels <- markerReac()$label } else { shiny::showNotification( + id = session$ns("label-limit"), paste("Warning! Label restricted to 100 or less labels. Currently selected:", length(markerReac()$label)), - duration = 10, + duration = NULL, type = "warning" ) + shinyjs::addClass(selector = paste0("#shiny-notification-", session$ns("label-limit")), class = "notification-position-center") } } diff --git a/inst/www/styles.css b/inst/www/styles.css new file mode 100644 index 0000000..dbbbaa8 --- /dev/null +++ b/inst/www/styles.css @@ -0,0 +1,13 @@ +/* notifications */ + +.notification-position-center { + position: fixed; + top: 50%; + left: 40%; + right: 40%; + opacity: 1; +} + +/* slider */ + +/* text input */ From a95c0ccdd61029ddd1f432239cef695a3e2ede4a Mon Sep 17 00:00:00 2001 From: Schultheis Date: Fri, 22 Dec 2017 11:30:20 +0100 Subject: [PATCH 4/9] orNumeric: moved css to styles.css; use javascript to add/remove css class --- R/orNumeric.R | 182 +++++++++++--------------------------------- inst/www/styles.css | 91 +++++++++++++++++++++- 2 files changed, 136 insertions(+), 137 deletions(-) diff --git a/R/orNumeric.R b/R/orNumeric.R index 6b801dc..fd83518 100644 --- a/R/orNumeric.R +++ b/R/orNumeric.R @@ -12,7 +12,10 @@ orNumericUI <- function(id){ ns <- shiny::NS(id) shiny::tagList( - shiny::tagList(shinyjs::useShinyjs(), shiny::uiOutput(ns("label"))), + shiny::tagList(shinyjs::useShinyjs(), + shiny::singleton(shiny::tags$head(shiny::tags$link(rel = "stylesheet", type = "text/css", href = "wilson_www/styles.css"))), + shiny::uiOutput(ns("label")) + ), shiny::uiOutput(ns("options")), shiny::uiOutput(ns("slider")), shiny::uiOutput(ns("info")) @@ -89,142 +92,49 @@ orNumeric <- function(input, output, session, choices, value, label = "Column", } }) - css <- shiny::reactive({ - # range slider? - if(length(value.r()) > 1) { - shiny::req(input$options) - # span.irs-bar = range between points (inner) - # span.irs-line = range outside of points (outer) - # span.irs-slider.from = left point - # span.irs-slider.to = right point - # span.irs-from = text above left point - # span.irs-to = text above right point - # span.irs-min = left text above slider - # span.irs-max = right text above slider - # span.irs-single = joined texts above points - - # inner css - if(input$options == "inner") { - css <- shiny::HTML(paste0("") - # outer css - }else if(input$options == "outer") { - css <- shiny::HTML(paste0("") - } - #single slider - }else { - # span.irs-min = left text above slider - # span.irs-max = right text above slider - # span.irs-single = text above point - # span.irs-slider.single = point - # span.irs-bar = bar left side of point - # span.irs-bar-edge = left edge of bar - # span.irs-line = bar right side of point - - # default for < - less <- shiny::HTML(paste0("" - - if(any("<" == input$options)) { - less <- shiny::HTML(paste0("" - } - shiny::HTML(less, equal, greater) - } - }) - - # insert style for slider + # change css classes so slider visually matches options shiny::observe({ - # re-insert css if slider is re-rendered - min.r() - max.r() - - # escape . to get valid css selector - # TODO better validation - selector <- gsub(pattern = ".", replacement = "\\.", x = session$ns("slider-style"), fixed = TRUE) - selector2 <- gsub(pattern = ".", replacement = "\\.", x = session$ns("slider"), fixed = TRUE) - - if(length(value.r()) > 1) shiny::req(input$options) - shiny::removeUI( - selector = paste0("#", selector) - ) - - shiny::insertUI( - selector = paste0("#", selector2), - where = "afterBegin", - ui = css() - ) + # change css classes if slider is re-rendered + min.r() + max.r() + + if(length(value.r()) > 1){ + shiny::req(input$options) + + if(input$options == "inner") { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('outer')")) + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').addClass('inner')")) + } else if(input$options == "outer") { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('inner')")) + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').addClass('outer')")) + } + } else { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').addClass('empty')")) + + if(shiny::isTruthy(input$options)) { + if(any(input$options == ">")) { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').addClass('greater')")) + } else { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('greater')")) + } + + if(any(input$options == "=")) { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').addClass('equal')")) + } else { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('equal')")) + } + + if(any(input$options == "<")) { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').addClass('less')")) + } else { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('less')")) + } + } else { + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('greater')")) + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('equal')")) + shinyjs::runjs(paste0("$(document.getElementById('", session$ns("slider"),"')).find('span').removeClass('less')")) + } + } }) output$slider <- shiny::renderUI({ diff --git a/inst/www/styles.css b/inst/www/styles.css index dbbbaa8..0fd7231 100644 --- a/inst/www/styles.css +++ b/inst/www/styles.css @@ -8,6 +8,95 @@ opacity: 1; } -/* slider */ +/* slider +.irs-bar = range between points (inner)/ bar left side of point +.irs-bar-edge = left edge of bar +.irs-line = range outside of points (outer)/ bar right side of point +.irs-slider.single = single point +.irs-slider.from = left point +.irs-slider.to = right point +.irs-from = text above left point +.irs-to = text above right point +.irs-min = left text above slider +.irs-max = right text above slider +.irs-single = joined texts above points/ text above single point +*/ +/* ranged slider */ +.inner.irs-bar { + background: #428bca; + border-top: 1px solid #428bca; + border-bottom: 1px solid #428bca; +} + +.inner.irs-from, .inner.irs-to, .inner.irs-single { + background: #428bca; + color: #FFF; +} + +.inner.irs-line { + border: 1px solid #CCC; + background: linear-gradient(to bottom, #DDD -50%, #FFF 150%); +} + +.outer.irs-bar { + border: 1px solid #CCC; + background: linear-gradient(to bottom, #DDD -50%, #FFF 150%); +} + +.outer.irs-from, .outer.irs-to, .outer.irs-single { + background: rgba(0,0,0,0.1); + color: #333; +} + +.outer.irs-line { + background: #428bca; + border-top: 1px solid #428bca; + border-bottom: 1px solid #428bca; +} + +.outer.irs-min, .outer.irs-max { + background: #428bca; + color: #FFF; +} + +/* single slider */ +.less.irs-bar, .less.irs-bar-edge { + background: #428bca; + border-top: 1px solid #428bca; + border-bottom: 1px solid #428bca; +} + +.less.irs-min { + background: #428bca; + color: #FFF; +} + +.equal.irs-single { + background: #428bca; + color: #FFF; +} + +.greater.irs-line { + background: #428bca; + border-top: 1px solid #428bca; + border-bottom: 1px solid #428bca; +} + +.greater.irs-max { + background: #428bca; + color: #FFF; +} + +/* empty */ +.empty.irs-bar:not(.less), .empty.irs-bar-edge:not(.less) { + background: linear-gradient(to bottom, #DDD -50%, #FFF 150%); + border: 1px solid #CCC; + border-right: 0; +} + +.empty.irs-single:not(.equal) { + background: rgba(0,0,0,0.1); + color: #333; +} /* text input */ From 7777d242563cf30f9db35042a445eb6ea7ed39f5 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 9 Jan 2018 09:26:00 +0100 Subject: [PATCH 5/9] columnSelector: don't use deprecated scoped style --- R/columnSelector.R | 6 ++++-- inst/www/styles.css | 4 ++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/columnSelector.R b/R/columnSelector.R index a06320c..159e89a 100644 --- a/R/columnSelector.R +++ b/R/columnSelector.R @@ -13,7 +13,8 @@ columnSelectorUI <- function(id, label = F, title = NULL) { shiny::tagList( shiny::tags$b(title), - shiny::HTML(""), + shinyjs::useShinyjs(), + shiny::singleton(shiny::tags$head(shiny::tags$link(rel = "stylesheet", type = "text/css", href = "wilson_www/styles.css"))), shiny::uiOutput(ns("out")), {if(label) shiny::uiOutput(ns("showLabel"))} ) @@ -78,9 +79,10 @@ columnSelector <- function(input, output, session, type.columns, type = NULL, co if(multiple) { columnSelectLabel = paste0(columnSelectLabel, "(s)") } + shiny::tagList( shiny::selectInput(session$ns("select.type"), label = columnTypeLabel, choices = type.r(), selected = type.r()[1], multiple = FALSE), - shiny::selectizeInput(session$ns("select.column"), label = columnSelectLabel, choices = choices, multiple = multiple) + shiny::div(shiny::selectizeInput(session$ns("select.column"), label = columnSelectLabel, choices = choices, multiple = multiple), class = "empty") # colored background if empty ) }) diff --git a/inst/www/styles.css b/inst/www/styles.css index 0fd7231..aad0d57 100644 --- a/inst/www/styles.css +++ b/inst/www/styles.css @@ -100,3 +100,7 @@ } /* text input */ + +.empty > div .selectize-input:not(.has-items) { + background: #FFFFE1; +} From 546191697a988dd3aebaf84bc3259c34b61b4b31 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 9 Jan 2018 09:29:13 +0100 Subject: [PATCH 6/9] geneView: don't use deptrecated scoped style --- R/geneView.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/geneView.R b/R/geneView.R index 7ce41c8..3e71057 100644 --- a/R/geneView.R +++ b/R/geneView.R @@ -12,6 +12,7 @@ geneViewUI <- function(id, plot.columns = 3){ shiny::tagList( rintrojs::introjsUI(), shinyjs::useShinyjs(), + shiny::singleton(shiny::tags$head(shiny::tags$link(rel = "stylesheet", type = "text/css", href = "wilson_www/styles.css"))), shiny::fluidPage( shiny::fluidRow( shinydashboard::box( @@ -30,7 +31,6 @@ geneViewUI <- function(id, plot.columns = 3){ width = 3, shiny::div(id = ns("guide_geneSelection"), - shiny::HTML(""), shiny::uiOutput(ns("genes"))), shiny::div(id = ns("guide_genelabel"), labelUI(ns("labeller"))) @@ -189,6 +189,9 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot. #only fetch needed data (calculation on server-side) shiny::updateSelectizeInput(session, "genes", choices = unique(data.r()[[2]]), server = TRUE) + # colored if not has item + output <- shiny::div(class = "empty", output) + return(output) }) From 98e674914a527ab56cc917a05139f46b43e78344 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Wed, 10 Jan 2018 09:02:09 +0100 Subject: [PATCH 7/9] featureSelector: 'Select TopX features' -> 'Select TopX and/or BottomX features' --- R/featureSelector.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/featureSelector.R b/R/featureSelector.R index 0bce69f..df95e47 100644 --- a/R/featureSelector.R +++ b/R/featureSelector.R @@ -100,7 +100,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu }) and_selected <- shiny::callModule(and, "and", data = data.r, show.elements = features.r, element.grouping = feature.grouping.r, delimiter = delimiter, multiple = multiple, contains = contains, ranged = ranged, step = step, reset = shiny::reactive(input$reset)) - row_selector <- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select TopX features:", stepsize = 1) + row_selector <- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select TopX and/or BottomX features:", stepsize = 1) # row_selector choices choices <- shiny::reactive({ @@ -144,7 +144,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu # reset row_selector shiny::observeEvent(input$reset, { value(NULL) - row_selector <<- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select TopX features:", stepsize = 1) + row_selector <<- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select TopX and/or BottomX features:", stepsize = 1) }) #Fetch reactive guide for this module @@ -189,8 +189,8 @@ featureSelector <- function(input, output, session, data, features = NULL, featu # row selector info shiny::observeEvent(input$infobutton, { - title <- "Select TopX features" - content <- "Subset the TopX features from the currently selected candidates." + title <- "Select TopX and/or BottomX features" + content <- "Subset the TopX and/or BottomX features from the currently selected candidates." shiny::showModal( shiny::modalDialog( From 925fcf60d1a739fa612c7d84e90039ff5d73e022 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Fri, 12 Jan 2018 13:42:51 +0100 Subject: [PATCH 8/9] scatterPlot: suggestion to use fewer label --- R/scatterPlot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/scatterPlot.R b/R/scatterPlot.R index 9acbd5a..2637149 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -273,7 +273,7 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma } else { shiny::showNotification( id = session$ns("label-limit"), - paste("Warning! Label restricted to 100 or less labels. Currently selected:", length(markerReac()$label)), + paste("Warning! Label restricted to 100 or less labels. Currently selected:", length(markerReac()$label), "Please select fewer genes to label."), duration = NULL, type = "warning" ) From ee5bfb673ebc1a0750cc447b48a11052fd934eaf Mon Sep 17 00:00:00 2001 From: Schultheis Date: Fri, 12 Jan 2018 13:53:31 +0100 Subject: [PATCH 9/9] featureSelector: "Select TopX and/or BottomX features:" -> "Select n features from the top and/or bottom of the list" --- R/featureSelector.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/featureSelector.R b/R/featureSelector.R index df95e47..bb64b5d 100644 --- a/R/featureSelector.R +++ b/R/featureSelector.R @@ -100,7 +100,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu }) and_selected <- shiny::callModule(and, "and", data = data.r, show.elements = features.r, element.grouping = feature.grouping.r, delimiter = delimiter, multiple = multiple, contains = contains, ranged = ranged, step = step, reset = shiny::reactive(input$reset)) - row_selector <- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select TopX and/or BottomX features:", stepsize = 1) + row_selector <- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select n features from the top and/or bottom of the list", stepsize = 1) # row_selector choices choices <- shiny::reactive({ @@ -144,7 +144,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu # reset row_selector shiny::observeEvent(input$reset, { value(NULL) - row_selector <<- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select TopX and/or BottomX features:", stepsize = 1) + row_selector <<- shiny::callModule(orNumeric, "row_selector", choices = choices, value = value_wrapper, label = "Select n features from the top and/or bottom of the list", stepsize = 1) }) #Fetch reactive guide for this module @@ -189,7 +189,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu # row selector info shiny::observeEvent(input$infobutton, { - title <- "Select TopX and/or BottomX features" + title <- "Select n features from the top and/or bottom of the list" content <- "Subset the TopX and/or BottomX features from the currently selected candidates." shiny::showModal(