Skip to content

Commit

Permalink
Improve renderer performance
Browse files Browse the repository at this point in the history
  • Loading branch information
@rschuchmann
rschuchmann committed Apr 15, 2024
1 parent d62e08a commit 43131a4
Show file tree
Hide file tree
Showing 2 changed files with 215 additions and 224 deletions.
226 changes: 114 additions & 112 deletions renderer_times_miro/mirocompare_explorer.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N

if (length(numericColumnNames) > 1) {
viewData <- viewData %>%
pivot_longer(cols = numericColumnNames,
pivot_longer(cols = all_of(numericColumnNames),
names_to = "Hdr",
values_to = "value")
}
Expand Down Expand Up @@ -1210,19 +1210,13 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N

# apply custom labels
if (length(config$chartOptions$customLabels)) {
labelCols <- dataTmp[, sapply(dataTmp, class) == 'character']
for (i in seq_len(nrow(dataTmp))) {
for (j in seq_len(length(labelCols))) {
if (is.na(dataTmp[[i, j]])) {
next
}
for (key in names(config$chartOptions$customLabels)) {
if (dataTmp[[i, j]] == key) {
dataTmp[[i, j]] <- config$chartOptions$customLabels[[key]]
break
}
}
}
labelCols <- dataTmp[, sapply(dataTmp, class) == "character"]
for (col in seq_len(length(labelCols))) {
dataTmp[[col]] <- ifelse(
dataTmp[[col]] %in% names(config$chartOptions$customLabels),
config$chartOptions$customLabels[dataTmp[[col]]],
dataTmp[[col]]
)
}
}

Expand Down Expand Up @@ -1287,24 +1281,76 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N
sum(numericCols) > 1
}

dashboardChartData <- list()
getData <- function(indicator) {
noRowHeaders <- attr(dashboardChartData[[indicator]], "noRowHeaders")
dataTmp <- dashboardChartData[[indicator]]
if (length(dataViewsConfig[[indicator]]$decimals)) {
dataTmp <- dataTmp %>%
mutate(across(where(is.numeric), ~ round(., as.numeric(dataViewsConfig[[indicator]]$decimals))))
}

# filter user selection
if (length(dataViewsConfig[[indicator]]$userFilter)) {
indicatorTmp <- indicator
if (length(dataViewsConfig[[indicator]]$userFilter) == 1 &&
dataViewsConfig[[indicator]]$userFilter %in% names(dataViewsConfig)) {
indicatorTmp <- dataViewsConfig[[indicator]]$userFilter
}

for (filterName in dataViewsConfig[[indicatorTmp]]$userFilter) {
if (length(input[[paste0(indicatorTmp, "userFilter_", filterName)]])) {
filterEl <- input[[paste0(indicatorTmp, "userFilter_", filterName)]]
if (filterName %in% names(dataViewsConfig[[indicator]]$cols)) {
dataTmp <- dataTmp %>%
select(
seq_len(noRowHeaders),
(any_of(filterEl) |
contains(paste0("\U2024", filterEl, "\U2024")) |
starts_with(paste0(filterEl, "\U2024")) |
ends_with(paste0("\U2024", filterEl)))
)
} else {
dataTmp <- dataTmp %>%
filter(!!rlang::sym(filterName) %in% filterEl)
}
}
}
}
return(dataTmp)
}

dashboardChartData <- list()
currentConfig <- c()
for (view in names(dataViewsConfig)) {
config <- dataViewsConfig[[view]]
if (!is.list(dataViewsConfig[[view]])) {
# custom user output
next
}
# Check whether last view uses same data as current one
if (length(currentConfig) &&
identical(
currentConfig[setdiff(names(currentConfig), c("pivotRenderer", "decimals"))],
dataViewsConfig[[view]][setdiff(names(dataViewsConfig[[view]]), c("pivotRenderer", "decimals"))]
)) {
dashboardChartData[[view]] <- preparedData
next
}

currentConfig <- dataViewsConfig[[view]]

if (!is.null(config$data)) {
viewData <- combineData(data$get(config$data), scenarioNames)
if (!is.null(currentConfig$data)) {
viewData <- combineData(data$get(currentConfig$data), scenarioNames)
} else {
viewData <- cubeoutputData
}

# Scenario columns need to be lengthened to only have one value column
viewData <- viewData %>%
pivot_longer(cols = scenarioNames,
pivot_longer(cols = all_of(scenarioNames),
names_to = "_scenName",
values_to = "value")

preparedData <- prepareData(config, viewData)
preparedData <- prepareData(currentConfig, viewData)
dashboardChartData[[view]] <- preparedData
}

Expand Down Expand Up @@ -1655,31 +1701,8 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N
return()
}

dataTmp <- dashboardChartData[[indicator]]
if(length(dataViewsConfig[[indicator]]$decimals)){
dataTmp <- dataTmp %>%
mutate(across(where(is.numeric), ~ round(., as.numeric(dataViewsConfig[[indicator]]$decimals))))
}

#filter user selection
if (length(dataViewsConfig[[indicator]]$userFilter)) {
for (filterName in dataViewsConfig[[indicator]]$userFilter) {
if(length(input[[paste0(indicator, "userFilter_", filterName)]])) {
filterEl <- input[[paste0(indicator, "userFilter_", filterName)]]
if(filterName %in% names(dataViewsConfig[[indicator]]$cols)) {
dataTmp <- dataTmp %>%
select(1:as.numeric(attr(dashboardChartData[[indicator]], "noRowHeaders")),
(matches(paste0("^", filterEl, "$")) |
contains(paste0(filterEl, "\U2024")) |
contains(paste0("\U2024", filterEl)))
)
} else {
dataTmp <- dataTmp %>%
filter(!!rlang::sym(filterName) %in% filterEl)
}
}
}
}
dataTmp <- getData(indicator)
noRowHeaders <- attr(dashboardChartData[[indicator]], "noRowHeaders")

# Table Summary
colSummarySettings <- NULL
Expand Down Expand Up @@ -1746,18 +1769,19 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N
rownames = FALSE,
container = DTbuildColHeaderContainer(
names(dataTmp),
attr(dashboardChartData[[indicator]], "noRowHeaders"),
unlist(nonNumericCols[names(dataTmp)[seq_len(attr(dashboardChartData[[indicator]], "noRowHeaders"))]],
use.names = FALSE
),
noRowHeaders,
nonNumericCols,
colSummary = colSummarySettings
),
options = list(paging = FALSE, dom = 't',
scrollX = TRUE,
scrollY = "35vh",
columnDefs = list(list(
className = 'dt-left', targets = "_all"
)))
options = list(
paging = FALSE, dom = "t",
scrollX = TRUE,
scrollY = "35vh",
scrollCollapse = TRUE,
columnDefs = list(list(
className = "dt-left", targets = "_all"
))
)
)
})

Expand Down Expand Up @@ -1786,40 +1810,17 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N

# charts output
output[[paste0(indicator, "Chart")]] <- chartjs::renderChartjs({

dataTmp <- dashboardChartData[[indicator]]
if(length(dataViewsConfig[[indicator]]$decimals)){
dataTmp <- dataTmp %>%
mutate(across(where(is.numeric), ~ round(., as.numeric(dataViewsConfig[[indicator]]$decimals))))
}

#filter user selection
if (length(dataViewsConfig[[indicator]]$userFilter)) {
for (filterName in dataViewsConfig[[indicator]]$userFilter) {
if(length(input[[paste0(indicator, "userFilter_", filterName)]])) {
filterEl <- input[[paste0(indicator, "userFilter_", filterName)]]
if(filterName %in% names(dataViewsConfig[[indicator]]$cols)) {
dataTmp <- dataTmp %>%
select(1:as.numeric(attr(dashboardChartData[[indicator]], "noRowHeaders")),
(matches(paste0("^", filterEl, "$")) |
contains(paste0(filterEl, "\U2024")) |
contains(paste0("\U2024", filterEl)))
)
} else {
dataTmp <- dataTmp %>%
filter(!!rlang::sym(filterName) %in% filterEl)
}
}
}
}
dataTmp <- getData(indicator)

chartType <- tolower(input[[paste0(indicator, "ChartType")]])
currentView <- dataViewsConfig[[indicator]]

if (!nrow(dataTmp) ||
!chartType %in%
c("line", "scatter", "area", "stackedarea", "bar",
"stackedbar", "radar", "timeseries")) {
c(
"line", "scatter", "area", "stackedarea", "bar",
"stackedbar", "radar", "timeseries"
)) {
return()
}

Expand All @@ -1835,6 +1836,7 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N
if (length(currentView$chartOptions$customChartColors) &&
length(names(currentView$chartOptions$customChartColors))) {
# custom chart colors specified

colorLabels <- names(currentView$chartOptions$customChartColors)
colorLabelsNew <- colorLabels
if (length(currentView$chartOptions$customLabels)) {
Expand Down Expand Up @@ -1949,13 +1951,13 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N
}

# Fit chart to screen
chartJsObj$x$options$maintainAspectRatio = FALSE
chartJsObj$x$options$maintainAspectRatio <- FALSE

# set locale for '.' as decimal sign
chartJsObj$x$options$locale = "en-US"
chartJsObj$x$options$locale <- "en-US"

# enable zoom
chartJsObj$x$options$plugins$zoom = list(
chartJsObj$x$options$plugins$zoom <- list(
zoom = list(
wheel = list(
enabled = TRUE
Expand All @@ -1977,33 +1979,33 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N

# download buttons: png & csv
output[[paste0(indicator, "DownloadButtons")]] <- renderUI({

canvasId <- paste0(indicator, "Chart")

tagList(
tags$div(class = " dashboard-btn-wrapper",
tags$a(
id = ns(paste0(indicator, "DownloadCsv")),
class = "btn btn-default btn-custom pivot-btn-custom shiny-download-link dashboard-btn dashboard-btn-csv",
href = "",
target = "_blank",
download = NA,
tags$div(
tags$i(class = "fa fa-file-csv")
),
title = lang$renderers$miroPivot$btDownloadCsv
),
tags$a(
id = ns("downloadPng"),
class = "btn btn-default bt-export-canvas btn-custom pivot-btn-custom dashboard-btn dashboard-btn-png",
download = paste0(canvasId, ".png"),
href = "#",
`data-canvasid` = ns(canvasId),
tags$div(
tags$i(class = "fa fa-file-image")
),
title = lang$renderers$miroPivot$btDownloadPng
)
tags$div(
class = " dashboard-btn-wrapper",
tags$a(
id = ns(paste0(indicator, "DownloadCsv")),
class = "btn btn-default btn-custom pivot-btn-custom shiny-download-link dashboard-btn dashboard-btn-csv",
href = "",
target = "_blank",
download = NA,
tags$div(
tags$i(class = "fa fa-file-csv")
),
title = lang$renderers$miroPivot$btDownloadCsv
),
tags$a(
id = ns(paste0(indicator, "DownloadPng")),
class = "btn btn-default bt-export-canvas btn-custom pivot-btn-custom dashboard-btn dashboard-btn-png",
download = paste0(canvasId, ".png"),
href = "#",
`data-canvasid` = ns(canvasId),
tags$div(
tags$i(class = "fa fa-file-image")
),
title = lang$renderers$miroPivot$btDownloadPng
)
)
)
})
Expand All @@ -2012,10 +2014,10 @@ renderMirocompare_explorer <- function(input, output, session, data, options = N
output[[paste0(indicator, "DownloadCsv")]] <- downloadHandler(
filename = paste0(indicator, ".csv"),
content = function(file) {
return(write_csv(dashboardChartData[[indicator]], file, na = ""))
dataTmp <- getData(indicator)
return(write_csv(dataTmp, file, na = ""))
}
)

})
}
if (!length(dashboard) || !length(generalConfig$tabNames$dashboard)) {
Expand Down
Loading

0 comments on commit 43131a4

Please sign in to comment.