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/R/featureSelector.R b/R/featureSelector.R
index 0bce69f..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 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 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,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 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(
shiny::modalDialog(
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)
}
}
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)
})
diff --git a/R/orNumeric.R b/R/orNumeric.R
index f4da109..a2df084 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/R/scatterPlot.R b/R/scatterPlot.R
index 1fc2a8b..2637149 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",
@@ -266,7 +267,18 @@ 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(
+ id = session$ns("label-limit"),
+ paste("Warning! Label restricted to 100 or less labels. Currently selected:", length(markerReac()$label), "Please select fewer genes to label."),
+ duration = NULL,
+ type = "warning"
+ )
+ shinyjs::addClass(selector = paste0("#shiny-notification-", session$ns("label-limit")), class = "notification-position-center")
+ }
}
if(markerReac()$highlight == "Highlight" & nrow(features.r()) > 0){
diff --git a/inst/www/styles.css b/inst/www/styles.css
new file mode 100644
index 0000000..aad0d57
--- /dev/null
+++ b/inst/www/styles.css
@@ -0,0 +1,106 @@
+/* notifications */
+
+.notification-position-center {
+ position: fixed;
+ top: 50%;
+ left: 40%;
+ right: 40%;
+ opacity: 1;
+}
+
+/* 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 */
+
+.empty > div .selectize-input:not(.has-items) {
+ background: #FFFFE1;
+}