for (f in list.files('ui', pattern = '.R', full.names = T)) {
source(f)
}
# NOTE: this is copied from `shinydashboard`
#' Assert that a tag has specified properties
#' @param tag A tag object.
#' @param type The type of a tag, like "div", "a", "span".
#' @param class An HTML class.
#' @param allowUI If TRUE (the default), allow dynamic outputs generated by
#' \code{\link[shiny]{uiOutput}} or \code{\link[shiny]{htmlOutput}}. When a
#' dynamic output is provided, \code{tagAssert} won't try to validate the the
#' contents.
#' @keywords internal
tagAssert <- function(tag, type = NULL, class = NULL, allowUI = TRUE) {
if (!inherits(tag, "shiny.tag")) {
print(tag)
stop("Expected an object with class 'shiny.tag'.")
}
# Skip dynamic output elements
if (allowUI &&
(hasCssClass(tag, "shiny-html-output") ||
hasCssClass(tag, "shinydashboard-menu-output"))) {
return()
}
if (!is.null(type) && tag$name != type) {
stop("Expected tag to be of type ", type)
}
if (!is.null(class)) {
if (is.null(tag$attribs$class)) {
stop("Expected tag to have class '", class, "'")
} else {
tagClasses <- strsplit(tag$attribs$class, " ")[[1]]
if (!(class %in% tagClasses)) {
stop("Expected tag to have class '", class, "'")
}
}
}
}
# Modified dashboard header from the original source for incorporating two `select input` widgets
.dashboardHeader <- function(..., title = NULL, titleWidth = NULL, disable = FALSE, .list = NULL) {
items <- c(list(...), .list)
lapply(items, tagAssert, type = "li", class = "dropdown")
titleWidth <- validateCssUnit(titleWidth)
# Set up custom CSS for custom width.
custom_css <- NULL
if (!is.null(titleWidth)) {
# This CSS is derived from the header-related instances of '230px' (the
# default sidebar width) from inst/AdminLTE/AdminLTE.css. One change is that
# instead making changes to the global settings, we've put them in a media
# query (min-width: 768px), so that it won't override other media queries
# (like max-width: 767px) that work for narrower screens.
custom_css <- tags$head(
tags$style(
HTML(
gsub(
"_WIDTH_", titleWidth, fixed = TRUE, '
@media (min-width: 768px) {
.main-header > .navbar {
margin-left: _WIDTH_;
}
.main-header .logo {
width: _WIDTH_;
}
}'
)
)
)
)
}
tags$header(
class = "main-header",
id = 'header',
custom_css,
style = if (disable) "display: none;",
span(class = "logo", title),
tags$nav(
class = "navbar navbar-static-top", role = "navigation",
# Embed hidden icon so that we get the font-awesome dependency
span(shiny::icon("bars"), style = "display:none;"),
# Sidebar toggle button
a(
href="#", class="sidebar-toggle", `data-toggle`="offcanvas",
role="button", span(class="sr-only", "Toggle navigation")
),
# select inputs for dimension and function/problem ID
# HTML('
# <div class="col-sm-1">
# </div>
# <table class=".table">
# <tr>
# <td>
# <b>Dimension:</b>
# <select id="Overall.Dim" style="width: 100px; margin: 7px 20px 5px 1px;">
# </select>
# </td>
# <td>
# <b>Problem ID:</b>
# <select id="Overall.Funcid" style="width: 100px; margin: 7px 20px 5px 1px;">
# </select>
# </td>
# </tr>
# </table>'
# ),
div(
class = "navbar-custom-menu",
tags$ul(class = "nav navbar-nav", items)
)
)
)
}
header <- .dashboardHeader(title = HTML('<div align="center"><b>IOHanalyzer</b></div>'))
# The side bar layout ---------------------------------------------
sidebar <- dashboardSidebar(
tags$style(
"#sidebarItemExpanded {
overflow: auto;
max-height: 100vh;
}"
),
useShinyjs(),
sidebar_menu(),
hr(),
DIM_fID_panel()
)
body <- dashboardBody(
tags$style(
HTML('
.popover-title {color:black;}
.popover-content {color:black;}
.main-sidebar {z-index:auto;}
.fa-exclamation-triangle {color:#E87722}
.sticky {
position: fixed;
top: 0;
width: 100%;
}
.sticky2 {
position: fixed;
}
.table {
border-collapse: collapse;
width: 100%;
}
.table td, tr {
padding: 0px;
margin: 0px;
vertical-align: middle;
height: 45px;
}
.table th {height: 0px;}'
)
),
# to show text on the header (heading banner)
tags$head(
tags$style(
HTML('
.myClass {
font-size: 20px;
line-height: 50px;
text-align: left;
font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
padding: 0 15px;
overflow: hidden;
color: white;
}'
)
)
),
tags$head(
tags$style(
HTML(
'.box-title {
font-size: 20px;
line-height: 50px;
text-align: left;
font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
padding: 0 15px;
overflow: hidden;
color: white;
}'
)
)
),
tags$head(
tags$style(
HTML(
"label { font-size:120%; }"
)
)
),
tags$script(
HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<span class="myClass">Performance Evaluation for Iterative
Optimization Heuristics</span>\');
})'
)
),
tags$script(
"Shiny.addCustomMessageHandler('background-color',
function(color) {
document.body.style.backgroundColor = color;
document.body.innerText = color;
});"
),
tags$script(
HTML('
window.setInterval(function() {
var elem = document.getElementById("process_data_promt");
if (typeof elem !== "undefined" && elem !== null) elem.scrollTop = elem.scrollHeight;
}, 20);'
)
),
tags$head(
tags$script(
HTML("
Shiny.addCustomMessageHandler('manipulateMenuItem', function(message){
var aNodeList = document.getElementsByTagName('a');
for (var i = 0; i < aNodeList.length; i++) {
if(aNodeList[i].getAttribute('data-value') == message.tabName || aNodeList[i].getAttribute('href') == message.tabName) {
if(message.action == 'hide'){
aNodeList[i].setAttribute('style', 'display: none;');
} else {
aNodeList[i].setAttribute('style', 'display: block;');
};
};
}
});
")
)
),
# make the data uploading prompt always scroll to the bottom
tags$script(
HTML('
window.setInterval(function() {
var elem = document.getElementById("upload_data_promt");
if (typeof elem !== "undefined" && elem !== null) elem.scrollTop = elem.scrollHeight;
}, 20);'
)
),
# render the header and the side bar 'sticky'
tags$script(
HTML(
'// When the user scrolls the page, execute myFunction
window.onscroll = function() {myFunction()};
// Get the header
var header = document.getElementById("header");
// Get the side bar
var sideBar = document.getElementById("sidebarCollapsed");
sideBar.classList.add("sticky2");
// Get the offset position of the navbar
var sticky = header.offsetTop;
// Add the sticky class to the header when you reach its scroll position.
// Remove "sticky" when you leave the scroll position
function myFunction() {
if (window.pageYOffset > sticky) {
header.classList.add("sticky");
} else {
header.classList.remove("sticky");
}
}'
)
),
# load MathJax
# TODO: download MathJax and its license and include it in our package
HTML("<head><script src='https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.4/MathJax.js?config=TeX-MML-AM_CHTML'
async></script></head>"),
use_bs_tooltip(),
use_bs_popover(),
# tabitems ----------------------
tabItems(
tabItem(tabName = 'about', includeMarkdown('markdown/about.md')),
# tabItem(tabName = 'dataformat', includeMarkdown('markdown/dataformat.md')),
# data uploading functionalities -----------------
tabItem(
tabName = 'upload',
fluidRow(
welcome_bar(width = 12)
),
fluidRow(
column(
width = 6,
upload_box(collapsible = F)
),
column(
width = 6,
overal_loading_box(collapsible = F)
)
# column(
# width = 4,
# ontology_box(collapsible = F)
# ),
),
fluidRow(
column(
width = 6,
upload_prompt_box(collapsible = F)
),
column(
width = 6,
data_list_box(collapsible = F)
)
)
),
# General data overview ----------------------
tabItem(
tabName = 'overview',
fluidRow(
column(
width = 12,
general_overview_box_all(collapsed = F),
general_overview_box_single(collapsed = F)
)
)
),
# RT (RunTime): Data Summary -----------------
tabItem(
tabName = 'ERT_data',
fluidRow(
column(
width = 12,
rt_overview_box(collapsed = F),
rt_stats_box(collapsed = F),
rt_sample_box()
)
)
),
# RT: Expected Convergence Curve ---------------------------------------------
tabItem(
tabName = 'ERT_convergence_single',
fluidRow(
column(
width = 12,
ERT_box(collapsed = F),
ERT_comparison_box_dim()
)
)
),
tabItem(
tabName = 'ERT_convergence_aggr',
fluidRow(
column(
width = 12,
ERT_agg_box(collapsed = F),
ERT_comparison_box(collapsed = T)
)
)
),
# RT: histograms, violin plots ------------------------------------------
tabItem(
tabName = 'RT_PMF',
fluidRow(
column(
width = 12,
rt_histogram_box(collapsed = F),
rt_pmf_box(),
rt_CDP_box()
)
)
),
# RT ECDF ------------------------------------------
tabItem(
tabName = 'RT_ECDF_single',
fluidRow(
column(
width = 12,
rt_ecdf_single_target_box(collapsed = F),
rt_ecdf_agg_targets_box()
# rt_ecdf_auc_box()
)
)
),
tabItem(
tabName = 'RT_ECDF_aggr',
fluidRow(
column(
width = 12,
rt_ecdf_agg_fct_box(collapsed = F)
)
)
),
# Parameter tab -------
tabItem(
tabName = 'RT_PARAMETER',
fluidRow(
column(
width = 12,
rt_par_summary_box(collapsed = F),
rt_par_expected_value_box(),
rt_par_sample_box()
)
)
),
tabItem(
tabName = 'RT_Statistics_single',
fluidRow(
column(
width = 12,
rt_heatmap_box()
)
)
),
tabItem(tabName = 'RT_DSC',
fluidRow(
column(
width = 12,
rt_dsc_box_rank(),
rt_dsc_box_omni(),
rt_dsc_box_posthoc()
)
)
),
tabItem(tabName = 'RT_Statistics_aggr',
fluidRow(
column(
width = 12,
fv_nevergrad_box(collapsed = F),
rt_glicko2_box(collapsed = T)
)
)
),
tabItem(tabName = 'RT_table_multi',
fluidRow(
column(
width = 12,
multi_function_ert_box(collapsed = F),
multi_function_sample_box(collapsed = T)
)
)
),
tabItem(tabName = 'RT_portfolio',
fluidRow(
column(
width = 12,
rt_shapleys_box(collapsed = F)
)
)
),
# FCE: Data Summary -----------------
tabItem(
tabName = 'FCE_DATA',
fluidRow(
column(
width = 12,
fv_overview_box(collapsed = F),
fv_stats_box(collapsed = F),
fv_sample_box()
)
)
),
# FCE: Expected Convergence Curve ---------------------------------------------
tabItem(
tabName = 'FCE_convergence_single',
fluidRow(
column(
width = 12,
fv_per_fct_box(collapsed = F)
)
)
),
tabItem(
tabName = 'FCE_convergence_aggr',
fluidRow(
column(
width = 12,
fv_agg_box(collapsed = F),
fv_comparison_box()
)
)
),
# FCE: historgrams, p.d.f. --------
tabItem(
tabName = 'FCE_PDF',
fluidRow(
column(
width = 12,
fv_histgram_box(collapsed = F),
fv_pdf_box(),
fv_CDP_box(collapsed = T)
)
)
),
# FCE: empirical c.d.f. ------------------------------------------
tabItem(
tabName = 'FCE_ECDF',
fluidRow(
column(
width = 12,
fv_ecdf_single_budget_box(collapsed = F),
fv_ecdf_agg_budgets_box(),
fv_ecdf_auc_box()
)
)
),
# Parameter tab -------
tabItem(
tabName = 'FCE_PARAMETER',
fluidRow(
column(
width = 12,
fv_par_expected_value_box(collapsed = F),
fv_par_summary_box(),
par_scatter_box(collapsed = T),
fv_par_sample_box()
)
)
),
tabItem(
tabName = 'FCE_Statistics_single',
fluidRow(
column(
width = 12,
fv_heatmap_box(collapsed = F)
)
)
),
tabItem(tabName = 'FV_table_multi',
fluidRow(
column(
width = 12,
multi_function_fv_box(collapsed = F),
multi_function_sample_box_fv(collapsed = T)
)
)
),
tabItem(tabName = 'FCE_DSC',
fluidRow(
column(
width = 12,
fv_dsc_box_rank(),
fv_dsc_box_omni(),
fv_dsc_box_posthoc()
)
)
),
tabItem(tabName = 'FCE_Statistics_aggr',
fluidRow(
column(
width = 12,
rt_nevergrad_box(collapsed = F),
fv_glicko2_box(collapsed = T)
)
)
),
tabItem(tabName = 'Positions',
fluidRow(
column(
width = 12,
Par_coord_box()
)
)
),
tabItem(tabName = 'EAF',
fluidRow(
column(
width = 12,
EAF_box()
)
)
),
tabItem(tabName = 'EAF_Diff',
fluidRow(
column(
width = 12,
EAF_Diff_box()
)
)
),
tabItem(tabName = 'EAF_CDF',
fluidRow(
column(
width = 12,
EAF_CDF_box()
)
)
),
tabItem(tabName = 'EAF_mult',
fluidRow(
column(
width = 12,
EAF_mult_box()
)
)
),
tabItem(tabName = 'EAF_CDF_mult',
fluidRow(
column(
width = 12,
EAF_CDF_mult_box()
)
)
),
tabItem(
tabName = 'Settings',
fluidRow(
column(
width = 12,
color_settings_box(),
general_settings_box()
)
)
)
# tabItem(tabName = 'Report',
# fluidRow(
# column(
# width = 12,
# main_report_box()
# )
# )
# )
)
)
# -----------------------------------------------------------
dashboardPage(title = 'IOHanalyzer', header, sidebar, body)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.