Nothing
# library(shiny)
# library(DT)
shinyServer(function(input, output) {
############################## DATA SECTION ############################
data <- reactive({
req(input$datafile)
# if input is already processed just read.csv
# else select associated sensor type
out = switch(input$datatype,
"processed" = read.csv(input$datafile$datapath),
"FreeStyle Libre" = iglu::read_raw_data(input$datafile$datapath, sensor = "libre", id = input$subjid),
"Dexcom" = iglu::read_raw_data(input$datafile$datapath, sensor = "dexcom", id = input$subjid),
"Libre Pro" = iglu::read_raw_data(input$datafile$datapath, sensor = "librepro", id = input$subjid),
"ASC" = iglu::read_raw_data(input$datafile$datapath, sensor = "asc", id = input$subjid),
"iPro" = iglu::read_raw_data(input$datafile$datapath, sensor = "ipro", id = input$subjid)
)
return(out)
})
output$data <- DT::renderDataTable({
validate(
need(input$demodata != '', "Please select Dataset")
)
DT::datatable(
(if (input$demodata == "user_data") {
out <- data()
} else if (input$demodata == "example_data") {
out <- iglu::example_data_5_subject
out$time <- as.character(out$time)
out
}),
extensions = "Buttons",
options = list(dom = "Btip",
buttons = c("copy", "csv", "excel", "pdf", "print"),
paging = FALSE)
)
})
output$downloaddata <- downloadHandler(
filename = function() {
filename <- paste0(gsub("\\.csv", "",basename(input$datafile$name)), "_processed")
paste(filename, ".csv", sep = "")
},
content = function(file) {
write.csv(data(), file, row.names = FALSE)
}
)
transform_data <- reactive({
req(input$demodata)
if (input$demodata == "user_data") {
data = data()
} else if (input$demodata == "example_data") {
data = iglu::example_data_5_subject
}
# what does this line do?
# iglu:::read_df_or_vec(data, id = input$id, time = input$time, gl = input$gl)
return(data)
})
############################# METRIC SECTION ######################################################
#add metric based on the parameter it takes in
parameter_type <- reactive({
#metric is considered as parameter type "none" if it only requires data as a parameter
if(input$metric %in% c("adrr", "cv_glu", "ea1c", "gmi", "cv_measures", "episode_calculation", "grade", "gri", "gvp", "hbgi", "iqr_glu", "j_index", "lbgi",
"mean_glu", "median_glu", "range_glu", "sd_glu", "sd_measures", "summary_glu", "all_metrics")){
return("none")
}
#metric is considered as parameter type "time" if it takes in data and time zone as parameters
else if(input$metric %in% c("auc","cv_measures", "sd_measures")){
return("time")
}
#metric is considered as parameter type "list" if it takes in data and a list of values as parameters
else if(input$metric %in% c("above_percent", "below_percent", "cogi", "quantile_glu")){
return("list")
}
#metric is considered as parameter type "value" if it takes in data and a single value as parameters
else if(input$metric %in% c("grade_hyper", "grade_hypo","m_value","mad_glu", "active_percent")){
return("value")
}
else if(input$metric == 'mage') {
return("mage")
}
else if(input$metric %in% c("hyper_index", "hypo_index")){
return("value1")
}
#metric is considered as parameter type "value_time" if it takes in data, a single value, and timezone as parameters
else if(input$metric %in% c("conga","mag","modd","roc","sd_roc")){
return("value_time")
}
#metric is considered as parameter type "lwrupr" if it takes in data, lower threshold, and upper threshold as parameters
else if(input$metric %in% c("grade_eugly")){
return("lwrupr")
}
else if(input$metric %in% c("igc")){
return("lwrupr1")
}
#metric is considered as parameter type "nested" if it takes in data and a list of ranges
else if(input$metric %in% c("in_range_percent")){
return("nested")
}
})
#specify first parameter and the default values
output$select_parameter <- renderUI({
parameter_type = parameter_type()
if(parameter_type == "list"){
if(input$metric == "above_percent"){
textInput("parameter", "Specify Parameter", value = "140, 180, 250")
}
else if(input$metric == "below_percent"){
textInput("parameter", "Specify Parameter", value = "50, 80")
}
else if(input$metric == "cogi"){
textInput("parameter", "Specify Parameter", value = "70, 180")
}
else if(input$metric == "quantile_glu"){
textInput("parameter", "Specify Parameter", value = "0, 25, 50, 75, 100")
}
}
else if(parameter_type == "mage") {
if(input$metric == "mage") {
radioButtons("parameter", "Mage Version", choiceNames=c('Version 2: ma (recommended)', 'Version 1: naive (superseded)'),choiceValues=c("ma","naive"))
}
}
else if(parameter_type == "value"){
if(input$metric == "grade_hyper"){
textInput("parameter", "Specify Parameter", value = "140")
}
else if(input$metric == "grade_hypo"){
textInput("parameter", "Specify Parameter", value = "80")
}
else if(input$metric == "m_value"){
textInput("parameter", "Specify Reference Value", value = "90")
}
else if(input$metric == "mad_glu"){
textInput("parameter", "Specify Parameter", value = "1.4826")
}
else if(input$metric == "active_percent"){
textInput("parameter", "Specify Parameter", value = "5")
}
}
else if(parameter_type == "value1"){
if(input$metric == "hyper_index"){
textInput("parameter", "Specify Upper Limit", value = "180")
}
else if(input$metric == "hypo_index"){
textInput("parameter", "Specify Lower Limit", value = "70")
}
}
else if(parameter_type == "value_time"){
if(input$metric == "conga"){
textInput("parameter", "Specify Parameter", value = "24")
}
else if(input$metric == "mag"){
textInput("parameter", "Specify Parameter", value = "60")
}
else if(input$metric == "modd"){
textInput("parameter", "Specify Parameter", value = "1")
}
else if(input$metric == "roc"){
textInput("parameter", "Specify Parameter", value = "15")
}
else if(input$metric == "sd_roc"){
textInput("parameter", "Specify Parameter", value = "15")
}
}
else if(parameter_type == "lwrupr"){
if(input$metric == "grade_eugly"){
textInput("parameter", "Specify Parameter", value = "80, 140")
}
}
else if(parameter_type == "lwrupr1"){
if(input$metric == "igc"){
textInput("parameter", "Specify Lower and Upper Limits", value = "70, 180")
}
else if(input$metric == "episode_calculation"){
textInput("parameter", "Specify Parameter", value = "70, 54")
}
}
else if(parameter_type == "nested"){
if(input$metric == "in_range_percent"){
textInput("parameter", "Specify Parameter", value = "(80, 200), (70, 180), (70,140)")
}
}
})
#add description of first parameter
output$help_text <- renderUI({
parameter_type = parameter_type()
if(parameter_type == "none"){
helpText("No parameters need to be specified.")
}
else if(parameter_type == "time"){
helpText("No parameters need to be specified.")
}
else if(parameter_type == "list"){
if(input$metric == "above_percent"){
helpText("Enter target glucose thresholds separated by comma.")
}
else if(input$metric == "below_percent"){
helpText("Enter target glucose thresholds separated by comma.")
}
else if(input$metric == "cogi"){
helpText("Enter lower and upper glucose limits separated by comma")
helpText("Default weights applie to time in range, time below range,
and glucose variability, respectively, are (.5, .35, .15)")
}
else if(input$metric == "quantile_glu"){
helpText("Enter quantile values separated by comma.")
}
}
else if(parameter_type == "value"){
if(input$metric == "active_percent"){
helpText("Enter CGM frequency in minutes.")
}
else if(input$metric == "grade_hyper"){
helpText("Enter the upper bound hyperglycemia cutoff value.")
}
else if(input$metric == "grade_hypo"){
helpText("Enter the lower bound hypoglycemia cutoff value.")
}
else if(input$metric == "m_value"){
helpText("Enter the reference value for normal basal glycemia.")
}
else if(input$metric == "active_percent"){
helpText("Enter CGM frequency in minutes.")
}
else if(input$metric == "mad_glu"){
helpText("Enter the value of the scaling factor.")
}
else if(input$metric == "mage"){
helpText("Enter algorithm version in single quotes: 'ma' (default) or 'naive'")
}
}
else if(parameter_type == "value1"){
if(input$metric == "hyper_index"){
helpText("Enter the upper limit of target glucose range.")
}
else if(input$metric == "hypo_index"){
helpText("Enter the lower limit of target glucose range.")
}
}
else if(parameter_type =="value_time"){
if(input$metric == "conga"){
helpText("Enter the hours between observations for the CONGA calculation.")
}
else if(input$metric == "mag"){
helpText("Enter the interval (in minutes) to calculate change in glucose.")
}
else if(input$metric == "modd"){
helpText("Enter the lag in days.")
}
else if(input$metric == "roc"){
helpText("Enter time interval (in minutes) for rate of change.")
}
else if(input$metric == "sd_roc"){
helpText("Enter time interval (in minutes) for rate of change.")
}
}
else if(parameter_type == "lwrupr"){
if(input$metric == "grade_eugly"){
helpText("Enter a lower and an upper glycemic bound separated by a comma.")
}
}
else if(parameter_type == "lwrupr1"){
if(input$metric == "igc"){
helpText("Enter the lower and upper limits of the target range separated by a comma.")
}
}
else if(parameter_type == "nested"){
if(input$metric == "in_range_percent"){
helpText("Enter target ranges in list format - e.g. (lower, upper), (lower, upper)")
}
}
})
#specify second parameter and its default values
output$select_second_parameter <- renderUI({
parameter_type = parameter_type()
if(parameter_type == "value1"){
if(input$metric == "hyper_index"){
textInput("parameter2", "Specify Exponent", value = "1.1")
}
else if(input$metric == "hypo_index"){
textInput("parameter2", "Specify Exponent", value = "2")
}
}
else if(parameter_type == "lwrupr1"){
if(input$metric == "igc"){
textInput("parameter2", "Specify Exponent", value = "1.1, 2")
}
}
else if(parameter_type == "mage") {
if(input$parameter == "ma") {
textInput("parameter2", "Short MA length", value="5")
}
}
})
#add description of second parameter
output$second_parameter_helptext <- renderUI({
parameter_type = parameter_type()
if(parameter_type == "value1"){
if(input$metric == "hyper_index"){
helpText("Enter the upper limit exponent.")
}
else if(input$metric == "hypo_index"){
helpText("Enter the lower limit exponent.")
}
}
else if(parameter_type == "lwrupr1"){
if(input$metric == "igc"){
helpText("Enter the exponents separated by a comma with the upper limit as the first input and the lower limit as the second input.")
}
}
else if(parameter_type == "mage"){
if(input$parameter == "ma") {
helpText("Allowable values between 5 and 15. (5 recommended)")
}
}
})
#specify third parameter and its default value
output$select_third_parameter <- renderUI({
parameter_type = parameter_type()
if(parameter_type == "value1"){
if(input$metric == "hyper_index"){
textInput("parameter3", "Specify Scaling Factor", value = "30")
}
else if(input$metric == "hypo_index"){
textInput("parameter3", "Specify Scaling Factor", value = "30")
}
}
else if(parameter_type == "lwrupr1"){
if(input$metric == "igc"){
textInput("parameter3", "Specify Scaling Factor", value = "30,30")
}
}
else if(parameter_type == "mage") {
if(input$parameter == "ma") {
textInput("parameter3", "Long MA length", value="32")
}
}
})
#add description on third parameter
output$third_parameter_helptext <- renderUI({
parameter_type = parameter_type()
if(parameter_type == "value1"){
if(input$metric == "hyper_index"){
helpText("Enter the upper limit scaling factor.")
}
else if(input$metric == "hypo_index"){
helpText("Enter the lower limit scaling factor.")
}
}
else if(parameter_type == "lwrupr1"){
if(input$metric == "igc"){
helpText("Enter the scaling factors separated by a comma with the upper limit as the first input and the lower limit as the second input.")
}
}
else if(parameter_type == "mage"){
if(input$parameter == "ma") {
helpText("Allowable values between 20 and 40. (32 recommended)")
}
}
})
output$sleep_wake_help <- renderUI({
helpText("Enter a real number 0-24.")
})
# reactive function
metric_table <- reactive({
string = ""
parameter_type = parameter_type()
data = transform_data()
#### Validate catches for parameter 1 #####
if (is.null(input$parameter)) {
validate(
need(!is.null(input$parameter), "Please wait - Rendering")
)
} else if (input$parameter %in% c("ma", "naive")) {
validate (
need (input$metric == "mage" | parameter_type == "none",
"Please wait - Rendering")
)
} else if (grepl(',', input$parameter) & !grepl("\\(", input$parameter)) {
if (length(strsplit(input$parameter, split = ",")[[1]]) != 2) {
validate (
need(parameter_type %in% c("list", "none","time"), "Please wait - Rendering")
)
} else {
validate(
need(parameter_type %in% c("list", "lwrupr","lwrupr1","none","time"), "Please wait - Rendering")
)
}
} else if (grepl("\\(", input$parameter)) {
validate(
need(parameter_type %in% c("nested", "none","time"), "Please wait - Rendering")
)
} else if (!grepl(',', input$parameter)) {
# print(input$parameter) # un-comment for bug-fixing
validate(
need(parameter_type %in% c("value", "value1", "value_time", "none","time"),
"Please wait - Rendering")
)
}
# because MAGE input is unique (character)
if (input$metric == "mage") {
validate(
# print message instead of warning
need(input$parameter %in% c("ma", "naive"), "Parameter must be one of ma, or naive")
)
}
##### Validate for parameters2/3 ####
## parameter2 and parameter3 currently (7/29/21) include the same 3 metrics
## hyper index, hypo index, and igc
if (input$metric %in% c("hyper_index", "hypo_index", "mage")) {
validate(
need(!grepl(",", input$parameter3), "Please wait - Rendering")
)
}
#loading iglu library and using metric function
library(iglu)
if(is.null(input$parameter) | parameter_type == "none"){
string = paste("iglu::", input$metric, "(data)", sep = "")
}
else if(is.null(input$parameter) | parameter_type == "time"){
string = paste("iglu::", input$metric, "(data,", "tz=","'",input$tz,"')",sep = "")
}
else if(parameter_type == "list"){
string = paste("iglu::", input$metric, "(data, c(", input$parameter, "))", sep = "")
}
else if(parameter_type == "value"){
string = paste("iglu::", input$metric, "(data, ", input$parameter, ")", sep = "")
}
else if(parameter_type == "value1"){
string = paste("iglu::", input$metric, "(data, ", input$parameter, ",",input$parameter2,",",input$parameter3, ")", sep = "")
}
else if(parameter_type == "value_time"){
string = paste("iglu::", input$metric, "(data, ", input$parameter, ",","tz=" ,"'", input$tz,"'" ,")", sep = "")
}
else if(parameter_type == "lwrupr"){
string = paste("iglu::", input$metric, "(data, " , input$parameter, ")", sep = "")
}
else if(parameter_type == "lwrupr1"){
string = paste("iglu::", input$metric, "(data, " , input$parameter,",",input$parameter2,",",input$parameter3, ")", sep = "")
}
else if(parameter_type == "mage"){
if(input$parameter == "ma") {
string = paste("iglu::", input$metric, "(data, version='",input$parameter, "', short_ma=", input$parameter2,", long_ma=",input$parameter3,")", sep="")
}
else if(input$parameter == "naive") {
string = paste("iglu::", input$metric, "(data, version='",input$parameter,"')", sep="")
}
}
else if(parameter_type == "nested"){
strlist = strsplit(input$parameter, ")")[[1]]
paramstr = rep.int(0, length(strlist))
if(length(strlist) == 1){
paramstr = paste("c", strlist[1], ")", sep = "")
}
else {
for(i in 2:length(strlist)){
strlist[i] = substring(strlist[i], 3)
}
for(s in 1:length(strlist)){
paramstr[s] = paste("c", strlist[s], ")", sep = "")
}
paramstr = paste(paramstr, collapse = ", ")
}
string = paste("iglu::", input$metric, "(data, list(", paramstr, "))", sep= "")
}
if (input$filter_sleep_wake) {
validate (
need(input$sleep_start != input$sleep_end, "Sleep start cannot equal sleep end, please change one of the inputs")
)
if (parameter_type == "none") {
out_str = paste0("iglu::calculate_sleep_wake(data, FUN = ", input$metric, ", calculate = \'", input$sleep_or_wake, "\', sleep_start = ", input$sleep_start, ", sleep_end = ", input$sleep_end, ")")
}
else if (parameter_type == "list") {
param_string = strsplit(string, "\\(data, c\\(")[[1]][2]
argname = formalArgs(input$metric)
out_str = paste0("iglu::calculate_sleep_wake(data, FUN = ", input$metric, ", calculate = \'", input$sleep_or_wake, "\', sleep_start = ", input$sleep_start, ", sleep_end = ", input$sleep_end, ", ", argname[2], " = c(", param_string)
}
else if (parameter_type == "nested") {
param_string = strsplit(string, "\\(data, list\\(")[[1]][2]
argname = formalArgs(input$metric)
out_str = paste0("iglu::calculate_sleep_wake(data, FUN = ", input$metric, ", calculate = \'", input$sleep_or_wake, "\', sleep_start = ", input$sleep_start, ", sleep_end = ", input$sleep_end, ", ", argname[2], " = list(", paramstr, "))")
} else if (parameter_type == "time") {
out_str = paste0("iglu::calculate_sleep_wake(data, FUN = ", input$metric, ", calculate = \'", input$sleep_or_wake, "\', sleep_start = ", input$sleep_start, ", sleep_end = ", input$sleep_end, ", ", "tz='", input$tz, "')")
} else if (parameter_type == "mage") {
if(input$parameter == "ma") {
out_str = paste0("iglu::calculate_sleep_wake(data, FUN = ",input$metric," , calculate = '",input$sleep_or_wake,"' , sleep_start=",input$sleep_start,",sleep_end=",input$sleep_end,
", version='",input$parameter, "', short_ma=", input$parameter2,", long_ma=",input$parameter3,")")
}
else if(input$parameter == "naive") {
out_str = paste0("iglu::calculate_sleep_wake(data, FUN = ",input$metric," , calculate = '",input$sleep_or_wake,"' , sleep_start=",input$sleep_start,",sleep_end=",input$sleep_end, ", version='naive')")
}
}
else {
param_string = strsplit(string, "\\(data")[[1]][2]
list_of_params = strsplit(param_string, ", ")[[1]]
list_of_params = list_of_params[2:length(list_of_params)]
build_str = c(paste0("iglu::calculate_sleep_wake(data, FUN = ", input$metric, ", calculate = \'", input$sleep_or_wake, "\', sleep_start = ", input$sleep_start, ", sleep_end = ", input$sleep_end))
argnames = formalArgs(input$metric)
for (index in 1:length(list_of_params)) {
build_str = c(build_str, paste0(argnames[index+1], " = ", list_of_params[index]))
}
out_str = paste(build_str, collapse = ", ")
}
string = out_str
}
eval(parse(text = string))
})
output$metric <- DT::renderDataTable(metric_table(), extensions = "Buttons",
options = list(dom = "Btip",
buttons = c("copy", "csv", "excel", "pdf", "print"),
scrollX = TRUE))
############################ PLOTTING SECTION #####################################################
plottype <- reactive({ # wrap plottype input in a reactive for rendering UI and Plot
if(input$plottype == "tsplot"){
return("tsplot")
}
else if(input$plottype == "lasagnamulti"){
return("lasagnamulti")
}
else if(input$plottype == "lasagnasingle"){
return("lasagnasingle")
}
else if(input$plottype == "plot_roc"){
return("plot_roc")
}
else if(input$plottype == "hist_roc"){
return("hist_roc")
}
else if(input$plottype == "mage") {
return("mage")
}
})
subset_data <- reactive({ # define reactive function to subset data for plotting each time user changes subjects list
data = transform_data()
data = data[data$id == input$plot_subjects,] # reactively subset data when subjects input is modified
return(data)
})
output$plot_mage <- renderUI({
plottype = plottype()
if(plottype != "mage"){
return(NULL)
}
data = transform_data()
subject = unique(data$id)[1]
tags$div(
textInput("plot_subjects", "Enter Subject ID", value = subject),
helpText("Enter the ID of a subject to display their MAGE plot"),
textInput("mage_short_ma", "Short MA length", value="5"),
textInput("mage_long_ma", "Long MA length", value="32"),
radioButtons("mage_show_ma", "Show Moving Averages on Plot", c(
"No" = FALSE,
"Yes" = TRUE
), inline=TRUE),
textInput("mage_title", "Title", value = "default"),
textInput("mage_xlab", "X Label", value = "default"),
textInput("mage_ylab", "Y Label", value = "default")
)
})
output$lasagna_sidebar <- renderUI({
data = transform_data()
plottype = plottype()
if (plottype %in% c("lasagnamulti", "lasagnasingle")) {
outputs <- tagList()
outputs[[5]] <- textInput("plot_TR", "Specify Lower and Upper Target Values, separated by a Comma", value = "70, 180")
outputs[[6]] <- textInput("plot_midpoint", "Enter Midpoint Glucose Value for Color Scale", value = 105)
outputs[[7]] <- textInput("plot_limits", "Enter Limit Glucose Values for Color Scale Separated by a Comma", value = "50, 500")
outputs[[8]] <- helpText("The color bar can be modified by changing the values of the target range, the midpoint,
and the color bar limits")
outputs[[9]] <- radioButtons('plot_color_scheme', 'Transformation type',
choices = c(`Blue/Red` = '"blue-red"', `Red/Orange` = '"red-orange"'))
outputs[[10]] <- radioButtons('plot_log', 'Transformation type',
choices = c(`None` = 'FALSE', `Log10` = 'TRUE'))
if (plottype == "lasagnamulti") {
outputs[[1]] <- radioButtons("plot_lasagnatype", "Lasagna Plot Type",
choices = c(`Unsorted` = "unsorted",
`Subject-sorted` = "subjectsorted",
`Time-sorted` = "timesorted"
))
outputs[[2]] <- textInput("plot_maxd", "Enter Maximum # of Days to Plot", value = 14)
outputs[[3]] <- radioButtons("plot_datatype", "Data Aggregation Type",
choices = c(`Average across days` = "average",
`All data points` = "all"
))
outputs[[4]] <- helpText("Select whether to use all data points in the first maxd days, or whether
to take the average value at each time point across the first maxd days")
}
else if (plottype == "lasagnasingle") {
outputs[[1]] <- radioButtons("plot_lasagnatype", "Lasagna Plot Type",
choices = c(`Unsorted` = "unsorted",
`Time-sorted` = "timesorted"))
subject = unique(data$id)[1]
outputs[[2]] <- textInput("plot_subjects", "Enter Subject ID", value = subject)
outputs[[3]] <- helpText("Enter the ID of a subject to display their individualized lasagna plot")
outputs[[4]] <- NULL
}
} else {outputs = NULL}
outputs
})
output$tsplot_sidebar <- renderUI({
data = transform_data()
plottype = plottype()
if (plottype == "tsplot") {
outputs <- tagList()
outputs[[1]] <- textInput("plot_TR", "Specify Lower and Upper Target Values, separated by a Comma", value = "70, 180")
outputs[[2]] <- radioButtons('plot_log', 'Transformation type',
choices = c(`None` = 'FALSE', `Log10` = 'TRUE'))
} else {outputs = NULL}
outputs
})
output$rocplots_sidebar <- renderUI({
data = transform_data()
plottype = plottype()
if (plottype %in% c("plot_roc", "hist_roc")) {
outputs <- tagList()
subject = unique(data$id)[1]
outputs[[1]] <- textInput("plot_subjects", "Enter Subject ID", value = subject)
outputs[[2]] <- helpText("Enter the ID of a subject to display their individualized SD of ROC histogram")
outputs[[3]] <- textInput("plot_timelag", "Enter Timelag for ROC calculation", value = 15)
} else {outputs = NULL}
outputs
})
### Render Plot
plotFunc <- reactive({
library(iglu)
plottype = plottype() # bring reactive input variable into this renderPlot call
if(plottype == "tsplot"){
#plot_glu(data, plottype = "tsplot")
validate (
need(all(!is.null(input$plot_log)),
"Please wait - Rendering")
)
data = transform_data()
string = paste('iglu::plot_glu(data = data, plottype = "tsplot", datatype = "all", lasagnatype = NULL, ',
input$plot_TR, ', subjects = NULL, inter_gap = 45, tz = "", "blue-orange", log = ', input$plot_log, ')' ,sep = "")
eval(parse(text = string))
}
else if(plottype == "lasagnamulti"){
validate (
need(all(!is.null(input$plot_lasagnatype) & !is.null(input$plot_datatype)),
"Please wait - Rendering")
)
data = transform_data()
string = paste('iglu::plot_lasagna(data = data, datatype = "', input$plot_datatype, '", lasagnatype = "',
input$plot_lasagnatype, '", maxd = ', input$plot_maxd, ', limits = c(', input$plot_limits, ') ,',
input$plot_midpoint, ', ', input$plot_TR, ', dt0 = NULL, inter_gap = 60, tz ="",',
input$plot_color_scheme, ', ', input$plot_log, ')', sep = "")
eval(parse(text = string))
}
else if(plottype == "lasagnasingle"){
validate (
need(!is.null(input$plot_subjects), "Please wait - Rendering")
)
data = subset_data() # subset data to only user-specified subject
string = paste('iglu::plot_lasagna_1subject(data = data, lasagnatype = "',
input$plot_lasagnatype, '", limits = c(', input$plot_limits, ') ,',
input$plot_midpoint, ', ', input$plot_TR, ', dt0 = NULL, inter_gap = 60, tz = "",',
input$plot_color_scheme, ', ', input$plot_log, ')', sep = "")
eval(parse(text = string))
}
else if(plottype == "plot_roc"){
data = subset_data() # subset data to only user-specified subject
string = paste('iglu::plot_roc(data = data',
', timelag = ', input$plot_timelag, ', tz = "")', sep = "")
eval(parse(text = string))
}
else if(plottype == "hist_roc"){
data = subset_data() # subset data to only user-specified subject
string = paste('iglu::hist_roc(data = data',
', timelag = ', input$plot_timelag, ', tz = "")', sep = "")
eval(parse(text = string))
}
else if(plottype == "mage"){
validate (
need(all(!is.null(input$mage_short_ma), !is.null(input$mage_long_ma)), "Please wait - Rendering")
)
data = subset_data() # subset data to only user-specified subject
mage_title = ifelse(tolower(input$mage_title) == "default", NA, paste0("'",input$mage_title,"'"))
mage_xlab = ifelse(tolower(input$mage_xlab) == "default", NA, paste0("'",input$mage_xlab,"'"))
mage_ylab = ifelse(tolower(input$mage_ylab) == "default", NA, paste0("'",input$mage_ylab,"'"))
string = paste0("iglu::mage_ma_single(data=data,plot=TRUE,short_ma=",input$mage_short_ma,",long_ma=",
input$mage_long_ma,",show_ma=", input$mage_show_ma,",
,title=",mage_title,",xlab=", mage_xlab,",ylab=",mage_ylab,")")
eval(parse(text=string))
}
})
output$plot <- renderPlot({
plotFunc()
})
options(shiny.usecairo = T)
output$pdfButton <- downloadHandler(
filename = function() {
plottype = plottype()
paste(plottype, '.pdf', sep = '')
},
content = function(file) {
cairo_pdf(filename = file, width = 20, height = 18, bg = "transparent")
plot(plotFunc())
dev.off()
}
)
output$pngButton <- downloadHandler(
filename = function() {
plottype = plottype()
paste(plottype, '.png', sep = '')
},
content = function(file) {
png(file)
plot(plotFunc())
dev.off()
}
)
output$epsButton <- downloadHandler(
filename = function() {
plottype = plottype()
paste(plottype, '.eps', sep = '')
},
content = function(file) {
postscript(file)
plot(plotFunc())
dev.off()
}
)
############################ AGP SECTION #####################################################
### Get desired subject
output$agp_subject <- renderUI({
data = transform_data() # bring reactive data input into this renderUI call to default to all subjects
subject = unique(data$id)[1]
textInput("agp_subject", "Enter Subject ID", value = subject)
})
output$agp_subject_help_text <- renderUI({
helpText("Enter the ID of a subject to display their AGP Report")
})
output$agp_span <- renderUI({
sliderInput("agp_span", "Enter amount of smoothing for AGP plot",
min = 0.1, max = 0.7, value = 0.3, step = 0.1)
})
agp_data <- reactive({ # define reactive function to subset data for plotting each time user changes subjects list
validate (
if (is.null(input$agp_subject)) {
need(!is.null(input$agp_subject), "Please wait - Rendering")
} else {
need(input$agp_subject %in% transform_data()$id, "Please check Subject ID")
}
)
data = transform_data()
data = data[data$id == input$agp_subject,] # reactively subset data when subjects input is modified
return(data)
})
### Rendering Sections
agpMetrics <- reactive({
library(iglu)
data = agp_data()
string = paste("iglu::agp_metrics(data = data, shinyformat = TRUE)")
eval(parse(text = string))
})
output$agp_metrics <- DT::renderDataTable({
DT::datatable(agpMetrics(), options = list(dom = 't'), rownames = FALSE, colnames = "")
})
plotRanges <- reactive({
library(iglu)
data = agp_data()
string = paste('iglu::plot_ranges(data = data)')
eval(parse(text = string))
})
output$plot_ranges <- renderPlot({
plotRanges()
})
plotAGP <- reactive({
library(iglu)
data = agp_data()
string = paste0('iglu::plot_agp(data = data, smooth = TRUE, ', 'span = ',
input$agp_span, ')')
eval(parse(text = string))
})
output$plot_agp <- renderPlot({
plotAGP()
})
plotDaily <- reactive({
library(iglu)
data = agp_data()
string = paste('iglu::plot_daily(data = data)')
eval(parse(text = string))
})
output$plot_daily <- renderPlot({
plotDaily()
})
options(shiny.usecairo = T)
output$pdfAGP<- downloadHandler(
filename = function() {
paste("AGP", '.pdf', sep = '')
},
content = function(file) {
cairo_pdf(filename = file, width = 20, height = 18, bg = "transparent")
p = gridExtra::grid.arrange(gridExtra::arrangeGrob(gridExtra::tableGrob(agpMetrics(), rows = NULL),
plotRanges(), ncol = 2), plotAGP(), plotDaily())
plot(p)
dev.off()
}
)
output$pngAGP <- downloadHandler(
filename = function() {
paste("AGP", '.png', sep = '')
},
content = function(file) {
png(file)
p = gridExtra::grid.arrange(gridExtra::arrangeGrob(gridExtra::tableGrob(agpMetrics(), rows = NULL),
plotRanges(), ncol = 2), plotAGP(), plotDaily())
plot(p)
dev.off()
}
)
output$epsAGP <- downloadHandler(
filename = function() {
paste("AGP", '.eps', sep = '')
},
content = function(file) {
postscript(file)
p = gridExtra::grid.arrange(gridExtra::arrangeGrob(gridExtra::tableGrob(agpMetrics(), rows = NULL),
plotRanges(), ncol = 2), plotAGP(), plotDaily())
plot(p)
dev.off()
}
)
########## Episode calculation section#########
### Get desired subject
output$episode_subject <- renderUI({
data = transform_data() # bring reactive data input into this renderUI call to default to all subjects
subject = unique(data$id)[1]
textInput("episode_subject", "Enter Subject ID", value = subject)
})
episode_data <- reactive({ # define reactive function to subset data for plotting each time user changes subjects list
validate (
if (is.null(input$episode_subject)) {
need(!is.null(input$episode_subject), "Please wait - Rendering")
} else {
need(input$episode_subject %in% transform_data()$id, "Please check Subject ID")
}
)
data = transform_data()
data = data[data$id == input$episode_subject,] # reactively subset data when subjects input is modified
return(data)
})
plotEpisodeCalc <- reactive({
library(iglu)
data = episode_data()
lv1_hypo = input$lv1hypoThreshold
lv2_hypo = input$lv2hypoThreshold
lv1_hyper = input$lv1hyperThreshold
lv2_hyper = input$lv2hyperThreshold
dur_length = input$DurationLength
string = paste('iglu::epicalc_profile(data = data, lv1_hypo= lv1_hypo, lv2_hypo = lv2_hypo,
lv1_hyper=lv1_hyper,lv2_hyper=lv2_hyper, dur_length=dur_length)')
eval(parse(text = string))
})
output$plot_episode_calculation <- renderPlot({
plotEpisodeCalc()
})
output$pdfEpisode<- downloadHandler(
filename = function() {
paste("Episode", '.pdf', sep = '')
},
content = function(file) {
cairo_pdf(filename = file, width = 20, height = 18, bg = "transparent")
p = plotEpisodeCalc()
plot(p)
dev.off()
}
)
output$pngEpisode <- downloadHandler(
filename = function() {
paste("Episode", '.png', sep = '')
},
content = function(file) {
png(file)
p = plotEpisodeCalc()
plot(p)
dev.off()
}
)
output$epsEpisode <- downloadHandler(
filename = function() {
paste("Episode", '.eps', sep = '')
},
content = function(file) {
postscript(file)
p = plotEpisodeCalc()
plot(p)
dev.off()
}
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.