Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions inst/eDISH_app/global.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
library(safetyGraphics)
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(dplyr)
library(purrr)
Expand Down
8 changes: 5 additions & 3 deletions inst/eDISH_app/modules/renderSettings/renderSettings.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
# Functions to include
source("modules/renderSettings/util/createSettingsSection.R")
source("modules/renderSettings/util/createSettingLabel.R")
source("modules/renderSettings/util/createControl.R")
source("modules/renderSettings/util/createSettingsUI.R")
Expand Down Expand Up @@ -223,13 +224,14 @@ renderSettings <- function(input, output, session, data, settings, status){
status_new()$checks %>%
group_by(text_key) %>%
mutate(num_fail = sum(valid==FALSE)) %>%
mutate(icon = ifelse(num_fail==0, "<i class='glyphicon glyphicon-ok'></i>","<i class='glyphicon glyphicon-remove'></i>"))%>%
mutate(message_long = paste(message, collapse = " ") %>% trimws(),
message_short = case_when(
num_fail==0 ~ "OK",
num_fail==1 ~ "1 failed check.",
TRUE ~ paste(num_fail, "failed checks.")
)) %>%
select(text_key, message_long, message_short, num_fail) %>%
select(text_key, icon, message_long, message_short, num_fail) %>%
unique
})

Expand All @@ -246,8 +248,8 @@ renderSettings <- function(input, output, session, data, settings, status){

status_short <- status_df()[status_df()$text_key==key, "message_short"]
status_long <- status_df()[status_df()$text_key==key, "message_long"]

updateSettingStatus(ns=ns, key=key, status_short=status_short, status_long=status_long)
icon <- status_df()[status_df()$text_key==key, "icon"]
updateSettingStatus(ns=ns, key=key, status_short=status_short, status_long=status_long, icon=icon)
}

}
Expand Down
108 changes: 17 additions & 91 deletions inst/eDISH_app/modules/renderSettings/renderSettingsUI.R
Original file line number Diff line number Diff line change
@@ -1,97 +1,23 @@
#' Render Settings module - UI code
#'
#' This module creates the Settings tab for the Shiny app. The UI is dynamically populated from the server side.
#'
#' The UI contains:
#' - Chart selector
#' - Settings customizations for the selected charts:
#' - Data mapping
#' - Measure settings
#' - Appearance settings
#'
#' @param id The module-specific ID that will get pre-pended to all element IDs
#'
#' @return The UI for the Settings tab
#'

renderSettingsUI <- function(id){

ns <- NS(id)

tagList(
verticalLayout(
fluidRow(
column(4,
wellPanel(
div(
span(h2(tags$strong("Select Chart(s):"))),
checkboxGroupInput(ns("charts"),"",
choices = c("e-DISH" = "edish"),
selected="edish"))
)
fluidRow(
column(12,
class="chartSelect section",
checkboxGroupInput(
ns("charts"),
"Select Chart(s):",
choices = c("e-DISH" = "edish"),
selected="edish"
)
),
fluidRow(
column(4,
tags$hr()
)
),
fluidRow(
column(4,
h2(tags$strong("Customize Settings:"))
)
),
fluidRow(
column(4,
div(
div(style="display: inline-block;", h3(tags$i("Data Mapping"))),
div(style="display: inline-block;", checkboxInput(ns("show_data_mapping"), "show", TRUE))
)
)
),
conditionalPanel(condition="input.show_data_mapping", ns=ns,
fluidRow(
column(4,
wellPanel(
uiOutput(ns("data_mapping_ui"))
))

)
),

fluidRow(
column(4,
div(
div(style="display: inline-block;", h3(tags$i("Measure Settings"))),
div(style="display: inline-block;", checkboxInput(ns("show_measure_settings"), "show", TRUE))
)
)
),
conditionalPanel(condition="input.show_measure_settings", ns=ns,
fluidRow(
column(4,
wellPanel(
uiOutput(ns("measure_settings_ui"))

)
)
)
),
fluidRow(
column(6,
div(
div(style="display: inline-block;", h3(tags$i("Appearance Settings"))),
div(style="display: inline-block;", checkboxInput(ns("show_appearance_settings"), "show", TRUE))
)
)
),
conditionalPanel(condition="input.show_appearance_settings", ns=ns,
fluidRow(
column(4,
wellPanel(
uiOutput(ns("appearance_settings_ui"))
)
)
)
)
))
),
#TODO - make this a loop based on metadata
fluidRow(
createSettingsSection("data_mapping", "Data Mappings",6,ns),
createSettingsSection("measure_settings", "Measure Settings",6,ns),
createSettingsSection("appearance_settings", "Appearance Settings",6,ns)
)
)
}
73 changes: 29 additions & 44 deletions inst/eDISH_app/modules/renderSettings/util/createControl.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@
createControl <- function(key, metadata, data, settings, ns){

sm_key <- filter(metadata, text_key==key)

ctl_id <- paste0("ctl_", key)
tt_msg <- paste0("tt_msg_", key)
msg <- paste0("msg_", key)

Expand All @@ -28,6 +28,7 @@ createControl <- function(key, metadata, data, settings, ns){
setting_value <- safetyGraphics:::getSettingValue(key=setting_key, settings=settings)
setting_label <- createSettingLabel(key)
setting_description <- getSettingsMetadata(text_keys=key, cols="description")
setting_required <- ifelse(getSettingsMetadata(text_keys=key, cols="setting_required"),"\nSetting Required","\nSetting Optional")

### if a field-level input, get metadata about the parent column-level input
field_column <- NULL
Expand All @@ -37,69 +38,53 @@ createControl <- function(key, metadata, data, settings, ns){
field_column_label <- getSettingsMetadata(text_key = sm_key$field_column_key, cols = "label")
}


### get the choices for the selectors
value <- NULL
choices <- NULL
placeholder <- NULL
if(sm_key$column_mapping==TRUE){
if(is.null(setting_value)){

if(sm_key$column_mapping==TRUE & is.null(setting_value)){ #column mapping - no value specified
choices <- colnames(data)
placeholder <- list(
onInitialize = I('function() {
this.setValue("");}'))
} else{
choices <- unique(c(setting_value, colnames(data)))
placeholder <- list (onInitialize = I('function() { }'))
}
} else if (sm_key$field_mapping==TRUE){
if(is.null(field_column)){ ## if there is NOT a column specified in settings
placeholder <- list(onInitialize = I('function() {this.setValue("");}'))
} else if(sm_key$column_mapping==TRUE & !is.null(setting_value)) { #column mapping - value specified
choices <- unique(c(setting_value, colnames(data)))
placeholder <- list (onInitialize = I('function() { }'))
} else if (sm_key$field_mapping==TRUE & is.null(field_column)){ ## if there is NOT a column specified in settings
placeholder <- list(
placeholder = paste0("Please select a ", field_column_label),
onInitialize = I('function() {
this.setValue("");}'))
} else{ ## if there is a column specified in settings
this.setValue("");}')
)
} else if (sm_key$field_mapping==TRUE & !is.null(field_column)){ ## if there is NOT a column specified in settings
choices <- unique(c(setting_value, as.character(data[,field_column]))) %>% unlist
placeholder <- list (onInitialize = I('function() { }'))
}
} else if (sm_key$setting_type=="vector"){
choices <- setting_value ### this is meant to cover the scenario for x_options/y_options
}



### create code for the UI
multiple <- (sm_key$setting_type=="vector")

if (sm_key$column_mapping==TRUE | sm_key$field_mapping==TRUE){

multiple <- (sm_key$setting_type=="vector")

div(
span(title = setting_description, tags$label(HTML(setting_label))),
span(id = ns(tt_msg), title = "", tags$label(id = ns(msg), "")),
selectizeInput(inputId = ns(key), label = NULL, choices = choices, options = placeholder, multiple = multiple)
)
input <- selectizeInput(inputId = ns(key), label = NULL, choices = choices, options = placeholder, multiple = multiple)
} else if (sm_key$setting_type=="vector"){

div(
span(title = setting_description, tags$label(HTML(setting_label))),
span(id = ns(tt_msg), title = "", tags$label(id = ns(msg), "")),
selectizeInput(inputId = ns(key), label = NULL, choices = choices, selected = choices, multiple = TRUE)
)

input <- selectizeInput(inputId = ns(key), label = NULL, choices = choices, selected = choices, multiple = TRUE)
} else if (sm_key$setting_type=="numeric"){
div(
div(title = setting_description, tags$label(HTML(setting_label))),
sliderInput(inputId = ns(key), label = NULL, value=setting_value, min=0, max=50)
)
input <- sliderInput(inputId = ns(key), label = NULL, value=setting_value, min=0, max=50)
} else if (sm_key$setting_type=="logical"){
div(
div(title = setting_description, tags$label(HTML(setting_label))),
checkboxInput(inputId = ns(key), label = NULL, value=setting_value)
)
input <- checkboxInput(inputId = ns(key), label = NULL, value=setting_value)
} else if (sm_key$setting_type=="character"){
input <-textAreaInput(inputId = ns(key), label = NULL, value = setting_value)
}

div(
class="control-wrap",
id=ns(ctl_id),
span(title = paste0(setting_description," ",setting_required), tags$label(HTML(setting_label))),
div(
div(title = setting_description, tags$label(HTML(setting_label))),
textAreaInput(inputId = ns(key), label = NULL, value = setting_value)
class="select-wrap",
input,
div(id = ns(tt_msg), title = "", tags$label(id = ns(msg), ""), class="status")
)
}
)
}
Original file line number Diff line number Diff line change
Expand Up @@ -9,10 +9,5 @@ createSettingLabel <- function(key){
sm <- getSettingsMetadata(text_keys=key)
setting_label <- sm$label
required <- sm$setting_required

if (required){
paste0("<i class='fa fa-info-circle' style='color:gray'></i> ", setting_label, "<strong>*</strong>")
} else {
paste0("<i class='fa fa-info-circle' style='color:gray'></i> ", setting_label)
}
paste0(setting_label)#, " <i class='fa fa-info-circle' style='color:gray'></i>" )
}
24 changes: 24 additions & 0 deletions inst/eDISH_app/modules/renderSettings/util/createSettingsSection.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,24 @@
createSettingsSection <- function(class, label,cols,ns){
Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nice!

section <-
column(cols,
wellPanel(
class=paste0(class," section"),
h3(
label,
materialSwitch(
ns(paste0("show_",class)),
label = "",
right=TRUE,
value = TRUE,
status = "primary"
)
),
conditionalPanel(
condition=paste0("input.show_",class),
ns=ns,
uiOutput(ns(paste0(class,"_ui")))
)
)
)
return(section)
}
29 changes: 13 additions & 16 deletions inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,24 +9,21 @@
#' @param status_short Abbreviated validation message
#' @param status_long Detailed validation message

updateSettingStatus<-function(ns, key, status_short, status_long){
updateSettingStatus<-function(ns, key, status_short, status_long, icon){

ctl_id<-paste0("ctl_", key)
#TODO: get msg_ and tooltip_ selectors using relative position to control id
msg_id <- paste0("msg_", key)
tooltip_id <- paste0("tt_msg_", key)

if (status_short=="OK"){
shinyjs::html(id = msg_id,
html = paste(" <em style='color:green; font-size:12px;'>", status_short,"</em>",
"<i class='fa fa-ellipsis-h' style='color:green'></i>"))

shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "Selection is valid")'))

} else {
shinyjs::html(id = msg_id,
html = paste(" <em style='color:red; font-size:12px;'>", status_short,"</em>",
"<i class='fa fa-ellipsis-h' style='color:red'></i>"))

shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "', status_long, '")'))
if(status_short=="OK"){
shinyjs::addClass(id=ctl_id, class="valid")
shinyjs::removeClass(id=ctl_id, class="invalid")
}else{
shinyjs::removeClass(id=ctl_id, class="valid")
shinyjs::addClass(id=ctl_id, class="invalid")
}
shinyjs::html(id = msg_id, html = paste(icon))
if(nchar(status_long)>0){
shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "',status_long,'").addClass("details")'))
}

}
6 changes: 3 additions & 3 deletions inst/eDISH_app/ui.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,9 @@

tagList(
useShinyjs(),
tags$style(HTML("
.ok { color:#008000;}
.notok {color: #FF0000;}")),
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "index.css")
),
navbarPage("eDISH Shiny app",
tabPanel(title = htmlOutput("data_tab_title"),
dataUploadUI("datatab")
Expand Down
Loading