R/plot.R
In rte-antares-rpackage/bpN: Antares Visualizations
# Copyright © 2016 RTE Réseau de transport d’électricité
#' plot time series contained in an antaresData object
#'
#' This function generates an interactive plot of an antares time series.
#'
#' @param x
#' Object of class \code{antaresData}. Alternatively, it can be a list of
#' \code{antaresData} objects. In this case, one chart is created for each
#' object. Can also be opts object from h5 file or list of opts object from h5 file.
#' @param table
#' Name of the table to display when \code{x} is an \code{antaresDataList}
#' object.
#' @param variable
#' Name of the variable to plot. If this argument is missing, then the
#' function starts a shiny gadget that let the user choose the variable to
#' represent. When the user clicks on the "Done" button", the graphic is
#' returned by the function.
#' @param elements
#' Vector of "element" names indicating for which elements of 'x' should the
#' variable be plotted. For instance if the input data contains areas, then
#' this parameter should be a vector of area names. If data contains clusters
#' data, this parameter has to be the concatenation of the area name and the
#' cluster name, separated by \code{" > "}. This is to prevent confusion
#' when two clusters from different areas have the same name.
#' @param variable2Axe \code{character}, variables on second axis.
#' @param type
#' Type of plot to draw. "ts" creates a time series plot, "barplot" creates
#' a barplot with one bar per element representing the average value of the
#' variable for this element. "monotone" draws the monotone curve of the
#' variable for each element.
#' @param dateRange
#' A vector of two dates. Only data points between these two dates are
#' displayed. If NULL, then all data is displayed.
#' @param confInt
#' Number between 0 and 1 indicating the size of the confidence interval to
#' display. If it equals to 0, then confidence interval is not computed nor
#' displayed. Used only when multiple Monte Carlo scenarios are present in
#' the input data.
#' @param minValue
#' Only used if parameter \code{type} is "density" or "cdf". If this parameter
#' is set, all values that are less than \code{minValue} are removed from the
#' graphic. This is useful to deal with variables containing a few extreme
#' values (generally cost and price variables). If \code{minValue} is unset,
#' all values are displayed.
#' @param maxValue
#' Only used if parameter \code{type} is "density" or "cdf". If this parameter
#' is set, all values not in [-minValue, maxValue] are removed from the graphic.
#' This is useful to deal with variables containing a few extreme values
#' (generally cost and price variables). If \code{maxValue} is 0 or unset, all
#' values are displayed.
#' @param aggregate
#' When multiple elements are selected, should the data be aggregated. If
#' "none", each element is represented separetly. If "mean" values are
#' averaged and if "sum" they are added. You can also compute mean ans sum by areas.
#' @param colors
#' Vector of colors
#' @param ylab
#' Label of the Y axis.
#' @param colorScaleOpts
#' A list of parameters that control the creation of color scales. It is used
#' only for heatmaps. See \code{\link{colorScaleOptions}}() for available
#' parameters.
#' @param xyCompare
#' Use when you compare studies, can be "union" or "intersect". If union, all
#' of mcYears in one of studies will be selectable. If intersect, only mcYears in all
#' studies will be selectable.
#' @param highlight highlight curve when mouse over
#' @param secondAxis add second axis to graph
#'
#' @inheritParams prodStack
#'
#' @return
#' The function returns an object of class "htmlwidget". It is generated by
#' package \code{highcharter} if time step is annual or by \code{dygraphs} for
#' any other time step.It can be directly displayed in the viewer or be stored
#' in a variable for later use.
#'
#' @details
#' If the input data contains several Monte-Carlo scenarios, the function will
#' display the evolution of the average value. Moreover it will represent a
#' 95% confidence interval.
#'
#' If the input data has a annual time step, the function creates a barplot
#' instead of a line chart.
#'
#' compare argument can take following values :
#' \itemize{
#' \item "mcYear"
#' \item "main"
#' \item "variable"
#' \item "type"
#' \item "confInt"
#' \item "elements"
#' \item "aggregate"
#' \item "legend"
#' \item "highlight"
#' \item "stepPlot"
#' \item "drawPoints"
#' \item "secondAxis"
#' }
#'
#' @examples
#' \dontrun{
#' setSimulationPath(path = path1)
#' mydata <- readAntares(areas = "all", timeStep = "hourly")
#' plot(x = mydata)
#'
#' # Plot only a few areas
#' plot(x = mydata[area %in% c("area1", "area2", "area3")])
#'
#' # If data contains detailed results, then the function adds a confidence
#' # interval
#' dataDetailed <- readAntares(areas = "all", timeStep = "hourly", mcYears = 1:2)
#' plot(x = dataDetailed)
#'
#' # If the time step is annual, the function creates a barplot instead of a
#' # linechart
#' dataAnnual <- readAntares(areas = "all", timeStep = "annual")
#' plot(x = dataAnnual)
#'
#' # Compare two simulaitons
#' # Compare the results of two simulations
#' setSimulationPath(path1)
#' mydata1 <- readAntares(areas = "all", timeStep = "daily")
#' setSimulationPath(path2)
#' mydata2 <- readAntares(areas = "all", timeStep = "daily")
#'
#' plot(x = list(mydata1, mydata2))
#'
#' # When you compare studies, you have 2 ways to defind inputs, union or intersect.
#' # for example, if you chose union and you have mcYears 1 and 2 in the first study
#' # and mcYears 2 and 3 in the second, mcYear input will be worth c(1, 2, 3)
#' # In same initial condition (study 1 -> 1,2 ans study 2 -> 2, 3) if you choose intersect,
#' # mcYear input will be wort 2.
#' # You must specify union or intersect with xyCompare argument (default union).
#' plot(x = list(mydata1[area %in% c("a", "b")],
#' mydata1[area %in% c("b", "c")]), xyCompare = "union")
#' plot(x = list(mydata1[area %in% c("a", "b")],
#' mydata1[area %in% c("b", "c")]), xyCompare = "intersect")
#'
#' # Compare data in a single simulation
#' # Compare two periods for the same simulation
#' plot(x = mydata1, compare = "dateRange")
#'
#' # Compare two Monte-Carlo scenarios
#' detailedData <- readAntares(areas = "all", mcYears = "all")
#' plot(x = detailedData, .compare = "mcYear")
#'
#' # Use h5 for dynamic request / exploration in a study
#' # Set path of simulaiton
#' setSimulationPath(path = path1)
#'
#' # Convert your study in h5 format
#' writeAntaresH5(path = mynewpath)
#'
#' # Redefine sim path with h5 file
#' opts <- setSimulationPath(path = mynewpath)
#' plot(x = opts)
#'
#' # Compare elements in a single study
#' plot(x = opts, .compare = "mcYear")
#' # Compare 2 studies
#' plot(x = list(opts, opts2))
#'
#' }
#'
#'
#'
#'
#' @export
tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
variable2Axe = NULL,
mcYear = "average",
type = c("ts", "barplot", "monotone", "density", "cdf", "heatmap"),
dateRange = NULL,
confInt = 0,
minValue = NULL,
maxValue = NULL,
aggregate = c("none", "mean", "sum", "mean by areas", "sum by areas"),
compare = NULL,
compareOpts = list(),
interactive = getInteractivity(),
colors = NULL,
main = NULL,
ylab = NULL,
legend = TRUE,
legendItemsPerRow = 5,
colorScaleOpts = colorScaleOptions(20),
width = NULL, height = NULL, xyCompare = c("union","intersect"),
h5requestFiltering = list(), highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE,
secondAxis = FALSE,
timeSteph5 = "hourly",
mcYearh5 = NULL,
tablesh5 = c("areas", "links"), language = "en",
hidden = NULL, ...) {
if(!is.null(compare) && !interactive){
stop("You can't use compare in no interactive mode")
}
# Check language
if(!language %in% availableLanguages_labels){
stop("Invalid 'language' argument. Must be in : ", paste(availableLanguages_labels, collapse = ", "))
}
if(language != "en"){
variable <- .getColumnsLanguage(variable, language)
variable2Axe <- .getColumnsLanguage(variable2Axe, language)
}
# Check hidden
.validHidden(hidden, c("H5request", "timeSteph5", "tables", "mcYearH5", "table", "mcYear", "variable",
"secondAxis", "variable2Axe", "type", "dateRange", "confInt", "minValue", "maxValue",
"elements", "aggregate", "legend", "highlight", "stepPlot", "drawPoints", "main"))
#Check compare
.validCompare(compare, c("mcYear", "main", "variable", "type", "confInt", "elements", "aggregate", "legend",
"highlight", "stepPlot", "drawPoints", "secondAxis"))
if(is.list(compare)){
if("secondAxis" %in% names(compare)){
compare <- c(compare, list(variable2Axe = NULL))
}
} else if(is.vector(compare)){
if("secondAxis" %in% compare){
compare <- c(compare, "variable2Axe")
}
}
xyCompare <- match.arg(xyCompare)
type <- match.arg(type)
aggregate <- match.arg(aggregate)
colorScaleOpts <- do.call(colorScaleOptions, colorScaleOpts)
init_elements <- elements
init_dateRange <- dateRange
if(!is.null(compare) && "list" %in% class(x)){
if(length(x) == 1) x <- list(x[[1]], x[[1]])
}
if(!is.null(compare) && ("antaresData" %in% class(x) | "simOptions" %in% class(x))){
x <- list(x, x)
}
# .testXclassAndInteractive(x, interactive)
h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x)
# Generate a group number for dygraph objects
if (!("dateRange" %in% compare)) {
group <- sample(1e9, 1)
} else {
group <- NULL
}
compareOptions <- .compOpts(x, compare)
if(is.null(compare)){
if(compareOptions$ncharts > 1){
compare <- list()
}
}
processFun <- function(x, elements = NULL, dateRange = NULL) {
assert_that(inherits(x, "antaresData"))
x <- as.antaresDataList(x)
lapply(x, function(x) {
idCols <- .idCols(x)
if(language != "en"){
ind_to_change <- which(colnames(x) %in% language_columns$en)
if(length(ind_to_change) > 0){
# new_name <- language_columns[en %in% colnames(x), ]
# v_new_name <- new_name[[language]]
# names(v_new_name) <- new_name[["en"]]
# setnames(x, colnames(x)[ind_to_change], unname(v_new_name[colnames(x)[ind_to_change]]))
#
# BP 2017
# keep subset
ind_to_keep <- which(colnames(x) %in% language_columns$en[language_columns$keep_bp])
x <- x[, c(idCols, colnames(x)[ind_to_keep]), with = FALSE]
ind_to_change <- which(colnames(x) %in% language_columns$en)
new_name <- language_columns[en %in% colnames(x), ]
v_new_name <- new_name[["bp"]]
names(v_new_name) <- new_name[["en"]]
setnames(x, colnames(x)[ind_to_change], unname(v_new_name[colnames(x)[ind_to_change]]))
}
}
valueCols <- setdiff(names(x), idCols)
timeStep <- attr(x, "timeStep")
opts <- simOptions(x)
dt <- x[, .(
timeId = timeId,
time = .timeIdToDate(timeId, attr(x, "timeStep"), simOptions(x)),
value = 0)
]
if ("cluster" %in% idCols) {
dt$element <- paste(x$area, x$cluster, sep = " > ")
} else if ("district" %in% idCols) {
dt$element <- x$district
} else if ("link" %in% idCols) {
dt$element <- x$link
} else if ("area" %in% idCols) {
dt$element <- x$area
} else stop("No Id column")
if ("mcYear" %in% names(x)) {
dt$mcYear <- x$mcYear
}
dataDateRange <- as.Date(range(dt$time))
if (is.null(dateRange) || length(dateRange) < 2) dateRange <- dataDateRange
uniqueElem <- sort(as.character(unique(dt$element)))
if (is.null(elements)) {
elements <- uniqueElem
# if (length(elements) > 5) elements <- elements[1:5]
}
# Function that generates the desired graphic.
plotFun <- function(mcYear, id, variable, variable2Axe, elements, type, confInt, dateRange,
minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main) {
if (is.null(variable)) variable <- valueCols[1]
if (is.null(dateRange)) dateRange <- dateRange
if (is.null(type) || !variable %in% names(x)) {
return(combineWidgets())
}
if(variable[1] == "No Input") {return(combineWidgets(switch(language,
"fr" = "Pas de données",
"No data")))}
dt <- .getTSData(
x, dt,
variable = c(variable, variable2Axe), elements = elements,
uniqueElement = uniqueElem,
mcYear = mcYear, dateRange = dateRange, aggregate = aggregate
)
if (nrow(dt) == 0) return(combineWidgets(switch(language,
"fr" = "Pas de données",
"No data")))
if(type == "ts"){
if(!is.null(dateRange))
{
if(dt$time[1] > dateRange[1]){
dt <- dt[c(NA, 1:nrow(dt))]
dt$time[1] <- dateRange[1]
}
nrowTp <- nrow(dt)
if(dt$time[nrowTp] < dateRange[2]){
dt <- dt[c(1:nrow(dt), NA)]
dt$time[nrowTp + 1] <- dateRange[2]
}
}
}
f <- switch(type,
"ts" = .plotTS,
"barplot" = .barplot,
"monotone" = .plotMonotone,
"density" = .density,
"cdf" = .cdf,
"heatmap" = .heatmap,
stop("Invalid type")
)
variable2Axe <- apply(expand.grid(elements, variable2Axe), 1, function(X){paste(X, collapse = " __ ")})
# BP 2017
if(length(main) > 0){
mcYear <- ifelse(mcYear == "average", "moyen", mcYear)
if(grepl("h5$", main)){
# main <- paste0(gsub(".h5$", "", main), " : ", areas, " (tirage ", mcYear, ")")
main <- paste0(gsub(".h5$", "", main), " : Tirage ", mcYear)
} else {
# main <- paste0("Production ", areas, " (tirage ", mcYear, ")")
main <- paste0("Tirage ", mcYear)
}
}
f(
dt,
timeStep = timeStep,
variable = variable,
variable2Axe = variable2Axe,
confInt = confInt,
minValue = minValue,
maxValue = maxValue,
colors = colors,
main = main,
ylab = if(length(ylab) == 1) ylab else ylab[id],
legend = legend,
legendItemsPerRow = legendItemsPerRow,
width = width,
height = height,
opts = opts,
colorScaleOpts = colorScaleOpts,
group = group,
highlight = highlight,
stepPlot = stepPlot,
drawPoints = drawPoints,
language = language
)
}
list(
plotFun = plotFun,
dt = dt,
x = x,
idCols = idCols,
valueCols = valueCols,
showConfInt = !is.null(x$mcYear) && length(unique(x$mcYear) > 1),
dataDateRange = dataDateRange,
dateRange = dateRange,
uniqueElem = uniqueElem,
uniqueMcYears = unique(x$mcYear),
elements = elements,
timeStep = timeStep,
opts = opts
)
})
}
# If not in interactive mode, generate a simple graphic, else create a GUI
# to interactively explore the data
if (!interactive) {
x <- .cleanH5(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering)
params <- .transformDataForComp(.giveListFormat(x), compare, compareOpts,
processFun = processFun,
elements = elements, dateRange = dateRange)
# paramCoe <- .testParamsConsistency(params = params, mcYear = mcYear)
# mcYear <- paramCoe$mcYear
if (is.null(table)) table <- names(params$x[[1]])[1]
if (is.null(mcYear)) mcYear <- "average"
L_w <- lapply(params$x, function(X){
X[[table]]$plotFun(mcYear, 1, variable, variable2Axe, elements, type, confInt, dateRange,
minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main)
})
return(combineWidgets(list = L_w))
}
# typeChoices <- c("ts", "barplot", "monotone", "density", "cdf", "heatmap")
# names(typeChoices) <- c(.getLabelLanguage("time series", language), .getLabelLanguage("barplot", language),
# .getLabelLanguage("monotone", language), .getLabelLanguage("density", language),
# .getLabelLanguage("cdf", language), .getLabelLanguage("heatmap", language))
# BP 2017
typeChoices <- c("ts","monotone")
names(typeChoices) <- c(.getLabelLanguage("time series", language), .getLabelLanguage("monotone", language))
##remove notes
table <- NULL
x_in <- NULL
paramsH5 <- NULL
timeSteph5 <- NULL
mcYearH5 <- NULL
sharerequest <- NULL
timeStepdataload <- NULL
x_tranform <- NULL
manipulateWidget({
.tryCloseH5()
if(.id <= length(params$x)){
if(length(variable) == 0){return(combineWidgets(switch(language,
"fr" = "Veuillez sélectionner des variables",
"Please select some variables")))}
if(length(elements) == 0){return(combineWidgets(switch(language,
"fr" = "Veuillez sélectionner des éléments",
"Please select some elements")))}
if(length(params[["x"]][[max(1,.id)]]) == 0){return(combineWidgets(switch(language,
"fr" = "Pas de données",
"No data")))}
if(is.null(params[["x"]][[max(1,.id)]][[table]])){return(combineWidgets(switch(language,
"fr" = paste0("Table ", table, " absente de l'étude"),
paste0("Table ", table, " not exists in this study"))))}
if(!secondAxis){
variable2Axe <- NULL
} else {
aggregate <- "none"
}
widget <- params[["x"]][[max(1,.id)]][[table]]$plotFun(mcYear, .id, variable, variable2Axe, elements, type, confInt,
dateRange, minValue, maxValue, aggregate, legend,
highlight, stepPlot, drawPoints, main)
controlWidgetSize(widget, language)
} else {
combineWidgets(switch(language,
"fr" = "Pas de données pour cette sélection",
"No data for this selection"))
}
},
x = mwSharedValue({x}),
# #Output
# outPutGraph = mwSharedValue({
# ls()
# }),
x_in = mwSharedValue({
.giveListFormat(x)
}),
h5requestFiltering = mwSharedValue({h5requestFiltering}),
paramsH5 = mwSharedValue({
.h5ParamList(X_I = x_in, xyCompare = xyCompare, h5requestFilter = h5requestFiltering)
}),
H5request = mwGroup(
label = .getLabelLanguage("H5request", language),
# BP 2017
eventsH5 = mwSelect(choices = {
choix = c("By event", "By mcYear")
names(choix) <- sapply(choix, function(tmp) .getLabelLanguage(tmp, language))
choix
}, value = "By event",
multiple = FALSE, label = .getLabelLanguage("Selection", language), .display = !"eventsH5" %in% hidden),
timeSteph5 = mwSelect(
{
if(length(paramsH5) > 0 & length(eventsH5) > 0){
# choices = paramsH5$timeStepS
# BP 2017
if(eventsH5 %in% "By event"){
choices = c("hourly")
} else {
choices = setdiff(paramsH5$timeStepS, "annual")
}
names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
choices
} else {
NULL
}
},
value = if(.initial) {
paramsH5$timeStepS[1]
}else{NULL},
label = .getLabelLanguage("timeStep", language),
multiple = FALSE, .display = !"timeSteph5" %in% hidden & length(intersect("By mcYear", eventsH5)) > 0
),
tables = mwSelect(
{
# choices = paramsH5[["tabl"]]
# BP 2017
choices <- c("areas", "links")
names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
choices
},
value = {
if(.initial) {paramsH5[["tabl"]][1]}else{NULL}
},
label = .getLabelLanguage("table", language), multiple = TRUE,
.display = !"tables" %in% hidden
),
# mcYearH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]),
# # value = {
# # if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
# # },
# # BP 2017
# value = c(1:2),
# label = .getLabelLanguage("mcYears to be imported", language), multiple = TRUE,
# .display = !"mcYearH5" %in% hidden
# ),
mcYearH5 = mwSelect(choices = {
if(length(eventsH5) > 0){
if(eventsH5 %in% "By event"){
bp_mcy_params_labels
} else {
paramsH5[["mcYearS"]]
}
} else {
NULL
}
},
value = "35",
label = .getLabelLanguage("mcYears to be imported", language),
.display = (!"mcYearH5" %in% hidden & length(intersect("By mcYear", eventsH5)) > 0 & !meanYearH5) |
(!"mcYearH5" %in% hidden & length(intersect("By event", eventsH5)) > 0)
),
meanYearH5 = mwCheckbox(value = FALSE,
label = .getLabelLanguage("Average mcYear", language),
.display = !"meanYearH5" %in% hidden & length(intersect("By mcYear", eventsH5)) > 0),
.display = {
any(unlist(lapply(x_in, .isSimOpts))) & !"H5request" %in% hidden
}),
sharerequest = mwSharedValue({
if(length(meanYearH5) > 0 & length(eventsH5) > 0){
if(meanYearH5 & eventsH5 %in% "By mcYear"){
list(timeSteph5_l = timeSteph5, mcYearh_l = NULL, tables_l = tables)
} else {
list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables)
}
} else {
list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables)
}
}),
x_tranform = mwSharedValue({
dataInApp <- sapply(1:length(x_in),function(zz){
.loadH5Data(sharerequest, x_in[[zz]], h5requestFilter = paramsH5$h5requestFilter[[zz]])
}, simplify = FALSE)
dataInApp
}),
table = mwSelect(
{
if(!is.null(params)){
# out <- as.character(.compareOperation(
# lapply(params$x, function(vv){
# unique(names(vv))
# }), xyCompare))
# BP 2017
out <- c("areas", "links")
if(length(out) > 0){
names(out) <- sapply(out, function(x) .getLabelLanguage(x, language))
out
}else{"No Input"}
}
},
value = {
if(.initial) table
else NULL
}, .display = length(as.character(.compareOperation(
lapply(params$x, function(vv){
unique(names(vv))
}), xyCompare))) > 1 & !"table" %in% hidden,
label = .getLabelLanguage("table", language)
),
mcYear = mwSelect(
choices = {
# tmp <- c("average", if(!is.null(params)){
# as.character(.compareOperation(lapply(params$x, function(vv){
# unique(vv[[table]]$uniqueMcYears)
# }), xyCompare))})
# names(tmp) <- sapply(tmp, function(x) .getLabelLanguage(x, language))
# tmp
# BP 2017
allMcY <- .compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueMcYears)
}), xyCompare)
names(allMcY) <- allMcY
if(is.null(allMcY)){
allMcY <- "average"
names(allMcY) <- .getLabelLanguage("average", language)
}
allMcY
},
value = {
# if(.initial) "average"
# BP 2017
if(.initial) mcYear
else NULL
}, multiple = FALSE,
label = .getLabelLanguage("mcYear to be displayed", language),
.display = !"mcYear" %in% hidden
),
variable = mwSelect(
choices = {
if(!is.null(params)){
out <- as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$valueCols)
}), xyCompare))
if(length(out) > 0){out} else {"No Input"}
}
},
value = {
if(.initial){
if(is.null(variable)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$valueCols)
}), xyCompare))[1]
} else {
variable
}
} else {
NULL
}
}, multiple = TRUE,
label = .getLabelLanguage("variable", language),
.display = !"variable" %in% hidden
),
secondAxis = mwCheckbox(secondAxis, label = .getLabelLanguage("secondAxis", language),
.display = !"secondAxis" %in% hidden),
variable2Axe = mwSelect(label = .getLabelLanguage("Variables 2nd axis", language),
choices = {
if(!is.null(params)){
out <- as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$valueCols)
}), xyCompare))
out <- out[!out%in%variable]
if(length(out) > 0){out} else {"No Input"}
}
},
value = {
if(.initial) variable2Axe
else NULL
}, multiple = TRUE, .display = secondAxis & !"variable2Axe" %in% hidden
),
type = mwSelect(
choices = {
if (timeStepdataload == "annual") "barplot"
else if (timeStepdataload %in% c("hourly", "daily")) typeChoices
else setdiff(typeChoices, "heatmap")
},
value = {
if(.initial) type
else NULL
},
.display = timeStepdataload != "annual" & !"type" %in% hidden,
label = .getLabelLanguage("type", language)
),
dateRange = mwDateRange(value = {
# if(.initial){
# res <- NULL
# if(!is.null(params) & ! is.null(table)){
# res <- c(.dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table),
# .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table))
# if(any(is.infinite(c(res))))
# {res <- NULL}
# }
# ##Lock 7 days for hourly data
# if(!is.null(params$x[[1]][[table]]$timeStep)){
# if(params$x[[1]][[table]]$timeStep == "hourly"){
# # if(params$x[[1]][[table]]$dateRange[2] - params$x[[1]][[table]]$dateRange[1]>7){
# # res[1] <- params$x[[1]][[table]]$dateRange[2] - 7
# # }
# # BP 2017
# res <- c("2029-01-15", "2029-01-21")
# }
# }
# res
# }else{NULL}
# BP 2017
if(length(intersect("By event", eventsH5) > 0)){
tmp_mcYear <- as.character(mcYear)
c(bp_mcy_params[mcYear == tmp_mcYear, date_start], bp_mcy_params[mcYear == tmp_mcYear, date_end])
} else if(.initial){
c("2029-01-15", "2029-01-21")
} else if(params$x[[1]][[1]]$timeStep %in% c("daily", "weekly", "monthly")){
c("2028-07-01", "2029-06-29")
}
},
min = {
if(!is.null(params) & ! is.null(table)){
R <- .dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table)
if(is.infinite(R)){NULL}else{R}
# BP 17
"2028-07-01"
}
},
max = {
# if(!is.null(params) & ! is.null(table)){
# R <- .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table)
# if(is.infinite(R)){NULL}else{R}
# }
# BP 17
"2029-06-29"
},
language = eval(parse(text = "language")),
# BP 2017
format = "dd MM",
separator = " : ",
weekstart = 1,
# .display = timeStepdataload != "annual" & !"dateRange" %in% hidden,
# BP 17
.display = timeStepdataload != "annual" & !"dateRange" %in% hidden & eventsH5 %in% "By mcYear",
label = .getLabelLanguage("dateRange", language)
),
confInt = mwSlider(0, 1, confInt, step = 0.01,
label = .getLabelLanguage("confidence interval", language),
.display = params$x[[max(1,.id)]][[table]]$showConfInt & mcYear == "average" & !"confInt" %in% hidden
),
minValue = mwNumeric(minValue, label = .getLabelLanguage("min value", language),
.display = type %in% c("density", "cdf") & !"minValue" %in% hidden
),
maxValue = mwNumeric(maxValue, label = .getLabelLanguage("max value", language),
.display = type %in% c("density", "cdf") & !"maxValue" %in% hidden
),
elements = mwSelect(
choices = {
# c( if(!is.null(params)){
# as.character(.compareOperation(lapply(params$x, function(vv){
# unique(vv[[table]]$uniqueElem)
# }), xyCompare))
# })
# BP 2017
choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
choix[grepl("fr", choix)]
},
value = {
if(.initial) {
if(is.null(elements)){
# as.character(.compareOperation(lapply(params$x, function(vv){
# unique(vv[[table]]$uniqueElem)
# }), xyCompare))[1]
#
# BP 2017
choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
choix[grepl("fr", choix)][1]
}else {
elements
}
} else {
# BP 2017
choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
choix[grepl("fr", choix)][1]
}
},
multiple = TRUE,
label = .getLabelLanguage("elements", language),
.display = !"elements" %in% hidden
),
aggregate = mwSelect({
tmp <- c("none", "mean", "sum", "mean by areas", "sum by areas")
names(tmp) <- c(.getLabelLanguage("none", language),
.getLabelLanguage("mean", language),
.getLabelLanguage("sum", language),
.getLabelLanguage("mean by areas", language),
.getLabelLanguage("sum by areas", language))
tmp
}, value ={
if(.initial) aggregate
else NULL
}, .display = !secondAxis & !"aggregate" %in% hidden,
label = .getLabelLanguage("aggregate", language)
),
legend = mwCheckbox(legend, .display = type %in% c("ts", "density", "cdf") & !"legend" %in% hidden,
label = .getLabelLanguage("legend", language)),
highlight = mwCheckbox(highlight, label = .getLabelLanguage("highlight", language),
.display = !"highlight" %in% hidden),
stepPlot = mwCheckbox(stepPlot, label = .getLabelLanguage("stepPlot", language),
.display = !"stepPlot" %in% hidden),
drawPoints = mwCheckbox(drawPoints, label =.getLabelLanguage("drawPoints", language),
.display = !"drawPoints" %in% hidden),
timeStepdataload = mwSharedValue({
attributes(x_tranform[[1]])$timeStep
}),
main = mwText(main, label = .getLabelLanguage("title", language),
.display = !"main" %in% hidden),
params = mwSharedValue({
.transformDataForComp(x_tranform, compare, compareOpts, processFun = processFun,
elements = init_elements, dateRange = init_dateRange)
}),
.compare = {
compare
},
.compareOpts = {
compareOptions
},
...
)
}
#' @export
#' @rdname tsPlot
#' @method plot antaresData
plot.antaresData <- tsPlot
#' @export
#' @rdname tsPlot
#' @method plot simOptions
plot.simOptions <- tsPlot
#' @export
#' @rdname tsPlot
#' @method plot list
plot.list <- tsPlot
rte-antares-rpackage/bpN documentation built on May 31, 2019, 2:52 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Copyright © 2016 RTE Réseau de transport d’électricité
#' plot time series contained in an antaresData object
#'
#' This function generates an interactive plot of an antares time series.
#'
#' @param x
#' Object of class \code{antaresData}. Alternatively, it can be a list of
#' \code{antaresData} objects. In this case, one chart is created for each
#' object. Can also be opts object from h5 file or list of opts object from h5 file.
#' @param table
#' Name of the table to display when \code{x} is an \code{antaresDataList}
#' object.
#' @param variable
#' Name of the variable to plot. If this argument is missing, then the
#' function starts a shiny gadget that let the user choose the variable to
#' represent. When the user clicks on the "Done" button", the graphic is
#' returned by the function.
#' @param elements
#' Vector of "element" names indicating for which elements of 'x' should the
#' variable be plotted. For instance if the input data contains areas, then
#' this parameter should be a vector of area names. If data contains clusters
#' data, this parameter has to be the concatenation of the area name and the
#' cluster name, separated by \code{" > "}. This is to prevent confusion
#' when two clusters from different areas have the same name.
#' @param variable2Axe \code{character}, variables on second axis.
#' @param type
#' Type of plot to draw. "ts" creates a time series plot, "barplot" creates
#' a barplot with one bar per element representing the average value of the
#' variable for this element. "monotone" draws the monotone curve of the
#' variable for each element.
#' @param dateRange
#' A vector of two dates. Only data points between these two dates are
#' displayed. If NULL, then all data is displayed.
#' @param confInt
#' Number between 0 and 1 indicating the size of the confidence interval to
#' display. If it equals to 0, then confidence interval is not computed nor
#' displayed. Used only when multiple Monte Carlo scenarios are present in
#' the input data.
#' @param minValue
#' Only used if parameter \code{type} is "density" or "cdf". If this parameter
#' is set, all values that are less than \code{minValue} are removed from the
#' graphic. This is useful to deal with variables containing a few extreme
#' values (generally cost and price variables). If \code{minValue} is unset,
#' all values are displayed.
#' @param maxValue
#' Only used if parameter \code{type} is "density" or "cdf". If this parameter
#' is set, all values not in [-minValue, maxValue] are removed from the graphic.
#' This is useful to deal with variables containing a few extreme values
#' (generally cost and price variables). If \code{maxValue} is 0 or unset, all
#' values are displayed.
#' @param aggregate
#' When multiple elements are selected, should the data be aggregated. If
#' "none", each element is represented separetly. If "mean" values are
#' averaged and if "sum" they are added. You can also compute mean ans sum by areas.
#' @param colors
#' Vector of colors
#' @param ylab
#' Label of the Y axis.
#' @param colorScaleOpts
#' A list of parameters that control the creation of color scales. It is used
#' only for heatmaps. See \code{\link{colorScaleOptions}}() for available
#' parameters.
#' @param xyCompare
#' Use when you compare studies, can be "union" or "intersect". If union, all
#' of mcYears in one of studies will be selectable. If intersect, only mcYears in all
#' studies will be selectable.
#' @param highlight highlight curve when mouse over
#' @param secondAxis add second axis to graph
#'
#' @inheritParams prodStack
#'
#' @return
#' The function returns an object of class "htmlwidget". It is generated by
#' package \code{highcharter} if time step is annual or by \code{dygraphs} for
#' any other time step.It can be directly displayed in the viewer or be stored
#' in a variable for later use.
#'
#' @details
#' If the input data contains several Monte-Carlo scenarios, the function will
#' display the evolution of the average value. Moreover it will represent a
#' 95% confidence interval.
#'
#' If the input data has a annual time step, the function creates a barplot
#' instead of a line chart.
#'
#' compare argument can take following values :
#' \itemize{
#' \item "mcYear"
#' \item "main"
#' \item "variable"
#' \item "type"
#' \item "confInt"
#' \item "elements"
#' \item "aggregate"
#' \item "legend"
#' \item "highlight"
#' \item "stepPlot"
#' \item "drawPoints"
#' \item "secondAxis"
#' }
#'
#' @examples
#' \dontrun{
#' setSimulationPath(path = path1)
#' mydata <- readAntares(areas = "all", timeStep = "hourly")
#' plot(x = mydata)
#'
#' # Plot only a few areas
#' plot(x = mydata[area %in% c("area1", "area2", "area3")])
#'
#' # If data contains detailed results, then the function adds a confidence
#' # interval
#' dataDetailed <- readAntares(areas = "all", timeStep = "hourly", mcYears = 1:2)
#' plot(x = dataDetailed)
#'
#' # If the time step is annual, the function creates a barplot instead of a
#' # linechart
#' dataAnnual <- readAntares(areas = "all", timeStep = "annual")
#' plot(x = dataAnnual)
#'
#' # Compare two simulaitons
#' # Compare the results of two simulations
#' setSimulationPath(path1)
#' mydata1 <- readAntares(areas = "all", timeStep = "daily")
#' setSimulationPath(path2)
#' mydata2 <- readAntares(areas = "all", timeStep = "daily")
#'
#' plot(x = list(mydata1, mydata2))
#'
#' # When you compare studies, you have 2 ways to defind inputs, union or intersect.
#' # for example, if you chose union and you have mcYears 1 and 2 in the first study
#' # and mcYears 2 and 3 in the second, mcYear input will be worth c(1, 2, 3)
#' # In same initial condition (study 1 -> 1,2 ans study 2 -> 2, 3) if you choose intersect,
#' # mcYear input will be wort 2.
#' # You must specify union or intersect with xyCompare argument (default union).
#' plot(x = list(mydata1[area %in% c("a", "b")],
#' mydata1[area %in% c("b", "c")]), xyCompare = "union")
#' plot(x = list(mydata1[area %in% c("a", "b")],
#' mydata1[area %in% c("b", "c")]), xyCompare = "intersect")
#'
#' # Compare data in a single simulation
#' # Compare two periods for the same simulation
#' plot(x = mydata1, compare = "dateRange")
#'
#' # Compare two Monte-Carlo scenarios
#' detailedData <- readAntares(areas = "all", mcYears = "all")
#' plot(x = detailedData, .compare = "mcYear")
#'
#' # Use h5 for dynamic request / exploration in a study
#' # Set path of simulaiton
#' setSimulationPath(path = path1)
#'
#' # Convert your study in h5 format
#' writeAntaresH5(path = mynewpath)
#'
#' # Redefine sim path with h5 file
#' opts <- setSimulationPath(path = mynewpath)
#' plot(x = opts)
#'
#' # Compare elements in a single study
#' plot(x = opts, .compare = "mcYear")
#' # Compare 2 studies
#' plot(x = list(opts, opts2))
#'
#' }
#'
#'
#'
#'
#' @export
tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
variable2Axe = NULL,
mcYear = "average",
type = c("ts", "barplot", "monotone", "density", "cdf", "heatmap"),
dateRange = NULL,
confInt = 0,
minValue = NULL,
maxValue = NULL,
aggregate = c("none", "mean", "sum", "mean by areas", "sum by areas"),
compare = NULL,
compareOpts = list(),
interactive = getInteractivity(),
colors = NULL,
main = NULL,
ylab = NULL,
legend = TRUE,
legendItemsPerRow = 5,
colorScaleOpts = colorScaleOptions(20),
width = NULL, height = NULL, xyCompare = c("union","intersect"),
h5requestFiltering = list(), highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE,
secondAxis = FALSE,
timeSteph5 = "hourly",
mcYearh5 = NULL,
tablesh5 = c("areas", "links"), language = "en",
hidden = NULL, ...) {
if(!is.null(compare) && !interactive){
stop("You can't use compare in no interactive mode")
}
# Check language
if(!language %in% availableLanguages_labels){
stop("Invalid 'language' argument. Must be in : ", paste(availableLanguages_labels, collapse = ", "))
}
if(language != "en"){
variable <- .getColumnsLanguage(variable, language)
variable2Axe <- .getColumnsLanguage(variable2Axe, language)
}
# Check hidden
.validHidden(hidden, c("H5request", "timeSteph5", "tables", "mcYearH5", "table", "mcYear", "variable",
"secondAxis", "variable2Axe", "type", "dateRange", "confInt", "minValue", "maxValue",
"elements", "aggregate", "legend", "highlight", "stepPlot", "drawPoints", "main"))
#Check compare
.validCompare(compare, c("mcYear", "main", "variable", "type", "confInt", "elements", "aggregate", "legend",
"highlight", "stepPlot", "drawPoints", "secondAxis"))
if(is.list(compare)){
if("secondAxis" %in% names(compare)){
compare <- c(compare, list(variable2Axe = NULL))
}
} else if(is.vector(compare)){
if("secondAxis" %in% compare){
compare <- c(compare, "variable2Axe")
}
}
xyCompare <- match.arg(xyCompare)
type <- match.arg(type)
aggregate <- match.arg(aggregate)
colorScaleOpts <- do.call(colorScaleOptions, colorScaleOpts)
init_elements <- elements
init_dateRange <- dateRange
if(!is.null(compare) && "list" %in% class(x)){
if(length(x) == 1) x <- list(x[[1]], x[[1]])
}
if(!is.null(compare) && ("antaresData" %in% class(x) | "simOptions" %in% class(x))){
x <- list(x, x)
}
# .testXclassAndInteractive(x, interactive)
h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x)
# Generate a group number for dygraph objects
if (!("dateRange" %in% compare)) {
group <- sample(1e9, 1)
} else {
group <- NULL
}
compareOptions <- .compOpts(x, compare)
if(is.null(compare)){
if(compareOptions$ncharts > 1){
compare <- list()
}
}
processFun <- function(x, elements = NULL, dateRange = NULL) {
assert_that(inherits(x, "antaresData"))
x <- as.antaresDataList(x)
lapply(x, function(x) {
idCols <- .idCols(x)
if(language != "en"){
ind_to_change <- which(colnames(x) %in% language_columns$en)
if(length(ind_to_change) > 0){
# new_name <- language_columns[en %in% colnames(x), ]
# v_new_name <- new_name[[language]]
# names(v_new_name) <- new_name[["en"]]
# setnames(x, colnames(x)[ind_to_change], unname(v_new_name[colnames(x)[ind_to_change]]))
#
# BP 2017
# keep subset
ind_to_keep <- which(colnames(x) %in% language_columns$en[language_columns$keep_bp])
x <- x[, c(idCols, colnames(x)[ind_to_keep]), with = FALSE]
ind_to_change <- which(colnames(x) %in% language_columns$en)
new_name <- language_columns[en %in% colnames(x), ]
v_new_name <- new_name[["bp"]]
names(v_new_name) <- new_name[["en"]]
setnames(x, colnames(x)[ind_to_change], unname(v_new_name[colnames(x)[ind_to_change]]))
}
}
valueCols <- setdiff(names(x), idCols)
timeStep <- attr(x, "timeStep")
opts <- simOptions(x)
dt <- x[, .(
timeId = timeId,
time = .timeIdToDate(timeId, attr(x, "timeStep"), simOptions(x)),
value = 0)
]
if ("cluster" %in% idCols) {
dt$element <- paste(x$area, x$cluster, sep = " > ")
} else if ("district" %in% idCols) {
dt$element <- x$district
} else if ("link" %in% idCols) {
dt$element <- x$link
} else if ("area" %in% idCols) {
dt$element <- x$area
} else stop("No Id column")
if ("mcYear" %in% names(x)) {
dt$mcYear <- x$mcYear
}
dataDateRange <- as.Date(range(dt$time))
if (is.null(dateRange) || length(dateRange) < 2) dateRange <- dataDateRange
uniqueElem <- sort(as.character(unique(dt$element)))
if (is.null(elements)) {
elements <- uniqueElem
# if (length(elements) > 5) elements <- elements[1:5]
}
# Function that generates the desired graphic.
plotFun <- function(mcYear, id, variable, variable2Axe, elements, type, confInt, dateRange,
minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main) {
if (is.null(variable)) variable <- valueCols[1]
if (is.null(dateRange)) dateRange <- dateRange
if (is.null(type) || !variable %in% names(x)) {
return(combineWidgets())
}
if(variable[1] == "No Input") {return(combineWidgets(switch(language,
"fr" = "Pas de données",
"No data")))}
dt <- .getTSData(
x, dt,
variable = c(variable, variable2Axe), elements = elements,
uniqueElement = uniqueElem,
mcYear = mcYear, dateRange = dateRange, aggregate = aggregate
)
if (nrow(dt) == 0) return(combineWidgets(switch(language,
"fr" = "Pas de données",
"No data")))
if(type == "ts"){
if(!is.null(dateRange))
{
if(dt$time[1] > dateRange[1]){
dt <- dt[c(NA, 1:nrow(dt))]
dt$time[1] <- dateRange[1]
}
nrowTp <- nrow(dt)
if(dt$time[nrowTp] < dateRange[2]){
dt <- dt[c(1:nrow(dt), NA)]
dt$time[nrowTp + 1] <- dateRange[2]
}
}
}
f <- switch(type,
"ts" = .plotTS,
"barplot" = .barplot,
"monotone" = .plotMonotone,
"density" = .density,
"cdf" = .cdf,
"heatmap" = .heatmap,
stop("Invalid type")
)
variable2Axe <- apply(expand.grid(elements, variable2Axe), 1, function(X){paste(X, collapse = " __ ")})
# BP 2017
if(length(main) > 0){
mcYear <- ifelse(mcYear == "average", "moyen", mcYear)
if(grepl("h5$", main)){
# main <- paste0(gsub(".h5$", "", main), " : ", areas, " (tirage ", mcYear, ")")
main <- paste0(gsub(".h5$", "", main), " : Tirage ", mcYear)
} else {
# main <- paste0("Production ", areas, " (tirage ", mcYear, ")")
main <- paste0("Tirage ", mcYear)
}
}
f(
dt,
timeStep = timeStep,
variable = variable,
variable2Axe = variable2Axe,
confInt = confInt,
minValue = minValue,
maxValue = maxValue,
colors = colors,
main = main,
ylab = if(length(ylab) == 1) ylab else ylab[id],
legend = legend,
legendItemsPerRow = legendItemsPerRow,
width = width,
height = height,
opts = opts,
colorScaleOpts = colorScaleOpts,
group = group,
highlight = highlight,
stepPlot = stepPlot,
drawPoints = drawPoints,
language = language
)
}
list(
plotFun = plotFun,
dt = dt,
x = x,
idCols = idCols,
valueCols = valueCols,
showConfInt = !is.null(x$mcYear) && length(unique(x$mcYear) > 1),
dataDateRange = dataDateRange,
dateRange = dateRange,
uniqueElem = uniqueElem,
uniqueMcYears = unique(x$mcYear),
elements = elements,
timeStep = timeStep,
opts = opts
)
})
}
# If not in interactive mode, generate a simple graphic, else create a GUI
# to interactively explore the data
if (!interactive) {
x <- .cleanH5(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering)
params <- .transformDataForComp(.giveListFormat(x), compare, compareOpts,
processFun = processFun,
elements = elements, dateRange = dateRange)
# paramCoe <- .testParamsConsistency(params = params, mcYear = mcYear)
# mcYear <- paramCoe$mcYear
if (is.null(table)) table <- names(params$x[[1]])[1]
if (is.null(mcYear)) mcYear <- "average"
L_w <- lapply(params$x, function(X){
X[[table]]$plotFun(mcYear, 1, variable, variable2Axe, elements, type, confInt, dateRange,
minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main)
})
return(combineWidgets(list = L_w))
}
# typeChoices <- c("ts", "barplot", "monotone", "density", "cdf", "heatmap")
# names(typeChoices) <- c(.getLabelLanguage("time series", language), .getLabelLanguage("barplot", language),
# .getLabelLanguage("monotone", language), .getLabelLanguage("density", language),
# .getLabelLanguage("cdf", language), .getLabelLanguage("heatmap", language))
# BP 2017
typeChoices <- c("ts","monotone")
names(typeChoices) <- c(.getLabelLanguage("time series", language), .getLabelLanguage("monotone", language))
##remove notes
table <- NULL
x_in <- NULL
paramsH5 <- NULL
timeSteph5 <- NULL
mcYearH5 <- NULL
sharerequest <- NULL
timeStepdataload <- NULL
x_tranform <- NULL
manipulateWidget({
.tryCloseH5()
if(.id <= length(params$x)){
if(length(variable) == 0){return(combineWidgets(switch(language,
"fr" = "Veuillez sélectionner des variables",
"Please select some variables")))}
if(length(elements) == 0){return(combineWidgets(switch(language,
"fr" = "Veuillez sélectionner des éléments",
"Please select some elements")))}
if(length(params[["x"]][[max(1,.id)]]) == 0){return(combineWidgets(switch(language,
"fr" = "Pas de données",
"No data")))}
if(is.null(params[["x"]][[max(1,.id)]][[table]])){return(combineWidgets(switch(language,
"fr" = paste0("Table ", table, " absente de l'étude"),
paste0("Table ", table, " not exists in this study"))))}
if(!secondAxis){
variable2Axe <- NULL
} else {
aggregate <- "none"
}
widget <- params[["x"]][[max(1,.id)]][[table]]$plotFun(mcYear, .id, variable, variable2Axe, elements, type, confInt,
dateRange, minValue, maxValue, aggregate, legend,
highlight, stepPlot, drawPoints, main)
controlWidgetSize(widget, language)
} else {
combineWidgets(switch(language,
"fr" = "Pas de données pour cette sélection",
"No data for this selection"))
}
},
x = mwSharedValue({x}),
# #Output
# outPutGraph = mwSharedValue({
# ls()
# }),
x_in = mwSharedValue({
.giveListFormat(x)
}),
h5requestFiltering = mwSharedValue({h5requestFiltering}),
paramsH5 = mwSharedValue({
.h5ParamList(X_I = x_in, xyCompare = xyCompare, h5requestFilter = h5requestFiltering)
}),
H5request = mwGroup(
label = .getLabelLanguage("H5request", language),
# BP 2017
eventsH5 = mwSelect(choices = {
choix = c("By event", "By mcYear")
names(choix) <- sapply(choix, function(tmp) .getLabelLanguage(tmp, language))
choix
}, value = "By event",
multiple = FALSE, label = .getLabelLanguage("Selection", language), .display = !"eventsH5" %in% hidden),
timeSteph5 = mwSelect(
{
if(length(paramsH5) > 0 & length(eventsH5) > 0){
# choices = paramsH5$timeStepS
# BP 2017
if(eventsH5 %in% "By event"){
choices = c("hourly")
} else {
choices = setdiff(paramsH5$timeStepS, "annual")
}
names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
choices
} else {
NULL
}
},
value = if(.initial) {
paramsH5$timeStepS[1]
}else{NULL},
label = .getLabelLanguage("timeStep", language),
multiple = FALSE, .display = !"timeSteph5" %in% hidden & length(intersect("By mcYear", eventsH5)) > 0
),
tables = mwSelect(
{
# choices = paramsH5[["tabl"]]
# BP 2017
choices <- c("areas", "links")
names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
choices
},
value = {
if(.initial) {paramsH5[["tabl"]][1]}else{NULL}
},
label = .getLabelLanguage("table", language), multiple = TRUE,
.display = !"tables" %in% hidden
),
# mcYearH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]),
# # value = {
# # if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
# # },
# # BP 2017
# value = c(1:2),
# label = .getLabelLanguage("mcYears to be imported", language), multiple = TRUE,
# .display = !"mcYearH5" %in% hidden
# ),
mcYearH5 = mwSelect(choices = {
if(length(eventsH5) > 0){
if(eventsH5 %in% "By event"){
bp_mcy_params_labels
} else {
paramsH5[["mcYearS"]]
}
} else {
NULL
}
},
value = "35",
label = .getLabelLanguage("mcYears to be imported", language),
.display = (!"mcYearH5" %in% hidden & length(intersect("By mcYear", eventsH5)) > 0 & !meanYearH5) |
(!"mcYearH5" %in% hidden & length(intersect("By event", eventsH5)) > 0)
),
meanYearH5 = mwCheckbox(value = FALSE,
label = .getLabelLanguage("Average mcYear", language),
.display = !"meanYearH5" %in% hidden & length(intersect("By mcYear", eventsH5)) > 0),
.display = {
any(unlist(lapply(x_in, .isSimOpts))) & !"H5request" %in% hidden
}),
sharerequest = mwSharedValue({
if(length(meanYearH5) > 0 & length(eventsH5) > 0){
if(meanYearH5 & eventsH5 %in% "By mcYear"){
list(timeSteph5_l = timeSteph5, mcYearh_l = NULL, tables_l = tables)
} else {
list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables)
}
} else {
list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables)
}
}),
x_tranform = mwSharedValue({
dataInApp <- sapply(1:length(x_in),function(zz){
.loadH5Data(sharerequest, x_in[[zz]], h5requestFilter = paramsH5$h5requestFilter[[zz]])
}, simplify = FALSE)
dataInApp
}),
table = mwSelect(
{
if(!is.null(params)){
# out <- as.character(.compareOperation(
# lapply(params$x, function(vv){
# unique(names(vv))
# }), xyCompare))
# BP 2017
out <- c("areas", "links")
if(length(out) > 0){
names(out) <- sapply(out, function(x) .getLabelLanguage(x, language))
out
}else{"No Input"}
}
},
value = {
if(.initial) table
else NULL
}, .display = length(as.character(.compareOperation(
lapply(params$x, function(vv){
unique(names(vv))
}), xyCompare))) > 1 & !"table" %in% hidden,
label = .getLabelLanguage("table", language)
),
mcYear = mwSelect(
choices = {
# tmp <- c("average", if(!is.null(params)){
# as.character(.compareOperation(lapply(params$x, function(vv){
# unique(vv[[table]]$uniqueMcYears)
# }), xyCompare))})
# names(tmp) <- sapply(tmp, function(x) .getLabelLanguage(x, language))
# tmp
# BP 2017
allMcY <- .compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueMcYears)
}), xyCompare)
names(allMcY) <- allMcY
if(is.null(allMcY)){
allMcY <- "average"
names(allMcY) <- .getLabelLanguage("average", language)
}
allMcY
},
value = {
# if(.initial) "average"
# BP 2017
if(.initial) mcYear
else NULL
}, multiple = FALSE,
label = .getLabelLanguage("mcYear to be displayed", language),
.display = !"mcYear" %in% hidden
),
variable = mwSelect(
choices = {
if(!is.null(params)){
out <- as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$valueCols)
}), xyCompare))
if(length(out) > 0){out} else {"No Input"}
}
},
value = {
if(.initial){
if(is.null(variable)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$valueCols)
}), xyCompare))[1]
} else {
variable
}
} else {
NULL
}
}, multiple = TRUE,
label = .getLabelLanguage("variable", language),
.display = !"variable" %in% hidden
),
secondAxis = mwCheckbox(secondAxis, label = .getLabelLanguage("secondAxis", language),
.display = !"secondAxis" %in% hidden),
variable2Axe = mwSelect(label = .getLabelLanguage("Variables 2nd axis", language),
choices = {
if(!is.null(params)){
out <- as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$valueCols)
}), xyCompare))
out <- out[!out%in%variable]
if(length(out) > 0){out} else {"No Input"}
}
},
value = {
if(.initial) variable2Axe
else NULL
}, multiple = TRUE, .display = secondAxis & !"variable2Axe" %in% hidden
),
type = mwSelect(
choices = {
if (timeStepdataload == "annual") "barplot"
else if (timeStepdataload %in% c("hourly", "daily")) typeChoices
else setdiff(typeChoices, "heatmap")
},
value = {
if(.initial) type
else NULL
},
.display = timeStepdataload != "annual" & !"type" %in% hidden,
label = .getLabelLanguage("type", language)
),
dateRange = mwDateRange(value = {
# if(.initial){
# res <- NULL
# if(!is.null(params) & ! is.null(table)){
# res <- c(.dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table),
# .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table))
# if(any(is.infinite(c(res))))
# {res <- NULL}
# }
# ##Lock 7 days for hourly data
# if(!is.null(params$x[[1]][[table]]$timeStep)){
# if(params$x[[1]][[table]]$timeStep == "hourly"){
# # if(params$x[[1]][[table]]$dateRange[2] - params$x[[1]][[table]]$dateRange[1]>7){
# # res[1] <- params$x[[1]][[table]]$dateRange[2] - 7
# # }
# # BP 2017
# res <- c("2029-01-15", "2029-01-21")
# }
# }
# res
# }else{NULL}
# BP 2017
if(length(intersect("By event", eventsH5) > 0)){
tmp_mcYear <- as.character(mcYear)
c(bp_mcy_params[mcYear == tmp_mcYear, date_start], bp_mcy_params[mcYear == tmp_mcYear, date_end])
} else if(.initial){
c("2029-01-15", "2029-01-21")
} else if(params$x[[1]][[1]]$timeStep %in% c("daily", "weekly", "monthly")){
c("2028-07-01", "2029-06-29")
}
},
min = {
if(!is.null(params) & ! is.null(table)){
R <- .dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table)
if(is.infinite(R)){NULL}else{R}
# BP 17
"2028-07-01"
}
},
max = {
# if(!is.null(params) & ! is.null(table)){
# R <- .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table)
# if(is.infinite(R)){NULL}else{R}
# }
# BP 17
"2029-06-29"
},
language = eval(parse(text = "language")),
# BP 2017
format = "dd MM",
separator = " : ",
weekstart = 1,
# .display = timeStepdataload != "annual" & !"dateRange" %in% hidden,
# BP 17
.display = timeStepdataload != "annual" & !"dateRange" %in% hidden & eventsH5 %in% "By mcYear",
label = .getLabelLanguage("dateRange", language)
),
confInt = mwSlider(0, 1, confInt, step = 0.01,
label = .getLabelLanguage("confidence interval", language),
.display = params$x[[max(1,.id)]][[table]]$showConfInt & mcYear == "average" & !"confInt" %in% hidden
),
minValue = mwNumeric(minValue, label = .getLabelLanguage("min value", language),
.display = type %in% c("density", "cdf") & !"minValue" %in% hidden
),
maxValue = mwNumeric(maxValue, label = .getLabelLanguage("max value", language),
.display = type %in% c("density", "cdf") & !"maxValue" %in% hidden
),
elements = mwSelect(
choices = {
# c( if(!is.null(params)){
# as.character(.compareOperation(lapply(params$x, function(vv){
# unique(vv[[table]]$uniqueElem)
# }), xyCompare))
# })
# BP 2017
choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
choix[grepl("fr", choix)]
},
value = {
if(.initial) {
if(is.null(elements)){
# as.character(.compareOperation(lapply(params$x, function(vv){
# unique(vv[[table]]$uniqueElem)
# }), xyCompare))[1]
#
# BP 2017
choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
choix[grepl("fr", choix)][1]
}else {
elements
}
} else {
# BP 2017
choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
choix[grepl("fr", choix)][1]
}
},
multiple = TRUE,
label = .getLabelLanguage("elements", language),
.display = !"elements" %in% hidden
),
aggregate = mwSelect({
tmp <- c("none", "mean", "sum", "mean by areas", "sum by areas")
names(tmp) <- c(.getLabelLanguage("none", language),
.getLabelLanguage("mean", language),
.getLabelLanguage("sum", language),
.getLabelLanguage("mean by areas", language),
.getLabelLanguage("sum by areas", language))
tmp
}, value ={
if(.initial) aggregate
else NULL
}, .display = !secondAxis & !"aggregate" %in% hidden,
label = .getLabelLanguage("aggregate", language)
),
legend = mwCheckbox(legend, .display = type %in% c("ts", "density", "cdf") & !"legend" %in% hidden,
label = .getLabelLanguage("legend", language)),
highlight = mwCheckbox(highlight, label = .getLabelLanguage("highlight", language),
.display = !"highlight" %in% hidden),
stepPlot = mwCheckbox(stepPlot, label = .getLabelLanguage("stepPlot", language),
.display = !"stepPlot" %in% hidden),
drawPoints = mwCheckbox(drawPoints, label =.getLabelLanguage("drawPoints", language),
.display = !"drawPoints" %in% hidden),
timeStepdataload = mwSharedValue({
attributes(x_tranform[[1]])$timeStep
}),
main = mwText(main, label = .getLabelLanguage("title", language),
.display = !"main" %in% hidden),
params = mwSharedValue({
.transformDataForComp(x_tranform, compare, compareOpts, processFun = processFun,
elements = init_elements, dateRange = init_dateRange)
}),
.compare = {
compare
},
.compareOpts = {
compareOptions
},
...
)
}
#' @export
#' @rdname tsPlot
#' @method plot antaresData
plot.antaresData <- tsPlot
#' @export
#' @rdname tsPlot
#' @method plot simOptions
plot.simOptions <- tsPlot
#' @export
#' @rdname tsPlot
#' @method plot list
plot.list <- tsPlot
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.