suppressMessages(library(IOHanalyzer))
suppressMessages(library(shiny))
suppressMessages(library(shinyjs))
suppressMessages(library(reshape2))
suppressMessages(library(magrittr))
suppressMessages(library(data.table))
suppressMessages(library(dplyr))
suppressMessages(library(plotly))
suppressMessages(library(shinydashboard))
suppressMessages(library(xtable))
suppressMessages(library(colourpicker))
suppressMessages(library(bsplus))
suppressMessages(library(DT))
suppressMessages(library(knitr))
suppressMessages(library(kableExtra))
# global options
options(datatable.print.nrows = 20)
options(width = 80)
options(shiny.maxRequestSize = 500 * 1024 ^ 2) # maximal upload file size
# for customized 'plotlyOutput' function -----
widget_html <- function(name, package, id, style, class, inline = FALSE, ...) {
# attempt to lookup custom html function for widget
fn <- tryCatch(get(paste0(name, "_html"),
asNamespace(package),
inherits = FALSE),
error = function(e) NULL)
# call the custom function if we have one, otherwise create a div
if (is.function(fn)) {
fn(id = id, style = style, class = class, ...)
} else if (inline) {
tags$span(id = id, style = style, class = class)
} else {
tags$div(id = id, style = style, class = class)
}
}
checkShinyVersion <- function(error = TRUE) {
x <- utils::packageDescription('htmlwidgets', fields = 'Enhances')
r <- '^.*?shiny \\(>= ([0-9.]+)\\).*$'
if (is.na(x) || length(grep(r, x)) == 0 || system.file(package = 'shiny') == '')
return()
v <- gsub(r, '\\1', x)
f <- if (error) stop else packageStartupMessage
if (utils::packageVersion('shiny') < v)
f("Please upgrade the 'shiny' package to (at least) version ", v)
}
widget_dependencies <- function(name, package){
htmlwidgets::getDependency(name, package)
}
plotlyOutput.IOHanalyzer <- function(outputId, width = '100%', aspect_ratio = 16/10) {
padding_bottom <- paste0(100 / aspect_ratio, '%')
reportSize <- TRUE
inline <- FALSE
checkShinyVersion()
html <- htmltools::tagList(
widget_html('plotly', 'plotly', id = outputId,
class = paste0('plotly', " html-widget html-widget-output",
if (reportSize)
" shiny-report-size"),
style = sprintf("width:%s; height: 0; padding-bottom:%s; %s",
htmltools::validateCssUnit(width),
htmltools::validateCssUnit(padding_bottom),
if (inline)
"display: inline-block;"
else ""),
width = width, height = 0)
)
dependencies <- widget_dependencies('plotly', 'plotly')
htmltools::attachDependencies(html, dependencies)
}
# markers for plotly
symbols <- c("circle-open", "diamond-open", "square-open", "cross-open",
"triangle-up-open", "triangle-down-open")
# ploting settings for UI ---------------------
plotly_height <- "auto"
plotly_width <- "auto"
plotly_height2 <- "auto"
plotly_width2 <- "auto"
IOHprofiler <- 'IOHprofiler'
COCO <- 'COCO'
TWO_COL <- 'TWO_COL'
AUTOMATIC <- 'AUTOMATIC'
BIBOJ_COCO <- 'BIBOJ_COCO'
NEVERGRAD <- 'NEVERGRAD'
# directory where rds-data is stored
get_repo_location <- function() {
repo_dir <- paste0(file.path(Sys.getenv('HOME'), 'repository'))
if (!is.null(getOption("IOHprofiler.repo_dir"))) {
repo_dir <- getOption("IOHprofiler.repo_dir")
}
if (file.exists(repo_dir)) repo_dir else ''
}
print_html <- function(s, widget_id = 'process_data_promt')
shinyjs::html(widget_id, s, add = TRUE)
# download file names: csv, image ---------------------
AUC_ECDF_aggr_name <- parse(text = "paste0('AUC_ECDF_MULTI.', input$RTECDF.AUC.Table.Format)")
AUC_EAF_ECDF_aggr_name <- parse(text = "paste0('AUC_EAF.', input$EAF.AUC.Table.Format)")
overview_single_name <- parse(text = "paste0('Overview-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$Overview.Single.Format)")
overview_all_name <- parse(text = "paste0('Overview-All-', '.', input$Overview.All.Format)")
RT_csv_name <- parse(text = "paste0('RTStats-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RTSummary.Statistics.Format)")
RT_overview_name <- parse(text = "paste0('RTOverview-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RTSummary.Overview.Format)")
RTSample_csv_name <- parse(text = "paste0('RTSample-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RTSummary.Sample.Format)")
FV_csv_name <- parse(text = "paste0('FVStats-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$FCESummary.Statistics.Format)")
FV_overview_name <- parse(text = "paste0('FVOverview-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$FCESummary.Overview.Format)")
FVSample_csv_name <- parse(text = "paste0('FVSample-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$FCESummary.Sample.FileFormat)")
FV_PAR_csv_name <- parse(text = "paste0('PARSummary-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$FV_PAR.Summary.Format)")
FV_PARSample_csv_name <- parse(text = "paste0('PARSample-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$FV_PAR.Sample.FileFormat)")
RT_PAR_csv_name <- parse(text = "paste0('PARSummary-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RT_PAR.Summary.Format)")
RT_PARSample_csv_name <- parse(text = "paste0('PARSample-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RT_PAR.Sample.FileFormat)")
ERT_multi_func_name <- parse(text = "paste0('MultiERT-', paste0(input$Overall.Dim, 'D'),
'.', input$ERTPlot.Aggr.TableFormat)")
ERT_multi_dim_name <- parse(text = "paste0('MultiERT-', paste0('F', input$Overall.Funcid),
'.', input$ERTPlot.Aggr_Dim.TableFormat)")
FCE_multi_func_name <- parse(text = "paste0('MultiFCE-', paste0(input$Overall.Dim, 'D'),
'.', input$FCEPlot.Aggr.TableFormat)")
RT_Glicko2_table_name <- parse(text = "paste0('RT_Glicko2', '.', input$RT_Stats.Glicko.TableFormat)")
RT_Glicko2_figure_name <- parse(text = "paste0('RT_Glicko2', '.', input$RT_Stats.Glicko.Format)")
FV_Glicko2_table_name <- parse(text = "paste0('FV_Glicko2', '.', input$FV_Stats.Glicko.TableFormat)")
FV_Glicko2_figure_name <- parse(text = "paste0('FV_Glicko2', '.', input$FV_Stats.Glicko.Format)")
RT_DSC_table_name <- parse(text = "paste0('RT_DSC', '.', input$RT_Stats.DSC.TableFormat)")
RT_DSC_figure_name <- parse(text = "paste0('RT_DSC', '.', input$RT_Stats.DSC.Format)")
RT_DSC_figure_name_rank <- parse(text = "paste0('RT_DSC_PerformViz', '.', input$RT_Stats.DSC.Format_rank)")
RT_DSC_table_name_rank <- parse(text = "paste0('RT_DSC_Rank', '.', input$RT_Stats.DSC.TableFormat_rank)")
FV_DSC_table_name <- parse(text = "paste0('FV_DSC', '.', input$FV_Stats.DSC.TableFormat)")
FV_DSC_figure_name <- parse(text = "paste0('FV_DSC', '.', input$FV_Stats.DSC.Format)")
FV_DSC_figure_name_rank <- parse(text = "paste0('FV_DSC_PerformViz', '.', input$FV_Stats.DSC.Format_rank)")
FV_DSC_table_name_rank <- parse(text = "paste0('FV_DSC_Rank', '.', input$FV_Stats.DSC.TableFormat_rank)")
RT_Stats_table_name <- parse(text = "paste0('RT_Stat_Comp-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RT_Stats.Overview.TableFormat)")
RT_Stats_heatmap_name <- parse(text = "paste0('RT_Stat_Heatmap-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RT_Stats.Overview.Format)")
RT_Stats_network_name <- parse(text = "paste0('RT_Stat_Network-', paste0(input$Overall.Dim, 'D'),
paste0('F', input$Overall.Funcid), '.', input$RT_Stats.Overview.Format)")
RT_multifunc_ERT <- parse(text = "paste0('ERT_Table_Multi', '.', input$RT.MultiERT.Format)")
RT_multifunc_sample <- parse(text = "paste0('Sample_Table_Multi', '.', input$RT.MultiSample.Format)")
FV_multifunc_FV <- parse(text = "paste0('FV_Table_Multi', '.', input$FV.MultiFV.Format)")
FV_multifunc_sample <- parse(text = "paste0('Sample_Table_Multi_FV', '.', input$FV.MultiSample.Format)")
# max_samples <- 100
FIG_NAME_ERT_PER_FUN <- parse(text = "paste0('ERT-', Sys.Date(), '.', input$ERTPlot.Format)")
FIG_NAME_ERT_PER_FUN_MULTI <- parse(text = "paste0('ERT_Mult-', Sys.Date(), '.', input$ERTPlot.Multi.Format)")
FIG_NAME_ERT_AGGR <- parse(text = "paste0('ERT_Aggr-', Sys.Date(), '.', input$ERTPlot.Aggr.Format)")
FIG_NAME_ERT_AGGR_DIM <- parse(text = "paste0('ERT_Aggr_Dim-', Sys.Date(), '.', input$ERTPlot.Aggr_Dim.Format)")
FIG_NAME_RT_PMF <- parse(text = "paste0('RT_PMF-', Sys.Date(), '.', input$RTPMF.Bar.Format)")
FIG_NAME_RT_HIST <- parse(text = "paste0('RT_HIST-', Sys.Date(), '.', input$RTPMF.Hist.Format)")
FIG_NAME_RT_CDP <- parse(text = "paste0('RT_CDP-', Sys.Date(), '.', input$RTPMF.CDP.Format)")
FIG_NAME_RT_ECDF_AGGR <- parse(text = "paste0('RT_ECDF_AGGR-', Sys.Date(), '.', input$RTECDF.Multi.Format)")
FIG_NAME_RT_ECDF_MULT <- parse(text = "paste0('RT_ECDF_MULT-', Sys.Date(), '.', input$RTECDF.Aggr.Format)")
FIG_NAME_RT_AUC <- parse(text = "paste0('RT_AUC-', Sys.Date(), '.', input$RTECDF.AUC.Format)")
FIG_NAME_FV_PER_FUN <- parse(text = "paste0('FV-', Sys.Date(), '.', input$FCEPlot.Format)")
FIG_NAME_FV_PER_FUN_MULTI <- parse(text = "paste0('FCE_Mult-', Sys.Date(), '.', input$FCEPlot.Multi.Format)")
FIG_NAME_FV_AGGR <- parse(text = "paste0('FCE_Aggr-', Sys.Date(), '.', input$FCEPlot.Aggr.Format)")
FIG_NAME_FV_PDF <- parse(text = "paste0('FV_PMF-', Sys.Date(), '.', input$FCEPDF.Bar.Format)")
FIG_NAME_FV_HIST <- parse(text = "paste0('FV_HIST-', Sys.Date(), '.', input$FCEPDF.Hist.Format)")
FIG_NAME_FV_CDP <- parse(text = "paste0('FV_CDP-', Sys.Date(), '.', input$FCEPDF.CDP.Format)")
FIG_NAME_FV_ECDF_SINGLE <- parse(text = "paste0('FV_ECDF_Single-', Sys.Date(), '.', input$FCEECDF.Single.Format)")
FIG_NAME_FV_ECDF_AGGR <- parse(text = "paste0('FV_ECDF_AGGR-', Sys.Date(), '.', input$FCEECDF.Mult.Format)")
FIG_NAME_FV_AUC <- parse(text = "paste0('FV_AUC-', Sys.Date(), '.', input$FCEECDF.AUC.Format)")
FIG_NAME_RT_PAR_PER_FUN <- parse(text = "paste0('RT_PAR-', Sys.Date(), '.', input$RT_PAR.Plot.Format)")
FIG_NAME_FV_PAR_PER_FUN <- parse(text = "paste0('FV_PAR-', Sys.Date(), '.', input$FV_PAR.Plot.Format)")
FIG_NAME_RT_SHAPLEY <- parse(text = "paste0('RT-Shapley-', Sys.Date(), '.', input$RTportfolio.Shapley.Format)")
RT_NG_heatmap_name <- parse(text = "paste0('RT-NG_Heatmap-', Sys.Date(), '.', input$RT_NG.Heatmap.Format)")
FV_NG_heatmap_name <- parse(text = "paste0('FV-NG_Heatmap-', Sys.Date(), '.', input$FV_NG.Heatmap.Format)")
FIG_NAME_EAF <- parse(text = "paste0('EAF-', Sys.Date(), '.', input$EAF.Single.Format)")
FIG_NAME_EAFCDF <- parse(text = "paste0('EAFCDF-', Sys.Date(), '.', input$EAF.CDF.Format)")
FIG_NAME_EAFDiff <- parse(text = "paste0('EAFDiff-', Sys.Date(), '.', input$EAF.Diff.Format)")
FIG_NAME_EAFMultiCDF <- parse(text = "paste0('EAF_multiCDF-', Sys.Date(), '.', input$EAF.MultiCDF.Format)")
AUC_ECDFEAF_aggr_name <- parse(text = "paste0('AUC_ECDFEAF_MULTI.', input$RTECDF.AUC.Table.Format)")
# ID of the control widget, whose current value should de always recorded and restored ----
# those control widget are switched on and off
widget_id <- c('RTSummary.Statistics.Min',
'RTSummary.Statistics.Max',
'RTSummary.Statistics.Step',
'RTSummary.Sample.Min',
'RTSummary.Sample.Max',
'RTSummary.Sample.Step',
'RTECDF.Multi.Min',
'RTECDF.Multi.Max',
'RTECDF.Multi.Step',
'RTECDF.Single.Target',
'RTPMF.Bar.Target',
'RTPMF.Hist.Target',
'ERTPlot.Min',
'ERTPlot.Max',
'ERTPlot.Aggr.Targets',
'RTECDF.AUC.Min',
'RTECDF.AUC.Max',
'RTECDF.AUC.Step',
'FV_PAR.Plot.Min',
'FV_PAR.Plot.Max',
'FV_PAR.Summary.Min',
'FV_PAR.Summary.Max',
'FV_PAR.Summary.Step',
'FV_PAR.Sample.Min',
'FV_PAR.Sample.Max',
'FV_PAR.Sample.Step',
'RT_PAR.Plot.Min',
'RT_PAR.Plot.Max',
'RT_PAR.Summary.Min',
'RT_PAR.Summary.Max',
'RT_PAR.Summary.Step',
'RT_PAR.Sample.Min',
'RT_PAR.Sample.Max',
'RT_PAR.Sample.Step',
'FCESummary.Statistics.Min',
'FCESummary.Statistics.Max',
'FCESummary.Statistics.Step',
'FCESummary.Sample.Min',
'FCESummary.Sample.Max',
'FCESummary.Sample.Step',
'FCEPDF.Hist.Runtime',
'FCEPDF.CDP.Runtime',
'FCEPDF.Bar.Runtime',
'FCEPlot.Min',
'FCEPlot.Max',
'FCEECDF.Mult.Min',
'FCEECDF.Mult.Max',
'FCEECDF.Mult.Step',
'FCEECDF.AUC.Min',
'FCEECDF.AUC.Max',
'FCEECDF.AUC.Step',
'FCEECDF.Single.Target',
'EAF.Single.Min',
'EAF.Single.Max',
'EAF.Single.yMin',
'EAF.Single.yMax',
'EAF.CDF.yMin',
'EAF.CDF.yMax',
'EAF.Diff.yMin',
'EAF.Diff.yMax'
)
eventExpr <- parse(text = paste0('{', paste(paste0('input$', widget_id), collapse = "\n"), '}'))
# Supported formats table
supported_table_format <- c("csv", "tex", "md", "html")
# token needed for mapbox, which is again needed for ocra... ------
supported_fig_format <- c('pdf', 'png', 'eps', 'svg')
Sys.setenv('MAPBOX_TOKEN' = 'pk.eyJ1Ijoid2FuZ3JvbmluIiwiYSI6ImNqcmIzemhvMDBudnYzeWxoejh5c2Y5cXkifQ.9XGMWTDOsgi3-b5qG594kQ')
sanity_check_id <- function(input) {
for (id in widget_id) {
tryCatch(eval(parse(text = paste0('input$', id))),
error = function(e) {
cat(paste('widget', id, 'does not exist!\n'))
})
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.