diff --git a/DESCRIPTION b/DESCRIPTION
index 254cd1b..0fc1807 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Package: antaresViz
Type: Package
Title: Antares Visualizations
-Version: 0.12.0
-Date: 2017-12-14
+Version: 0.13.0
+Date: 2018-03-28
Authors@R: c(
person("Jalal-Edine", "ZAWAM", , "jalal-edine.zawam@rte-france.com", role = c("aut", "cre")),
person("Francois", "Guillem", , "francois.guillem@rte-france.com", role = "aut"),
diff --git a/R/limitSizeGraph.R b/R/limitSizeGraph.R
index 6d78631..e69731d 100644
--- a/R/limitSizeGraph.R
+++ b/R/limitSizeGraph.R
@@ -11,13 +11,21 @@ limitSizeGraph <- function(size){
options(antaresVizSizeGraph = size)
}
-controlWidgetSize <- function(widget){
+# @importFrom pryr object_size
+controlWidgetSize <- function(widget, language = "en"){
if(is.null(getOption("antaresVizSizeGraph"))){
options(antaresVizSizeGraph = 200)
}
+ # round(as.numeric(pryr::object_size(widget)) / 1048000, 1)
if(round(as.numeric(object.size(widget)) / 1048000, 1) > getOption("antaresVizSizeGraph")){
- return(combineWidgets(antaresVizSizeGraphError))
+ return(
+ combineWidgets(
+ switch(language,
+ "fr" = antaresVizSizeGraphError_fr,
+ antaresVizSizeGraphError)
+ )
+ )
} else {
widget
}
diff --git a/R/map.R b/R/map.R
index 11436a6..c8c86b1 100644
--- a/R/map.R
+++ b/R/map.R
@@ -155,7 +155,8 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
timeSteph5 = "hourly",
mcYearh5 = NULL,
tablesh5 = c("areas", "links"),
- sizeMiniPlot = FALSE,...) {
+ sizeMiniPlot = FALSE,language = "en",
+ hidden = NULL, ...) {
if(!is.null(compare) && !interactive){
@@ -165,6 +166,26 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
Column <- optionsT <- NULL
tpMap <- plotMapOptions()
+ # Check language
+ if(!language %in% availableLanguages_labels){
+ stop("Invalid 'language' argument. Must be in : ", paste(availableLanguages_labels, collapse = ", "))
+ }
+
+ if(language != "en"){
+ colAreaVar <- .getColumnsLanguage(colAreaVar, language)
+ sizeAreaVars <- .getColumnsLanguage(sizeAreaVars, language)
+ popupAreaVars <- .getColumnsLanguage(popupAreaVars, language)
+ labelAreaVar <- .getColumnsLanguage(labelAreaVar, language)
+ colLinkVar <- .getColumnsLanguage(colLinkVar, language)
+ sizeLinkVar <- .getColumnsLanguage(sizeLinkVar, language)
+ popupLinkVars <- .getColumnsLanguage(popupLinkVars, language)
+ }
+
+ # Check hidden
+ .validHidden(hidden, c("H5request", "timeSteph5", "tables", "mcYearH5", "mcYear", "dateRange", "Areas", "colAreaVar",
+ "sizeAreaVars", "miniPlot", "areaChartType", "sizeMiniPlot", "uniqueScale", "showLabels",
+ "popupAreaVars", "labelAreaVar", "Links", "colLinkVar", "sizeLinkVar", "popupLinkVars","type"))
+
#Check compare
.validCompare(compare, c("mcYear", "type", "colAreaVar", "sizeAreaVars", "areaChartType", "showLabels",
"popupAreaVars", "labelAreaVar","colLinkVar", "sizeLinkVar", "popupLinkVars"))
@@ -176,15 +197,18 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
areaChartType <- match.arg(areaChartType)
xyCompare <- match.arg(xyCompare)
- if(colAreaVar != "none" & colAreaVar%in%colorsVars$Column & runScale)
+ tmp_colAreaVar <- gsub("(_std$)|(_min$)|(_max$)", "", colAreaVar)
+ if(tmp_colAreaVar != "none" & tmp_colAreaVar%in%colorsVars$Column & runScale)
{
- raw <- colorsVars[Column == colAreaVar]
+ raw <- colorsVars[Column == tmp_colAreaVar]
options <- plotMapOptions(areaColorScaleOpts = colorScaleOptions(
- negCol = "#FFFFFF",
- zeroCol = rgb(raw$red, raw$green, raw$blue, maxColorValue = 255),
- posCol = rgb(raw$red/2, raw$green/2, raw$blue/2, maxColorValue = 255)))
-
+ negCol = "#FF0000",
+ # zeroCol = rgb(raw$red, raw$green, raw$blue, maxColorValue = 255),
+ # posCol = rgb(raw$red/2, raw$green/2, raw$blue/2, maxColorValue = 255)),
+ zeroCol = "#FFFFFF",
+ posCol = rgb(raw$red, raw$green, raw$blue, maxColorValue = 255)))
}
+
if (is.null(mcYear)) mcYear <- "average"
if(!is.null(compare) && "list" %in% class(x)){
@@ -258,7 +282,7 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
}
- }
+ }
# Keep only links and areas present in the data
if (areas) {
@@ -325,7 +349,7 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
# print(dateRange)
if(!is.null(dateRange)){
dateRange <- sort(dateRange)
- # xx <<- copy(x$areas)
+ # xx <<- copy(x)
# dd <<- dateRange
if(!is.null(x$areas))
{
@@ -333,6 +357,9 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
if("character" %in% class(x$areas$time)){
x$areas[,time := .timeIdToDate(x$areas$timeId, attr(x, "timeStep"), simOptions(x))]
}
+ if("Date" %in% class(x$areas$time)){
+ x$areas[,time := as.POSIXct(time, tz = "UTC")]
+ }
x$areas <- x$areas[time >= as.POSIXlt(dateRange[1], tz = "UTC") & time < as.POSIXlt(dateRange[2] + 1, tz = "UTC")]
}
if(!is.null(x$links))
@@ -341,31 +368,73 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
if("character" %in% class(x$links$time)){
x$links[,time := .timeIdToDate(x$links$timeId, attr(x, "timeStep"), simOptions(x))]
}
+ if("Date" %in% class(x$links$time)){
+ x$links[,time := as.POSIXct(time, tz = "UTC")]
+ }
x$links <- x$links[time >= as.POSIXlt(dateRange[1], tz = "UTC") & time < as.POSIXlt(dateRange[2] + 1, tz = "UTC")]
}
}
if (initial) {
assign("currentMapLayout", mapLayout, envir = env_plotFun)
- map <- .initMap(x, mapLayout, options) %>% syncWith(group)
+ map <- .initMap(x, mapLayout, options, language = language) %>% syncWith(group)
} else if(!isTRUE(all.equal(mapLayout, get("currentMapLayout", envir = env_plotFun)))){
assign("currentMapLayout", mapLayout)
- map <- .initMap(x, mapLayout, options) %>% syncWith(group)
+ map <- .initMap(x, mapLayout, options, language = language) %>% syncWith(group)
} else {
# in some case, map doesn't existed yet....!
if("output_1_zoom" %in% names(session$input)){
map <- leafletProxy(outputId, session)
} else {
- map <- .initMap(x, mapLayout, options) %>% syncWith(group)
+ map <- .initMap(x, mapLayout, options, language = language) %>% syncWith(group)
}
}
- map %>%
+ map <- map %>%
.redrawLinks(x, mapLayout, mcYear, t, colLinkVar, sizeLinkVar, popupLinkVars, options) %>%
.redrawCircles(x, mapLayout, mcYear, t, colAreaVar, sizeAreaVars, popupAreaVars,
uniqueScale, showLabels, labelAreaVar, areaChartType, options, sizeMiniPlot)
+
+ # combineWidgets(map, width = width, height = height) # bug
+ map
+
}
+
# Create the interactive widget
+ if(language != "en"){
+ ind_to_change <- which(colnames(x$areas) %in% language_columns$en)
+ if(length(ind_to_change) > 0){
+ new_name <- language_columns[en %in% colnames(x$areas), ]
+ v_new_name <- new_name[[language]]
+ names(v_new_name) <- new_name[["en"]]
+ setnames(x$areas, colnames(x$areas)[ind_to_change], unname(v_new_name[colnames(x$areas)[ind_to_change]]))
+ }
+
+ ind_to_change <- which(colnames(syntx$areas) %in% language_columns$en)
+ if(length(ind_to_change) > 0){
+ new_name <- language_columns[en %in% colnames(syntx$areas), ]
+ v_new_name <- new_name[[language]]
+ names(v_new_name) <- new_name[["en"]]
+ setnames(syntx$areas, colnames(syntx$areas)[ind_to_change], unname(v_new_name[colnames(syntx$areas)[ind_to_change]]))
+ }
+
+ ind_to_change <- which(colnames(x$links) %in% language_columns$en)
+ if(length(ind_to_change) > 0){
+ new_name <- language_columns[en %in% colnames(x$links), ]
+ v_new_name <- new_name[[language]]
+ names(v_new_name) <- new_name[["en"]]
+ setnames(x$links, colnames(x$links)[ind_to_change], unname(v_new_name[colnames(x$links)[ind_to_change]]))
+ }
+
+ ind_to_change <- which(colnames(syntx$links) %in% language_columns$en)
+ if(length(ind_to_change) > 0){
+ new_name <- language_columns[en %in% colnames(syntx$links), ]
+ v_new_name <- new_name[[language]]
+ names(v_new_name) <- new_name[["en"]]
+ setnames(syntx$links, colnames(syntx$links)[ind_to_change], unname(v_new_name[colnames(syntx$links)[ind_to_change]]))
+ }
+ }
+
areaValColumns <- setdiff(names(x$areas), .idCols(x$areas))
areaValColumnsSynt <- setdiff(names(syntx$areas), .idCols(syntx$areas))
@@ -436,29 +505,30 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
tmp_options <- plotMapOptions()
}
- params$x[[.id]]$plotFun(t = params$x[[.id]]$timeId,
- colAreaVar = colAreaVar,
- sizeAreaVars = sizeAreaVars,
- popupAreaVars = popupAreaVars,
- areaChartType = areaChartType,
- uniqueScale = uniqueScale,
- showLabels = showLabels,
- labelAreaVar = labelAreaVar,
- colLinkVar = colLinkVar,
- sizeLinkVar = sizeLinkVar,
- popupLinkVars = popupLinkVars,
- type = type,
- mcYear = mcYear,
- initial = .initial,
- session = .session,
- outputId = .output,
- dateRange = dateRange,
- sizeMiniPlot = sizeMiniPlot,
- options = tmp_options)
-
+ widget <- params$x[[.id]]$plotFun(t = params$x[[.id]]$timeId,
+ colAreaVar = colAreaVar,
+ sizeAreaVars = sizeAreaVars,
+ popupAreaVars = popupAreaVars,
+ areaChartType = areaChartType,
+ uniqueScale = uniqueScale,
+ showLabels = showLabels,
+ labelAreaVar = labelAreaVar,
+ colLinkVar = colLinkVar,
+ sizeLinkVar = sizeLinkVar,
+ popupLinkVars = popupLinkVars,
+ type = type,
+ mcYear = mcYear,
+ initial = .initial,
+ session = .session,
+ outputId = .output,
+ dateRange = dateRange,
+ sizeMiniPlot = sizeMiniPlot,
+ options = tmp_options)
+ # controlWidgetSize(widget, language) # bug due to leaflet and widget
+ widget
} else {
- combineWidgets("No data for this selection")
+ combineWidgets(.getLabelLanguage("No data for this selection", language))
}
}else{
combineWidgets()
@@ -469,19 +539,7 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
x_in = mwSharedValue({
.giveListFormat(x)
}),
- options = mwSharedValue({options}),
- optionsT = mwSharedValue({
- if(colAreaVar %in% colorsVars$Column & runScale){
- raw <- colorsVars[Column == colAreaVar]
- plotMapOptions(areaColorScaleOpts = colorScaleOptions(
- negCol = "#FFFFFF",
- zeroCol = rgb(raw$red, raw$green, raw$blue, maxColorValue = 255),
- posCol = rgb(raw$red/2, raw$green/2, raw$blue/2, maxColorValue = 255))
- )
- }else{
- options
- }
- }),
+
h5requestFiltering = mwSharedValue({h5requestFiltering}),
paramsH5 = mwSharedValue({
@@ -490,24 +548,65 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
paramsH5List
}),
H5request = mwGroup(
- timeSteph5 = mwSelect(choices = paramsH5$timeStepS,
- value = paramsH5$timeStepS[1],
- label = "timeStep",
- multiple = FALSE),
- tables = mwSelect(choices = paramsH5[["tabl"]][paramsH5[["tabl"]] %in% c("areas", "links")],
- value = {
- if(.initial) {paramsH5[["tabl"]][paramsH5[["tabl"]] %in% c("areas", "links")]} else {NULL}
- },
- label = "table", multiple = TRUE),
- mcYearH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]),
- value = {
- if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
- },
- label = "mcYear", multiple = TRUE),
- .display = {any(unlist(lapply(x_in, .isSimOpts)))}
+ label = .getLabelLanguage("H5request", language),
+ timeSteph5 = mwSelect(
+ {
+ if(length(paramsH5) > 0){
+ choices = paramsH5$timeStepS
+ names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
+ } else {
+ choices <- NULL
+ }
+ choices
+ },
+ value = paramsH5$timeStepS[1],
+ label = .getLabelLanguage("timeStep", language),
+ multiple = FALSE, .display = !"timeSteph5" %in% hidden
+ ),
+ tables = mwSelect(
+ {
+ if(length(paramsH5) > 0){
+ choices = paramsH5[["tabl"]][paramsH5[["tabl"]] %in% c("areas", "links")]
+ names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
+ } else {
+ choices <- NULL
+ }
+ choices
+ },
+ value = {
+ if(.initial) {paramsH5[["tabl"]][paramsH5[["tabl"]] %in% c("areas", "links")]} else {NULL}
+ },
+ label = .getLabelLanguage("table", language), multiple = TRUE,
+ .display = !"tables" %in% hidden
+ ),
+ mcYearH5 = mwSelectize(
+ choices = {
+ ch <- c("Average" = "", paramsH5[["mcYearS"]])
+ names(ch)[1] <- .getLabelLanguage("Average", language)
+ ch
+ },
+ value = {
+ if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
+ },
+ label = .getLabelLanguage("mcYears to be imported", language),
+ multiple = TRUE, options = list(maxItems = 4),
+ .display = (!"mcYearH5" %in% hidden & !meanYearH5)
+ ),
+ meanYearH5 = mwCheckbox(value = FALSE,
+ label = .getLabelLanguage("Average mcYear", language),
+ .display = !"meanYearH5" %in% hidden),
+ .display = {any(unlist(lapply(x_in, .isSimOpts))) & !"H5request" %in% hidden}
),
sharerequest = mwSharedValue({
- list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables)
+ if(length(meanYearH5) > 0){
+ if(meanYearH5){
+ 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({
sapply(1:length(x_in),function(zz){
@@ -516,151 +615,263 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(),
}),
##Stop h5
- mcYear = mwSelect({
- c("average", as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$x[[1]]$mcYear)
- }), xyCompare)))
- },
- value = { if(.initial) mcYear else NULL},
- .display = any(unlist(lapply(params$x, function(X){X$showMcYear})))
+ mcYear = mwSelect(
+ {
+ # allMcY <- c("average", .compareOperation(lapply(params$x, function(vv){
+ # unique(c(vv$x$areas$mcYear, vv$x$links$mcYear))
+ # }), xyCompare))
+ # names(allMcY) <- c(.getLabelLanguage("average", language), allMcY[-1])
+ # allMcY
+ # BP 2017
+ allMcY <- .compareOperation(lapply(params$x, function(vv){
+ unique(c(vv$x$areas$mcYear, vv$x$links$mcYear))
+ }), xyCompare)
+ names(allMcY) <- allMcY
+ if(is.null(allMcY)){
+ allMcY <- "average"
+ names(allMcY) <- .getLabelLanguage("average", language)
+ }
+ allMcY
+
+ },
+ value = { if(.initial) mcYear else NULL},
+ .display = any(unlist(lapply(params$x, function(X){X$showMcYear}))) & !"mcYear" %in% hidden,
+ label = .getLabelLanguage("mcYear to be displayed", language)
+ ),
+ type = mwRadio(
+ {
+ choices <- c("detail", "avg")
+ names(choices) <- c(.getLabelLanguage("By time id", language), .getLabelLanguage("Average", language))
+ choices
+ },
+ value = type,
+ label = .getLabelLanguage("type", language),
+ .display = !"type" %in% hidden
),
- type = mwRadio(list("By time id"="detail", "Average" = "avg"), value = type),
dateRange = mwDateRange(
value = {
if(.initial) params$x[[1]]$dateRange
else NULL
},
min = params$x[[1]]$dateRange[1],
- max = params$x[[1]]$dateRange[2],label = "Daterange"
+ max = params$x[[1]]$dateRange[2],
+ language = eval(parse(text = "language")),
+ # format = "dd MM",
+ separator = " : ",
+ label = .getLabelLanguage("dateRange", language),
+ .display = !"dateRange" %in% hidden
),
Areas = mwGroup(
+ label = .getLabelLanguage("Areas", language),
colAreaVar = mwSelect(
choices = {
- if (mcYear == "average") {
- c("none",
- as.character(.compareOperation(lapply(params$x, function(vv){
+ if(length(params) > 0){
+ if (mcYear == "average") {
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv$areaValColumnsSynt)
- }), xyCompare))
- )
- }else{
- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$areaValColumns)
- }), xyCompare)))
+ }), xyCompare)))
+ }else{
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$areaValColumns)
+ }), xyCompare)))
+ }
+ names(tmp) <- c(.getLabelLanguage("none", language), tmp[-1])
+ tmp
+ } else {
+ NULL
}
},
value = {
if(.initial) colAreaVar
else NULL
},
- label = "Color"
+ label = .getLabelLanguage("Color", language),
+ .display = !"colAreaVar" %in% hidden
),
sizeAreaVars = mwSelect(
{
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$areaNumValColumns)
- }), xyCompare))
+ if(length(params) > 0){
+ as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$areaNumValColumns)
+ }), xyCompare))
+ } else {
+ NULL
+ }
},
value = {
if(.initial) sizeAreaVars
else NULL
- }, label = "Size", multiple = TRUE),
+ },
+ label = .getLabelLanguage("Size", language),
+ multiple = TRUE, .display = !"sizeAreaVars" %in% hidden
+ ),
miniPlot = mwGroup(
- areaChartType = mwSelect(list("bar chart" = "bar",
- "pie chart" = "pie",
- "polar (area)" = "polar-area",
- "polar (radius)" = "polar-radius"),
- value = {
- if(.initial) areaChartType
- else NULL
- }),
- sizeMiniPlot = mwCheckbox(FALSE),
- .display = length(sizeAreaVars) >= 2),
- uniqueScale = mwCheckbox(uniqueScale, label = "Unique scale",
- .display = length(sizeAreaVars) >= 2 && areaChartType != "pie"),
- showLabels = mwCheckbox(showLabels, label = "Show labels",
- .display = length(sizeAreaVars) >= 2),
+ label = .getLabelLanguage("miniPlot", language),
+ areaChartType = mwSelect(
+ {
+ choices <- c("bar", "pie", "polar-area", "polar-radius")
+ names(choices) <- c(.getLabelLanguage("bar chart", language),
+ .getLabelLanguage("pie chart", language),
+ .getLabelLanguage("polar (area)", language),
+ .getLabelLanguage("polar (radius)", language))
+ choices
+ },
+ value = {
+ if(.initial) areaChartType
+ else NULL
+ }, label = .getLabelLanguage("areaChartType", language),
+ .display = !"areaChartType" %in% hidden
+ ),
+ sizeMiniPlot = mwCheckbox(sizeMiniPlot, label = .getLabelLanguage("sizeMiniPlot", language)),
+ .display = length(sizeAreaVars) >= 2 & !"miniPlot" %in% hidden
+ ),
+ uniqueScale = mwCheckbox(uniqueScale, label = .getLabelLanguage("Unique scale", language),
+ .display = length(sizeAreaVars) >= 2 && areaChartType != "pie" & !"uniqueScale" %in% hidden
+ ),
+ showLabels = mwCheckbox(showLabels, label = .getLabelLanguage("Show labels", language),
+ .display = length(sizeAreaVars) >= 2 & !"showLabels" %in% hidden
+ ),
popupAreaVars = mwSelect(
choices =
{
- if (mcYear == "average") {
- c("none",
- as.character(.compareOperation(lapply(params$x, function(vv){
+ if(length(params) > 0){
+ if (mcYear == "average") {
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv$areaValColumnsSynt)
}), xyCompare))
- )
- }else{
- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$areaValColumns)
- }), xyCompare)))
+ )
+ }else{
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$areaValColumns)
+ }), xyCompare)))
+ }
+ names(tmp) <- c(.getLabelLanguage("none", language), tmp[-1])
+ tmp
+ } else {
+ NULL
}
},
value = {
if(.initial) popupAreaVars
else NULL
},
- label = "Popup",
- multiple = TRUE
+ label = .getLabelLanguage("Popup", language),
+ multiple = TRUE, .display = !"popupAreaVars" %in% hidden
),
labelAreaVar = mwSelect(
- choices = {
- if (mcYear == "average") {
- c("none",
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$areaValColumnsSynt)
- }), xyCompare))
- )
- }else{
- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$areaValColumns)
- }), xyCompare)))
+ choices = {
+ if(length(params) > 0){
+ if (mcYear == "average") {
+ tmp <- c("none",
+ as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$areaValColumnsSynt)
+ }), xyCompare))
+ )
+ }else{
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$areaValColumns)
+ }), xyCompare)))
+ }
+ names(tmp) <- c(.getLabelLanguage("none", language), tmp[-1])
+ tmp
+ } else {
+ NULL
}
},
value = {
if(.initial) labelAreaVar
else NULL
- }, label = "Label",
- .display = length(sizeAreaVars) < 2
+ }, label = .getLabelLanguage("Label", language),
+ .display = length(sizeAreaVars) < 2 & !"labelAreaVar" %in% hidden
),
- .display = any(sapply(params$x, function(p) {"areas" %in% names(p$x)}))
+ .display = any(sapply(params$x, function(p) {"areas" %in% names(p$x)})) & !"Areas" %in% hidden
),
Links = mwGroup(
+ label = .getLabelLanguage("Links", language),
colLinkVar = mwSelect(
{
- c("none",
- as.character(.compareOperation(lapply(params$x, function(vv){
+ if(length(params) > 0){
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv$linkValColums)
}), xyCompare)))
+ names(tmp) <- c(.getLabelLanguage("none", language), tmp[-1])
+ tmp
+ } else {
+ NULL
+ }
},
value = {
if(.initial) colLinkVar
else NULL
- }, label = "Color"),
- sizeLinkVar = mwSelect({c("none",
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$linkNumValColumns)
- }), xyCompare))
- )},
- value = {
- if(.initial) sizeLinkVar
- else NULL
- }, label = "Width"),
- popupLinkVars = mwSelect( { c("none",
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$linkValColums)
- }), xyCompare)))
- },
- value = {
- if(.initial) popupLinkVars
- else NULL
- }, label = "Popup", multiple = TRUE),
- .display = any(sapply(params$x, function(p) {"links" %in% names(p$x)}))
+ }, label = .getLabelLanguage("Color", language), .display = !"colLinkVar" %in% hidden
+ ),
+ sizeLinkVar = mwSelect(
+ {
+ if(length(params) > 0){
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$linkNumValColumns)
+ }), xyCompare)))
+ names(tmp) <- c(.getLabelLanguage("none", language), tmp[-1])
+ tmp
+ } else {
+ NULL
+ }
+
+ },
+ value = {
+ if(.initial) sizeLinkVar
+ else NULL
+ }, label = .getLabelLanguage("Width", language), .display = !"sizeLinkVar" %in% hidden
+ ),
+ popupLinkVars = mwSelect(
+ {
+ if(length(params) > 0){
+ tmp <- c("none", as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$linkValColums)
+ }), xyCompare)))
+ names(tmp) <- c(.getLabelLanguage("none", language), tmp[-1])
+ tmp
+ } else {
+ NULL
+ }
+ },
+ value = {
+ if(.initial) popupLinkVars
+ else NULL
+ }, label = .getLabelLanguage("Popup", language), multiple = TRUE, .display = !"popupLinkVars" %in% hidden
+ ),
+ .display = any(sapply(params$x, function(p) {"links" %in% names(p$x)})) & !"Links" %in% hidden
),
mapLayout = mwSharedValue(mapLayout),
params = mwSharedValue({
- .getDataForComp(x_tranform, NULL, compare, compareOpts,
- processFun = processFun, mapLayout = mapLayout)
+ if(length(x_tranform) > 0 & length(mapLayout) > 0){
+ tmp <- .getDataForComp(x_tranform, NULL, compare, compareOpts,
+ processFun = processFun, mapLayout = mapLayout)
+ tmp2 <<- tmp
+ tmp
+ }
+ }),
+ options = mwSharedValue({options}),
+ optionsT = mwSharedValue({
+ if(length(colAreaVar) > 0){
+ tmp_colAreaVar <- gsub("(_std$)|(_min$)|(_max$)", "", colAreaVar)
+ if(tmp_colAreaVar %in% colorsVars$Column & runScale){
+ raw <- colorsVars[Column == tmp_colAreaVar]
+ plotMapOptions(areaColorScaleOpts = colorScaleOptions(
+ negCol = "#FF0000",
+ # zeroCol = rgb(raw$red, raw$green, raw$blue, maxColorValue = 255),
+ # posCol = rgb(raw$red/2, raw$green/2, raw$blue/2, maxColorValue = 255)),
+ zeroCol = "#FFFFFF",
+ posCol = rgb(raw$red, raw$green, raw$blue, maxColorValue = 255))
+ )
+ }else{
+ options
+ }
+ }else{
+ options
+ }
}),
.width = width,
.height = height,
diff --git a/R/map_helpers.R b/R/map_helpers.R
index b20884d..65b0dab 100644
--- a/R/map_helpers.R
+++ b/R/map_helpers.R
@@ -30,8 +30,6 @@
.getColAndSize <- function(data, coords, mergeBy, mcy, t, colVar, sizeVar,
popupVars, colorScaleOpts, labelVar = NULL) {
-
-
if (mcy != "average") data <- data[J(as.numeric(mcy))]
neededVars <- setdiff(unique(c(colVar, sizeVar, popupVars, labelVar)), "none")
@@ -78,13 +76,15 @@
# Special case of FLOW LIN
if (colVar == "FLOW LIN.") rangevar <- c(0, max(abs(rangevar)))
- if (rangevar[1] >= 0) {
- domain <- rangevar
- } else {
- domain <- c(-min(rangevar), max(rangevar))
- }
+ # if (rangevar[1] >= 0) {
+ # domain <- rangevar
+ # } else {
+ # domain <- c(-min(rangevar), max(rangevar))
+ # }
- if (colVar == "FLOW LIN.") colorScaleOpts$x <- abs(data[[colVar]])
+ domain <- rangevar
+
+ if (colVar %in% c("FLOW LIN.", .getColumnsLanguage("FLOW LIN.", language = "fr"))) colorScaleOpts$x <- abs(data[[colVar]])
else colorScaleOpts$x <- data[[colVar]]
colorScaleOpts$domain <- domain
@@ -119,7 +119,11 @@
res$dir <- sign(data$`FLOW LIN.`)
#coords[, `FLOW LIN.` := abs(`FLOW LIN.`)]
} else {
- res$dir <- 0
+ if(.getColumnsLanguage("FLOW LIN.", language = "fr") %in% names(data)){
+ res$dir <- sign(data[[.getColumnsLanguage("FLOW LIN.", language = "fr")]])
+ } else {
+ res$dir <- 0
+ }
}
# Pop-up
@@ -142,7 +146,7 @@
# Initialize a map with all elements invisible: links, circles and bar or polar
# charts
-.initMap <- function(x, ml, options) {
+.initMap <- function(x, ml, options, language = "en") {
map <- plot(ml, areas = !is.null(x$areas), links = !is.null(x$links),
colAreas = options$areaDefaultCol,
@@ -151,7 +155,7 @@
labelMaxSize = options$labelMaxSize,
tilesURL = options$tilesURL,
preprocess = options$preprocess) %>%
- addAntaresLegend(display = options$legend)
+ addAntaresLegend(display = options$legend, language = language)
addShadows(map)
}
diff --git a/R/map_plugins.R b/R/map_plugins.R
index eddf29e..be26a34 100644
--- a/R/map_plugins.R
+++ b/R/map_plugins.R
@@ -53,14 +53,18 @@ addShadows <- function(map) {
#' @noRd
addAntaresLegend <- function(map, htmlAreaColor = NULL, htmlAreaSize = NULL,
htmlLinkColor = NULL, htmlLinkSize = NULL,
- onComplete = "", display = "choose") {
+ onComplete = "", display = "choose", language = "en") {
options <- list(
htmlAreaColor = htmlAreaColor,
htmlAreaSize = htmlAreaSize,
htmlLinkColor = htmlLinkColor,
htmlLinkSize = htmlLinkSize,
onComplete = onComplete,
- display = display
+ display = display,
+ areas_name = .getLabelLanguage("Areas", language),
+ links_names = .getLabelLanguage("Links", language),
+ show_legend = .getLabelLanguage("Show legend", language),
+ hide_legend = .getLabelLanguage("Hide legend", language)
)
map %>% requireDep("antaresLegend") %>%
diff --git a/R/plot.R b/R/plot.R
index b642240..5f2829f 100644
--- a/R/plot.R
+++ b/R/plot.R
@@ -192,17 +192,33 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
secondAxis = FALSE,
timeSteph5 = "hourly",
mcYearh5 = NULL,
- tablesh5 = c("areas", "links"),...) {
+ 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))
@@ -252,6 +268,16 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
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]]))
+ }
+ }
valueCols <- setdiff(names(x), idCols)
timeStep <- attr(x, "timeStep")
opts <- simOptions(x)
@@ -293,7 +319,7 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
if (is.null(type) || !variable %in% names(x)) {
return(combineWidgets())
}
- if(variable[1] == "No Input") {return(combineWidgets("No data"))}
+ if(variable[1] == "No Input") {return(combineWidgets(.getLabelLanguage("No data", language)))}
dt <- .getTSData(
x, dt,
variable = c(variable, variable2Axe), elements = elements,
@@ -301,8 +327,8 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
mcYear = mcYear, dateRange = dateRange, aggregate = aggregate
)
- if (nrow(dt) == 0) return(combineWidgets("No data"))
-
+ if (nrow(dt) == 0) return(combineWidgets(.getLabelLanguage("No data", language)))
+
if(type == "ts"){
if(!is.null(dateRange))
{
@@ -331,6 +357,17 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
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,
@@ -352,7 +389,8 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
group = group,
highlight = highlight,
stepPlot = stepPlot,
- drawPoints = drawPoints
+ drawPoints = drawPoints,
+ language = language
)
}
@@ -377,12 +415,12 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
# 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)
+ processFun = processFun,
+ elements = elements, dateRange = dateRange)
# paramCoe <- .testParamsConsistency(params = params, mcYear = mcYear)
# mcYear <- paramCoe$mcYear
@@ -390,13 +428,16 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
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)
+ minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main)
})
return(combineWidgets(list = L_w))
}
- typeChoices <- c("time series" = "ts", "barplot", "monotone", "density", "cdf", "heatmap")
+ 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))
##remove notes
table <- NULL
@@ -412,13 +453,17 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
.tryCloseH5()
if(.id <= length(params$x)){
- if(length(variable) == 0){return(combineWidgets(paste0("Please select some variables")))}
+ if(length(variable) == 0){return(combineWidgets(.getLabelLanguage("Please select some variables", language)))}
- if(length(elements) == 0){return(combineWidgets(paste0("Please select some elements")))}
+ if(length(elements) == 0){return(combineWidgets(.getLabelLanguage("Please select some elements", language)))}
- if(length(params[["x"]][[max(1,.id)]]) == 0){return(combineWidgets(paste0("No data")))}
+ if(length(params[["x"]][[max(1,.id)]]) == 0){return(combineWidgets(.getLabelLanguage("No data", language)))}
- if(is.null(params[["x"]][[max(1,.id)]][[table]])){return(combineWidgets(paste0("Table ", table, " not exists in this study")))}
+ if(is.null(params[["x"]][[max(1,.id)]][[table]])){
+ return(combineWidgets(
+ paste0("Table ", table, " ", .getLabelLanguage("not exists in this study", language))
+ ))
+ }
if(!secondAxis){
variable2Axe <- NULL
@@ -426,11 +471,12 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
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)
+ dateRange, minValue, maxValue, aggregate, legend,
+ highlight, stepPlot, drawPoints, main)
+
+ controlWidgetSize(widget, language)
} else {
- combineWidgets("No data for this selection")
+ combineWidgets(.getLabelLanguage("No data for this selection", language))
}
},
x = mwSharedValue({x}),
@@ -451,31 +497,64 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
.h5ParamList(X_I = x_in, xyCompare = xyCompare, h5requestFilter = h5requestFiltering)
}),
-
H5request = mwGroup(
- timeSteph5 = mwSelect(choices = paramsH5$timeStepS,
- value = paramsH5$timeStepS[1],
- label = "timeStep",
- multiple = FALSE
+ label = .getLabelLanguage("H5request", language),
+ timeSteph5 = mwSelect(
+ {
+ if(length(paramsH5) > 0){
+ choices = paramsH5$timeStepS
+ 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
),
- tables = mwSelect(choices = paramsH5[["tabl"]],
- value = {
- if(.initial) {paramsH5[["tabl"]][1]}else{NULL}
- },
- label = "table", multiple = TRUE
+ tables = mwSelect(
+ {
+ choices = paramsH5[["tabl"]]
+ 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}
- },
- label = "mcYear", multiple = TRUE
+ mcYearH5 = mwSelectize(
+ choices = {
+ ch <- c("Average" = "", paramsH5[["mcYearS"]])
+ names(ch)[1] <- .getLabelLanguage("Average", language)
+ ch
+ },
+ value = {
+ if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
+ },
+ label = .getLabelLanguage("mcYears to be imported", language),
+ multiple = TRUE, options = list(maxItems = 4),
+ .display = (!"mcYearH5" %in% hidden & !meanYearH5)
),
+ meanYearH5 = mwCheckbox(value = FALSE,
+ label = .getLabelLanguage("Average mcYear", language),
+ .display = !"meanYearH5" %in% hidden),
.display = {
- any(unlist(lapply(x_in, .isSimOpts)))
+ any(unlist(lapply(x_in, .isSimOpts))) & !"H5request" %in% hidden
}),
sharerequest = mwSharedValue({
- list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables)
+ if(length(meanYearH5) > 0){
+ if(meanYearH5){
+ 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({
@@ -492,7 +571,10 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
lapply(params$x, function(vv){
unique(names(vv))
}), xyCompare))
- if(length(out) > 0){out}else{"No Input"}
+ if(length(out) > 0){
+ names(out) <- sapply(out, function(x) .getLabelLanguage(x, language))
+ out
+ }else{"No Input"}
}
},
value = {
@@ -501,21 +583,38 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
}, .display = length(as.character(.compareOperation(
lapply(params$x, function(vv){
unique(names(vv))
- }), xyCompare))) > 1
+ }), xyCompare))) > 1 & !"table" %in% hidden,
+ label = .getLabelLanguage("table", language)
),
mcYear = mwSelect(
choices = {
- c("average", if(!is.null(params)){
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv[[table]]$uniqueMcYears)
- }), xyCompare))
- })
+ # 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"
+ # if(.initial) "average"
+ if(.initial) mcYear
else NULL
- }, multiple = FALSE
+ }, multiple = FALSE,
+ label = .getLabelLanguage("mcYear to be displayed", language),
+ .display = !"mcYear" %in% hidden
),
variable = mwSelect(
@@ -528,40 +627,54 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
}
},
value = {
- if(.initial) as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv[[table]]$valueCols)
- }), xyCompare))[1]
- else NULL
- }, multiple = TRUE
- ),
-
- secondAxis = mwCheckbox(secondAxis),
- variable2Axe = mwSelect(label = "Variables 2nd axis",
- choices = {
- if(!is.null(params)){
- out <- as.character(.compareOperation(lapply(params$x, function(vv){
+ if(.initial){
+ if(is.null(variable)){
+ as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv[[table]]$valueCols)
+ }), xyCompare))[1]
+ } else {
+ variable
+ }
+ } else {
+ # NULL
+ 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"}
+ }), xyCompare))[1]
}
- },
- value = {
- if(.initial) NULL
- else NULL
- }, multiple = TRUE, .display = secondAxis
+ }, 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 typeChoices[1:5]
+ else setdiff(typeChoices, "heatmap")
},
value = {
if(.initial) type
else NULL
},
- .display = timeStepdataload != "annual"
+ .display = timeStepdataload != "annual" & !"type" %in% hidden,
+ label = .getLabelLanguage("type", language)
),
dateRange = mwDateRange(value = {
@@ -574,16 +687,13 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
{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
+ 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
+ }
}
}
-
- }
-
res
}else{NULL}
},
@@ -599,54 +709,87 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL,
if(is.infinite(R)){NULL}else{R}
}
},
- .display = timeStepdataload != "annual"
+ language = eval(parse(text = "language")),
+ # format = "dd MM",
+ separator = " : ",
+ .display = timeStepdataload != "annual" & !"dateRange" %in% hidden,
+ label = .getLabelLanguage("dateRange", language)
),
confInt = mwSlider(0, 1, confInt, step = 0.01,
- label = "confidence interval",
- .display = params$x[[max(1,.id)]][[table]]$showConfInt & mcYear == "average"
+ label = .getLabelLanguage("confidence interval", language),
+ .display = params$x[[max(1,.id)]][[table]]$showConfInt & mcYear == "average" & !"confInt" %in% hidden
),
- minValue = mwNumeric(minValue, "min value",
- .display = type %in% c("density", "cdf")
+ minValue = mwNumeric(minValue, label = .getLabelLanguage("min value", language),
+ .display = type %in% c("density", "cdf") & !"minValue" %in% hidden
),
- maxValue = mwNumeric(maxValue, "max value",
- .display = type %in% c("density", "cdf")
+ 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)){
+ choix <- c(if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv[[table]]$uniqueElem)
}), xyCompare))
})
+ choix
},
value = {
- if(.initial) {as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv[[table]]$uniqueElem)
- }), xyCompare))[1]}
+ if(.initial) {
+ if(is.null(elements)){
+
+ if(!is.null(params)){
+ as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv[[table]]$uniqueElem)
+ }), xyCompare))[1]
+ } else {
+ NULL
+ }
+ }else {
+ elements
+ }
+ } else {
+ NULL
+ }
},
- multiple = TRUE
+ multiple = TRUE,
+ label = .getLabelLanguage("elements", language),
+ .display = !"elements" %in% hidden
),
- aggregate = mwSelect(c("none", "mean", "sum", "mean by areas", "sum by areas"),
- value ={
- if(.initial) aggregate
- else NULL
- }, .display = !secondAxis
+ 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")),
- highlight = mwCheckbox(highlight),
- stepPlot = mwCheckbox(stepPlot),
- drawPoints = mwCheckbox(drawPoints),
+ 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 = "title"),
+ main = mwText(main, label = .getLabelLanguage("title", language),
+ .display = !"main" %in% hidden),
params = mwSharedValue({
.transformDataForComp(x_tranform, compare, compareOpts, processFun = processFun,
diff --git a/R/plot_barplot.R b/R/plot_barplot.R
index d62e8a5..08e1bb0 100644
--- a/R/plot_barplot.R
+++ b/R/plot_barplot.R
@@ -11,7 +11,7 @@
ylab = NULL,
legend = TRUE,
legendItemsPerRow = 5,
- width = NULL, height = NULL, ...) {
+ width = NULL, height = NULL, language = "en", ...) {
if (is.null(dt$mcYear)) {
dt <- dt[, .(value = mean(value)), by = element]
@@ -21,7 +21,7 @@
if (confInt == 0) {
dt <- dt[, .(value = mean(value)), by = .(element)]
} else {
- uniqueElements <- sort(unique(dt$element))
+ uniqueElements <- as.character(sort(unique(dt$element)))
alpha <- (1 - confInt) / 2
.getConfInt <- function(x) {
@@ -36,7 +36,9 @@
dt[,"element" := as.character(element)]
variable <- paste0(variable, collapse = " ; ")
if (is.null(ylab)) ylab <- variable
- if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Comparison of", variable)
+ if (is.null(main) | isTRUE(all.equal("", main))){
+ main <- paste(.getLabelLanguage("Comparison of", language), variable)
+ }
g <- plot_ly(dt, textfont = list(color = '#000000')) %>%
config(displayModeBar = FALSE) %>%
diff --git a/R/plot_stats.R b/R/plot_stats.R
index 1e29415..c36604a 100644
--- a/R/plot_stats.R
+++ b/R/plot_stats.R
@@ -1,7 +1,7 @@
.plotMonotone <- function(dt, timeStep, variable, variable2Axe = NULL, confInt = NULL, maxValue,
- main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) {
+ main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = "en", ...) {
- uniqueElements <- sort(unique(dt$element))
+ uniqueElements <- as.character(sort(unique(dt$element)))
plotConfInt <- FALSE
# If dt contains several Monte-Carlo scenario, compute aggregate statistics
if (is.null(dt$mcYear)) {
@@ -19,7 +19,7 @@
dt <- dt[, .(y = mean(y)), by = .(element, x)]
} else {
plotConfInt <- TRUE
- uniqueElements <- sort(unique(dt$element))
+ uniqueElements <- as.character(sort(unique(dt$element)))
alpha <- (1 - confInt) / 2
dt <- dt[, .(y = c(mean(y), quantile(y, c(alpha, 1 - alpha))),
@@ -31,7 +31,9 @@
variable <- paste0(variable, collapse = " ; ")
if (is.null(ylab)) ylab <- variable
- if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Monotone of", variable)
+ if (is.null(main) | isTRUE(all.equal("", main))){
+ main <- paste(.getLabelLanguage("Monotone of", language), variable)
+ }
.plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, variable2Axe = variable2Axe,
highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, ...)
@@ -39,9 +41,9 @@
}
.density <- function(dt, timeStep, variable, variable2Axe = NULL, minValue = NULL, maxValue = NULL,
- main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) {
+ main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = "en", ...) {
- uniqueElements <- sort(unique(dt$element))
+ uniqueElements <- as.character(sort(unique(dt$element)))
xbins <- .getXBins(dt$value, minValue, maxValue)
if (is.character(xbins)) return(xbins)
@@ -54,8 +56,13 @@
dt <- dt[, .getDensity(value), by = element]
variable <- paste0(variable, collapse = " ; ")
- if (is.null(ylab)) ylab <- "Density"
- if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Density of", variable)
+ if (is.null(ylab)){
+ ylab <- .getLabelLanguage("Density", language)
+ }
+
+ if (is.null(main) | isTRUE(all.equal("", main))){
+ main <- paste(.getLabelLanguage("Density of", language), variable)
+ }
.plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements,variable2Axe = variable2Axe,
highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints,...)
@@ -63,9 +70,9 @@
}
.cdf <- function(dt, timeStep, variable, variable2Axe = NULL, minValue = NULL, maxValue = NULL,
- main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) {
+ main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = "en", ...) {
- uniqueElements <- sort(unique(dt$element))
+ uniqueElements <- as.character(sort(unique(dt$element)))
xbins <- .getXBins(dt$value, minValue, maxValue)$xbins
@@ -77,8 +84,13 @@
dt <- dt[, .getCDF(value), by = element]
variable <- paste0(variable, collapse = " ; ")
- if (is.null(ylab)) ylab <- "Proportion of time steps"
- if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Cumulated distribution of", variable)
+ if (is.null(ylab)){
+ ylab <- .getLabelLanguage("Proportion of time steps", language)
+ }
+
+ if (is.null(main) | isTRUE(all.equal("", main))){
+ main <- paste(.getLabelLanguage("Cumulated distribution of", language), variable)
+ }
.plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, variable2Axe = variable2Axe,
highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, ...)
@@ -114,7 +126,7 @@
.plotStat <- function(dt, ylab, main, colors, uniqueElements,
legend, legendItemsPerRow, width, height,
plotConfInt = FALSE, highlight = FALSE,
- stepPlot = FALSE, drawPoints = FALSE,variable2Axe = NULL, ...) {
+ stepPlot = FALSE, drawPoints = FALSE,variable2Axe = NULL, language = "en", ...) {
dt <- dcast(dt, x ~ element, value.var = "y")
if (is.null(colors)) {
@@ -127,7 +139,7 @@
g <- dygraph(as.data.frame(dt), main = main, group = legendId) %>%
dyOptions(
includeZero = TRUE,
- colors = colors,
+ # colors = colors,
gridLineColor = gray(0.8),
axisLineColor = gray(0.6),
axisLabelColor = gray(0.6),
@@ -138,19 +150,18 @@
dyAxis("y", label = ylab, pixelsPerLabel = 60) %>%
dyLegend(show = "never") %>%
dyCallbacks(
- highlightCallback = JS_updateLegend(legendId, timeStep = "none"),
+ highlightCallback = JS_updateLegend(legendId, timeStep = "none", language = language),
unhighlightCallback = JS_resetLegend(legendId)
)
-
- if(length(variable2Axe)>0){
- for( i in variable2Axe)
- {
- g <- g %>% dySeries(i, axis = 'y2')
- }
+ for(i in 1:length(uniqueElements)){
+ if(!uniqueElements[i] %in% variable2Axe){
+ g <- g %>% dySeries(uniqueElements[i], color = colors[i])
+ } else {
+ g <- g %>% dySeries(uniqueElements[i], axis = 'y2', color = colors[i])
+ }
}
-
if(highlight)
{
g <- g %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2))
diff --git a/R/plot_ts.R b/R/plot_ts.R
index ec47cba..40c5cfc 100644
--- a/R/plot_ts.R
+++ b/R/plot_ts.R
@@ -23,10 +23,9 @@
legend = TRUE,
legendItemsPerRow = 5,
group = NULL,
- width = NULL, height = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) {
+ width = NULL, height = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = language, ...) {
-
- uniqueElements <- sort(unique(dt$element))
+ uniqueElements <- as.character(sort(unique(dt$element)))
plotConfInt <- FALSE
if (is.null(group)) group <- sample(1e9, 1)
@@ -59,7 +58,9 @@
}
if (is.null(ylab)) ylab <- variable
- if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Evolution of", variable)
+ if (is.null(main) | isTRUE(all.equal("", main))){
+ main <- paste(.getLabelLanguage("Evolution of", language), variable)
+ }
if (is.null(colors)) {
colors <- substring(rainbow(length(uniqueElements), s = 0.7, v = 0.7), 1, 7)
} else {
@@ -75,7 +76,7 @@
axisLineColor = gray(0.6),
axisLabelColor = gray(0.6),
labelsKMB = TRUE,
- colors = colors,
+ # colors = colors,
useDataTimezone = TRUE,
stepPlot = stepPlot,
drawPoints = drawPoints
@@ -83,19 +84,19 @@
dyAxis("x", rangePad = 10) %>%
dyAxis("y", label = ylab, pixelsPerLabel = 60, rangePad = 10) %>%
#dyRangeSelector() %>%
- dyLegend(show = "never") %>%
+ dyLegend(show = "never") %>%
dyCallbacks(
- highlightCallback = JS_updateLegend(legendId, timeStep),
+ highlightCallback = JS_updateLegend(legendId, timeStep, language = language),
unhighlightCallback = JS_resetLegend(legendId)
)
- if(length(variable2Axe)>0){
- for( i in variable2Axe)
- {
- g <- g %>% dySeries(i, axis = 'y2')
+ for(i in 1:length(uniqueElements)){
+ if(!uniqueElements[i] %in% variable2Axe){
+ g <- g %>% dySeries(uniqueElements[i], color = colors[i])
+ } else {
+ g <- g %>% dySeries(uniqueElements[i], axis = 'y2', color = colors[i])
}
}
-
if(highlight)
{
g <- g %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2))
diff --git a/R/plot_utils.R b/R/plot_utils.R
index 4d84a65..d01726c 100644
--- a/R/plot_utils.R
+++ b/R/plot_utils.R
@@ -40,7 +40,12 @@
tpl <- rbindlist(listVar)
elements <- as.vector(sapply(elements, function(X){paste(X, "__", variable)}))
}else{
- tpl <- listVar[[1]]
+ if(aggregate %in% c("mean by areas", "sum by areas")){
+ tpl <- listVar[[1]][,element := paste(element, '__' , names(listVar)[1])]
+ elements <- paste(elements, "__", variable)
+ } else {
+ tpl <- listVar[[1]]
+ }
}
# Filtering data if required
@@ -131,4 +136,19 @@
}
}
invisible(TRUE)
+}
+
+.validHidden <- function(hidden, values){
+ if(!is.null(hidden)){
+ if(!is.vector(hidden)){
+ stop("'hidden' must be a vector")
+ } else {
+ if(!all(hidden %in% values)){
+ invalid <- hidden[!hidden %in% values]
+ stop(paste0("Invalid arguments for 'hidden' : '", paste0(invalid, collapse = "', '"),
+ "'. Possible values : '", paste0(values, collapse = "', '"), "'."))
+ }
+ }
+ }
+ invisible(TRUE)
}
\ No newline at end of file
diff --git a/R/stack.R b/R/stack.R
index 7c32b1b..652361f 100644
--- a/R/stack.R
+++ b/R/stack.R
@@ -41,9 +41,9 @@
#' next series is drawn from 0.
#'
#' @noRd
-.plotStack <- function(x, timeStep, opts, colors, lines = NULL, lineColors = NULL,
+.plotStack <- function(x, timeStep, opts, colors, lines = NULL, lineColors = NULL, lineWidth = NULL,
legendId = "", groupId = legendId, main = "", ylab = "",
- width = NULL, height = NULL, dateRange = NULL, stepPlot = FALSE, drawPoints = FALSE) {
+ width = NULL, height = NULL, dateRange = NULL, stepPlot = FALSE, drawPoints = FALSE, language = "en") {
variables <- setdiff(names(x), c("timeId", lines))
@@ -106,7 +106,7 @@
dyOptions(
stackedGraph = TRUE,
colors = rev(colors),
- fillAlpha = 0.6,
+ fillAlpha = 0.85,
includeZero = TRUE,
gridLineColor = gray(0.8),
axisLineColor = gray(0.6),
@@ -120,7 +120,7 @@
dyAxis("y", label = ylab, rangePad = 10, pixelsPerLabel = 50, valueRange = c(min(dt$totalNeg, na.rm = TRUE) * 1.1, NA)) %>%
dyLegend(show = "never") %>%
dyCallbacks(
- highlightCallback = JS_updateLegend(legendId, timeStep),
+ highlightCallback = JS_updateLegend(legendId, timeStep, language = language),
unhighlightCallback = JS_resetLegend(legendId)
)
@@ -129,7 +129,7 @@
g <- g %>% dySeries(name = paste0("opp", lines[i]), color = lineColors[i],
fillGraph = FALSE, strokeWidth = 0)
g <- g %>% dySeries(name = lines[i], color = lineColors[i],
- fillGraph = FALSE, strokeWidth = 3)
+ fillGraph = FALSE, strokeWidth = lineWidth[i])
}
}
diff --git a/R/stack_aliases.R b/R/stack_aliases.R
index 0864612..f2b655e 100644
--- a/R/stack_aliases.R
+++ b/R/stack_aliases.R
@@ -41,6 +41,10 @@ prodStackAliases <- function() {
# Line colors
colors <- sprintf('"%s"', alias$lineColors)
cat(sprintf(",\n\n lineColors = c(%s)", paste(colors, collapse = ", ")))
+
+ # Line width
+ width <- sprintf('"%s"', alias$lineWidth)
+ cat(sprintf(",\n\n lineWidth = c(%s)", paste(width, collapse = ", ")))
}
cat("\n")
}
@@ -49,7 +53,7 @@ prodStackAliases <- function() {
#' @rdname prodStack
#' @export
setProdStackAlias <- function(name, variables, colors, lines = NULL,
- lineColors = NULL, description = NULL) {
+ lineColors = NULL, lineWidth = 3, description = NULL) {
if (is.null(description)) description <- name
if (length(variables) != length(colors)) {
@@ -60,6 +64,16 @@ setProdStackAlias <- function(name, variables, colors, lines = NULL,
stop("Number of line colors and number of lines should be equal.")
}
+ if(length(lineWidth) == 0){
+ lineWidth <- rep(3, length(lines))
+ } else if(length(lineWidth) == 1){
+ lineWidth <- rep(lineWidth, length(lines))
+ } else {
+ if (length(lines) != length(lineWidth)) {
+ stop("Number of line Width and number of lines should be equal.")
+ }
+ }
+
pkgEnv$prodStackAliases[[name]] <- list(
description = description,
variables = variables,
@@ -69,6 +83,7 @@ setProdStackAlias <- function(name, variables, colors, lines = NULL,
if (!is.null(lines)) {
pkgEnv$prodStackAliases[[name]]$lines <- lines
pkgEnv$prodStackAliases[[name]]$lineColors <- lineColors
+ pkgEnv$prodStackAliases[[name]]$lineWidth <- lineWidth
}
invisible(NULL)
diff --git a/R/stack_exchanges.R b/R/stack_exchanges.R
index cedae9e..1020f20 100644
--- a/R/stack_exchanges.R
+++ b/R/stack_exchanges.R
@@ -65,23 +65,31 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
stepPlot = FALSE, drawPoints = FALSE,
timeSteph5 = "hourly",
mcYearh5 = NULL,
- tablesh5 = c("areas", "links"), ...) {
+ 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 = ", "))
+ }
+ # Check hidden
+ .validHidden(hidden, c("H5request", "timeSteph5", "mcYearhH5", "mcYear", "main",
+ "dateRange", "unit", "area", "legend", "stepPlot", "drawPoints"))
#Check compare
.validCompare(compare, c("mcYear", "main", "unit", "area", "legend", "stepPlot", "drawPoints"))
-
+
unit <- match.arg(unit)
if (is.null(mcYear)) mcYear <- "average"
init_area <- area
-
+
xyCompare <- match.arg(xyCompare)
init_dateRange <- dateRange
@@ -93,7 +101,7 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
x <- list(x, x)
}
# .testXclassAndInteractive(x, interactive)
-
+
h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x)
@@ -165,7 +173,7 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
if (!is.null(row)) row <- row[mcYear == mcy, .(area, link, timeId, flow, to, direction)]
}else{
.printWarningMcYear()
- }
+ }
dt <- merge(dt[as.Date(.timeIdToDate(timeId, timeStep, simOptions(x))) %between% dateRange,
.(link, timeId, flow = `FLOW LIN.`)],
@@ -180,19 +188,40 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
dt <- dcast(dt, timeId ~ to, value.var = "flow")
+ # if("ROW" %in% colnames(dt)){
+ # dt[, ROW := NULL]
+ # }
+
# Graphical parameters
- if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Flows from/to", area)
- if (is.null(ylab)) ylab <- sprintf("Flows (%s)", unit)
+ if (is.null(main) | isTRUE(all.equal("", main))){
+ main <- paste(.getLabelLanguage("Flows from/to", language), area)
+ }
+ if (is.null(ylab)){
+ ylab <- sprintf(.getLabelLanguage("Flows (%s)", language), unit)
+ }
+
if (is.null(colors)) {
colors <- substring(rainbow(ncol(dt) - 1, s = 0.7, v = 0.7), 1, 7)
} else {
colors <- rep(colors, length.out = ncol(dt - 1))
}
+ # BP 2017
+ # if(length(main) > 0){
+ # mcYear <- ifelse(mcYear == "average", "moyen", mcYear)
+ # if(grepl("h5$", main)){
+ # # main <- paste0(gsub(".h5$", "", main), " : ", area, " (tirage ", mcYear, ")")
+ # main <- paste0(gsub(".h5$", "", main), " : Tirage ", mcYear)
+ # } else {
+ # # main <- paste0("Échanges ", area, " (tirage ", mcYear, ")")
+ # main <- paste0("Tirage ", mcYear)
+ # }
+ # }
+
# Stack
g <- .plotStack(dt, timeStep, opts, colors,
legendId = legendId + id - 1, groupId = groupId,
- main = main, ylab = ylab, stepPlot = stepPlot, drawPoints = drawPoints)
+ main = main, ylab = ylab, stepPlot = stepPlot, drawPoints = drawPoints, language = language)
if (legend) {
# Add a nice legend
@@ -244,9 +273,9 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
.tryCloseH5()
if(.id <= length(params$x)){
widget <- params$x[[max(1,.id)]]$plotFun(.id, area, dateRange, unit, mcYear, legend, stepPlot, drawPoints, main)
- controlWidgetSize(widget)
+ controlWidgetSize(widget, language)
} else {
- combineWidgets("No data for this selection")
+ combineWidgets(.getLabelLanguage("No data for this selection", language))
}
},
x = mwSharedValue(x),
@@ -261,28 +290,54 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
}),
H5request = mwGroup(
- timeSteph5 = mwSelect(choices = paramsH5$timeStepS,
- value = paramsH5$timeStepS[1],
- label = "timeStep",
- multiple = FALSE
+ label = .getLabelLanguage("H5request", language),
+ timeSteph5 = mwSelect(
+ {
+ if(length(paramsH5) > 0){
+ choices = paramsH5$timeStepS
+ 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
),
- mcYearH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]),
- value = {
- if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
- },
- label = "mcYear",
- multiple = TRUE
+ mcYearH5 = mwSelectize(
+ choices = {
+ ch <- c("Average" = "", paramsH5[["mcYearS"]])
+ names(ch)[1] <- .getLabelLanguage("Average", language)
+ ch
+ },
+ value = {
+ if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
+ },
+ label = .getLabelLanguage("mcYears to be imported", language),
+ multiple = TRUE, options = list(maxItems = 4),
+ .display = (!"mcYearH5" %in% hidden & !meanYearH5)
),
+ meanYearH5 = mwCheckbox(value = FALSE,
+ label = .getLabelLanguage("Average mcYear", language),
+ .display = !"meanYearH5" %in% hidden),
.display = {
- any(unlist(lapply(x_in, .isSimOpts)))
+ any(unlist(lapply(x_in, .isSimOpts))) & !"H5request" %in% hidden
}
),
sharerequest = mwSharedValue({
- list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = NULL)
+ if(length(meanYearH5) > 0){
+ if(meanYearH5){
+ list(timeSteph5_l = timeSteph5, mcYearh_l = NULL, tables_l = NULL)
+ } else {
+ list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = NULL)
+ }
+ } else {
+ list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = NULL)
+ }
}),
-
x_tranform = mwSharedValue({
areas = "all"
links = "all"
@@ -296,33 +351,59 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
}),
mcYear = mwSelect({
- allMcY <- c("average", if(!is.null(params)){
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$x$mcYear)
- }), xyCompare))})
- allMcY
+ # allMcY <- c("average", .compareOperation(lapply(params$x, function(vv){
+ # unique(vv$x$mcYear)
+ # }), xyCompare))
+ # names(allMcY) <- c(.getLabelLanguage("average", language), allMcY[-1])
+
+ # BP 2017
+ allMcY <- .compareOperation(lapply(params$x, function(vv){
+ unique(vv$x$mcYear)
+ }), xyCompare)
+ names(allMcY) <- allMcY
+ if(is.null(allMcY)){
+ allMcY <- "average"
+ names(allMcY) <- .getLabelLanguage("average", language)
+ }
+ allMcY
},
value = {
if(.initial) mcYear
else NULL
},
.display = {
- length(c("average", if(!is.null(params)){
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$x$mcYear)
- }), xyCompare))})) != 1}
+ # length(c("average", if(!is.null(params)){
+ # as.character(.compareOperation(lapply(params$x, function(vv){
+ # unique(vv$x$mcYear)
+ # }), xyCompare))})) != 1 &
+ !"mcYear" %in% hidden
+ },
+ label = .getLabelLanguage("mcYear to be displayed", language)
),
area = mwSelect({
if(!is.null(params)){
as.character(.compareOperation(lapply(params$x, function(vv){
unique(vv$areaList)
- }), xyCompare))}
+ }), xyCompare))
+ }
},
value = {
- if(.initial) area
+ if(.initial){
+ if(!is.null(area)){
+ area
+ } else {
+ if(!is.null(params)){
+ as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$areaList)
+ }), xyCompare))[1]
+ } else {
+ NULL
+ }
+ }
+ }
else NULL
- }),
+ }, label = .getLabelLanguage("area", language), .display = !"area" %in% hidden),
dateRange = mwDateRange(value = {
if(.initial){
@@ -333,15 +414,13 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
}
##Lock 7 days for hourly data
- if(!is.null(attributes(params$x[[1]]$x)$timeStep))
- {
- if(attributes(params$x[[1]]$x)$timeStep == "hourly"){
- if(params$x[[1]]$dateRange[2] - params$x[[1]]$dateRange[1]>7){
- res[1] <- params$x[[1]]$dateRange[2] - 7
+ if(!is.null(attributes(params$x[[1]]$x)$timeStep)){
+ if(attributes(params$x[[1]]$x)$timeStep == "hourly"){
+ if(params$x[[1]]$dateRange[2] - params$x[[1]]$dateRange[1]>7){
+ res[1] <- params$x[[1]]$dateRange[2] - 7
+ }
}
}
- }
-
res
}else{NULL}
},
@@ -355,19 +434,28 @@ exchangesStack <- function(x, area = NULL, mcYear = "average",
.dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = NULL)
}
},
- .display = timeStepdataload != "annual"
+ language = eval(parse(text = "language")),
+ # format = "dd MM",
+ separator = " : ",
+ .display = timeStepdataload != "annual" & !"timeSteph5" %in% hidden,
+ label = .getLabelLanguage("dateRange", language)
),
- unit = mwSelect(c("MWh", "GWh", "TWh"), unit),
+ unit = mwSelect(c("MWh", "GWh", "TWh"), unit, label = .getLabelLanguage("unit", language),
+ .display = !"unit" %in% hidden),
- legend = mwCheckbox(legend),
- stepPlot = mwCheckbox(stepPlot),
- drawPoints = mwCheckbox(drawPoints),
+ legend = mwCheckbox(legend, label = .getLabelLanguage("legend", language),
+ .display = !"legend" %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 = "title"),
+ main = mwText(main, label = .getLabelLanguage("title", language),
+ .display = !"main" %in% hidden),
params = mwSharedValue({
.getDataForComp(x_tranform, NULL, compare, compareOpts,
diff --git a/R/stack_prod.R b/R/stack_prod.R
index 2e3df4c..69a760c 100644
--- a/R/stack_prod.R
+++ b/R/stack_prod.R
@@ -81,6 +81,8 @@
#' Vector of colors with same length as parameter \code{lines}. This argument
#' should be \code{NULL} if there is no curve to trace or if parameter
#' \code{variables} is an alias.
+#' @param lineWidth
+#' Optionnal. Defaut to 3. Vector of width with same length as parameter \code{lines} (or only one value).
#' @param description
#' Description of the stack. It is displayed by function
#' \code{prodStackAliases}.
@@ -95,6 +97,8 @@
#' @param timeSteph5 \code{character} timeStep to read in h5 file. Only for Non interactive mode.
#' @param mcYearh5 \code{numeric} mcYear to read for h5. Only for Non interactive mode.
#' @param tablesh5 \code{character} tables for h5 ("areas" "links", "clusters" or "disticts"). Only for Non interactive mode.
+#' @param language \code{character} language use for label. Defaut to 'en'. Can be 'fr'.
+#' @param hidden \code{logical} Names of input to hide. Defaut to NULL
#' @param ... Other arguments for \code{\link{manipulateWidget}}
#'
#' @return
@@ -196,7 +200,8 @@ prodStack <- function(x,
areas = NULL,
mcYear = "average",
dateRange = NULL,
- main = "Production stack", unit = c("MWh", "GWh", "TWh"),
+ main = .getLabelLanguage("Production stack", language),
+ unit = c("MWh", "GWh", "TWh"),
compare = NULL,
compareOpts = list(),
interactive = getInteractivity(),
@@ -207,15 +212,24 @@ prodStack <- function(x,
h5requestFiltering = list(), stepPlot = FALSE, drawPoints = FALSE,
timeSteph5 = "hourly",
mcYearh5 = NULL,
- tablesh5 = c("areas", "links"),...) {
+ tablesh5 = c("areas", "links"), language = "en",
+ hidden = NULL, ...) {
if(!is.null(compare) && !interactive){
stop("You can't use compare in no interactive mode")
}
- #Check compare
+ # Check language
+ if(!language %in% availableLanguages_labels){
+ stop("Invalid 'language' argument. Must be in : ", paste(availableLanguages_labels, collapse = ", "))
+ }
+
+ # Check hidden
+ .validHidden(hidden, c("H5request", "timeSteph5", "tables", "mcYearH5", "mcYear", "main", "dateRange",
+ "stack", "unit", "areas", "legend", "stepPlot", "drawPoints"))
+ # Check compare
.validCompare(compare, c("mcYear", "main", "unit", "areas", "legend", "stack", "stepPlot", "drawPoints"))
-
+
xyCompare <- match.arg(xyCompare)
unit <- match.arg(unit)
if (is.null(mcYear)) mcYear <- "average"
@@ -268,10 +282,14 @@ prodStack <- function(x,
if (length(init_dateRange) < 2) init_dateRange <- dataDateRange
plotWithLegend <- function(id, areas, main = "", unit, stack, dateRange, mcYear, legend, stepPlot, drawPoints) {
- if (length(areas) == 0) return (combineWidgets("Please choose an area"))
+ if (length(areas) == 0) return (combineWidgets(.getLabelLanguage("Please choose an area", language)))
+
stackOpts <- .aliasToStackOptions(stack)
dt <- x[area %in% areas]
+ if(length(mcYear) == 0){
+ mcYear <- "average"
+ }
if (mcYear == "average") dt <- synthesize(dt)
else if ("mcYear" %in% names(dt)) {
mcy <- mcYear
@@ -285,26 +303,50 @@ prodStack <- function(x,
}
if(nrow(dt) == 0){
- return (combineWidgets("No data for this selection"))
+ return (combineWidgets(.getLabelLanguage("No data for this selection", language)))
}
+
+ # 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)
+ # }
+ # }
+
+ names(stackOpts$variables) <- sapply(names(stackOpts$variables), function(x){
+ .getColumnsLanguage(x, language)
+ })
+ names(stackOpts$lines) <- sapply(names(stackOpts$lines), function(x){
+ .getColumnsLanguage(x, language)
+ })
+
p <- try(.plotProdStack(dt,
stackOpts$variables,
stackOpts$colors,
stackOpts$lines,
stackOpts$lineColors,
+ stackOpts$lineWidth,
main = main,
unit = unit,
legendId = legendId + id - 1,
groupId = groupId,
dateRange = dateRange,
- stepPlot = stepPlot, drawPoints = drawPoints), silent = TRUE)
+ stepPlot = stepPlot, drawPoints = drawPoints, language = language), silent = TRUE)
if("try-error" %in% class(p)){
- return (combineWidgets(paste0("Can't visualize stack '", stack, "'
", p[1])))
+ return (
+ combineWidgets(paste0(.getLabelLanguage("Can't visualize stack", language), " '", stack, "'
", p[1]))
+ )
}
if (legend) {
- l <- prodStackLegend(stack, legendItemsPerRow, legendId = legendId + id - 1)
+ l <- prodStackLegend(stack, legendItemsPerRow, legendId = legendId + id - 1,
+ language = language)
} else {
l <- NULL
}
@@ -350,7 +392,7 @@ prodStack <- function(x,
table <- NULL
##remove notes
- mcYearhH5 <- NULL
+ mcYearH5 <- NULL
paramsH5 <- NULL
sharerequest <- NULL
timeStepdataload <- NULL
@@ -358,7 +400,6 @@ prodStack <- function(x,
x_in <- NULL
x_tranform <- NULL
-
manipulateWidget(
{
.tryCloseH5()
@@ -367,9 +408,9 @@ prodStack <- function(x,
unit, stack, dateRange,
mcYear, legend,
stepPlot, drawPoints)
- controlWidgetSize(widget)
+ controlWidgetSize(widget, language)
} else {
- combineWidgets("No data for this selection")
+ return (combineWidgets(.getLabelLanguage("No data for this selection", language)))
}
},
x = mwSharedValue({x}),
@@ -385,36 +426,70 @@ prodStack <- function(x,
tmp
}),
H5request = mwGroup(
- timeSteph5 = mwSelect(choices = paramsH5$timeStepS,
- value = paramsH5$timeStepS[1],
- label = "timeStep",
- multiple = FALSE
+ label = .getLabelLanguage("H5request", language),
+ timeSteph5 = mwSelect(
+ {
+ if(length(paramsH5) > 0){
+ choices = paramsH5$timeStepS
+ 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
),
- tables = mwSelect(choices = paramsH5[["tabl"]][paramsH5[["tabl"]]%in%c("areas", "districts")],
- value = {
- if(.initial) {paramsH5[["tabl"]][paramsH5[["tabl"]]%in%c("areas", "districts")][1]}else{NULL}
- },
- label = "table",
- multiple = FALSE
+ tables = mwSelect(
+ {
+ if(length(paramsH5) > 0){
+ choices = paramsH5[["tabl"]][paramsH5[["tabl"]]%in%c("areas", "districts")]
+ names(choices) <- sapply(choices, function(x) .getLabelLanguage(x, language))
+ choices
+ } else {
+ NULL
+ }
+ },
+ value = {
+ if(.initial) {paramsH5[["tabl"]][paramsH5[["tabl"]]%in%c("areas", "districts")][1]}else{NULL}
+ },
+ label = .getLabelLanguage("table", language),
+ multiple = FALSE, .display = !"tables" %in% hidden
),
- mcYearhH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]),
- value = {
- if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
- },
- label = "mcYear",
- multiple = TRUE
+ mcYearH5 = mwSelectize(
+ choices = {
+ ch <- c("Average" = "", paramsH5[["mcYearS"]])
+ names(ch)[1] <- .getLabelLanguage("Average", language)
+ ch
+ },
+ value = {
+ if(.initial){paramsH5[["mcYearS"]][1]}else{NULL}
+ },
+ label = .getLabelLanguage("mcYears to be imported", language),
+ multiple = TRUE, options = list(maxItems = 4),
+ .display = (!"mcYearH5" %in% hidden & !meanYearH5)
),
+ meanYearH5 = mwCheckbox(value = FALSE,
+ label = .getLabelLanguage("Average mcYear", language),
+ .display = !"meanYearH5" %in% hidden),
.display = {
- any(unlist(lapply(x_in, .isSimOpts)))
+ any(unlist(lapply(x_in, .isSimOpts))) & !"H5request" %in% hidden
}
),
sharerequest = mwSharedValue({
- list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearhH5, tables_l = tables)
+ if(length(meanYearH5) > 0){
+ if(meanYearH5){
+ 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({
h5requestFilteringTp <- paramsH5$h5requestFilter
@@ -430,7 +505,7 @@ prodStack <- function(x,
}
}
}
-
+
sapply(1:length(x_in),function(zz){
.loadH5Data(sharerequest, x_in[[zz]], h5requestFilter = h5requestFilteringTp[[zz]])
}, simplify = FALSE)
@@ -444,12 +519,27 @@ prodStack <- function(x,
##End h5
mcYear = mwSelect({
- c("average", .compareOperation(lapply(params$x, function(vv){
+ # allMcY <- c("average", .compareOperation(lapply(params$x, function(vv){
+ # unique(vv$x$mcYear)
+ # }), xyCompare))
+ # names(allMcY) <- c(.getLabelLanguage("average", language), allMcY[-1])
+
+ # BP 2017
+ allMcY <- .compareOperation(lapply(params$x, function(vv){
unique(vv$x$mcYear)
- }), xyCompare))
- }),
+ }), xyCompare)
+ names(allMcY) <- allMcY
+ if(is.null(allMcY)){
+ allMcY <- "average"
+ names(allMcY) <- .getLabelLanguage("average", language)
+ }
+ allMcY
+ }, value = {
+ if(.initial) mcYear
+ else NULL
+ }, label = .getLabelLanguage("mcYear to be displayed", language), .display = !"mcYear" %in% hidden),
- main = mwText(main, label = "title"),
+ main = mwText(main, label = .getLabelLanguage("title", language), .display = !"main" %in% hidden),
dateRange = mwDateRange(value = {
if(.initial){
@@ -461,14 +551,9 @@ prodStack <- function(x,
if(params$x[[1]]$timeStep == "hourly"){
if(params$x[[1]]$dateRange[2] - params$x[[1]]$dateRange[1]>7){
res[1] <- params$x[[1]]$dateRange[2] - 7
+ }
}
-
-
}
- }
-
-
-
res
}else{NULL}
},
@@ -481,14 +566,17 @@ prodStack <- function(x,
if(!is.null(params)){
.dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table)
}
- }
+ },
+ language = eval(parse(text = "language")),
+ # format = "dd MM",
+ separator = " : ",
+ label = .getLabelLanguage("dateRange", language),
+ .display = !"dateRange" %in% hidden
),
-
-
-
- stack = mwSelect(names(pkgEnv$prodStackAliases), stack),
-
- unit = mwSelect(c("MWh", "GWh", "TWh"), unit),
+ stack = mwSelect(names(pkgEnv$prodStackAliases), stack,
+ label = .getLabelLanguage("stack", language), .display = !"stack" %in% hidden),
+ unit = mwSelect(c("MWh", "GWh", "TWh"), unit,
+ label = .getLabelLanguage("unit", language), .display = !"unit" %in% hidden),
areas = mwSelect({
as.character(.compareOperation(lapply(params$x, function(vv){
@@ -497,17 +585,27 @@ prodStack <- function(x,
},
value = {
if(.initial){
- as.character(.compareOperation(lapply(params$x, function(vv){
- unique(vv$x$area)
- }), xyCompare))[1]
+ if(!is.null(areas)){
+ areas
+ } else {
+ as.character(.compareOperation(lapply(params$x, function(vv){
+ unique(vv$x$area)
+ }), xyCompare))[1]
+ }
}
- else{NULL}},
- multiple = TRUE
+ else NULL
+ },
+ multiple = TRUE,
+ label = .getLabelLanguage("areas", language),
+ .display = !"areas" %in% hidden
),
- legend = mwCheckbox(legend),
- stepPlot = mwCheckbox(stepPlot),
- drawPoints = mwCheckbox(drawPoints),
+ legend = mwCheckbox(legend, label = .getLabelLanguage("legend", language),
+ .display = !"legend" %in% hidden),
+ stepPlot = mwCheckbox(stepPlot, label = .getLabelLanguage("stepPlot", language),
+ .display = !"stepPlot" %in% hidden),
+ drawPoints = mwCheckbox(drawPoints, label = .getLabelLanguage("drawPoints", language),
+ .display = !"drawPoints" %in% hidden),
.compare = {
compare
},
@@ -576,10 +674,10 @@ prodStack <- function(x,
#' next series is drawn from 0.
#'
#' @noRd
-.plotProdStack <- function(x, variables, colors, lines, lineColors,
+.plotProdStack <- function(x, variables, colors, lines, lineColors, lineWidth,
main = NULL, unit = "MWh", legendId = "",
groupId = legendId,
- width = NULL, height = NULL, dateRange = NULL, stepPlot = FALSE, drawPoints = FALSE) {
+ width = NULL, height = NULL, dateRange = NULL, stepPlot = FALSE, drawPoints = FALSE, language = "en") {
timeStep <- attr(x, "timeStep")
@@ -591,19 +689,26 @@ prodStack <- function(x,
for (n in names(formulas)) {
dt[,c(n) := x[, eval(formulas[[n]]) / switch(unit, MWh = 1, GWh = 1e3, TWh = 1e6)]]
}
- .plotStack(dt, timeStep, simOptions(x), colors, lines, lineColors, legendId,
+ .plotStack(dt, timeStep, simOptions(x), colors, lines, lineColors, lineWidth, legendId,
groupId,
main = main, ylab = sprintf("Production (%s)", unit),
- width = width, height = height, dateRange = dateRange, stepPlot = stepPlot, drawPoints = drawPoints)
+ width = width, height = height, dateRange = dateRange, stepPlot = stepPlot, drawPoints = drawPoints, language = language)
}
#' @rdname tsLegend
#' @export
prodStackLegend <- function(stack = "eco2mix",
- legendItemsPerRow = 5, legendId = "") {
+ legendItemsPerRow = 5, legendId = "", language = "en") {
stackOpts <- .aliasToStackOptions(stack)
+ names(stackOpts$variables) <- sapply(names(stackOpts$variables), function(x){
+ .getColumnsLanguage(x, language)
+ })
+ names(stackOpts$lines) <- sapply(names(stackOpts$lines), function(x){
+ .getColumnsLanguage(x, language)
+ })
+
tsLegend(
labels = c(names(stackOpts$variables), names(stackOpts$lines)),
colors = c(stackOpts$colors, stackOpts$lineColors),
diff --git a/R/tsLegend.R b/R/tsLegend.R
index 58c08c3..580a47d 100644
--- a/R/tsLegend.R
+++ b/R/tsLegend.R
@@ -71,7 +71,7 @@ tsLegend <- function(labels, colors, types = "line", legendItemsPerRow = 5, lege
)
tags$div(
- style=sprintf("position:relative;height:%spx", max(i * 20, 40)),
+ style=sprintf("position:relative;height:%spx", max(i * 20 + 20, 40)),
tags$div(
style = "position:absolute;top:0;bottom:0;width:100px;
",
@@ -80,6 +80,7 @@ tsLegend <- function(labels, colors, types = "line", legendItemsPerRow = 5, lege
id = paste0("date", legendId)
)
),
+ tags$br(),
legendItems
)
}
@@ -150,21 +151,75 @@ tsLegend <- function(labels, colors, types = "line", legendItemsPerRow = 5, lege
)
}
-JS_updateLegend <- function(legendId, timeStep = "hourly") {
+JS_updateLegend <- function(legendId, timeStep = "hourly", language = "en") {
# Function that transform a timestamp ta a date label
- timeToLab <- switch(
- timeStep,
- hourly = "var date = new Date(x);
- var day = date.toUTCString().slice(0, 11);
- var h = date.toUTCString().slice(17, 22);
- return day + '
' + h;",
- daily = "var date = new Date(x); return date.toUTCString().slice(0, 11)",
- weekly = "var date = new Date(x); return date.toUTCString().slice(0, 11)",
- monthly = "var date = new Date(x); return date.toUTCString().slice(7, 11)",
- "return x"
- )
-
+ timeToLab <- switch(
+ timeStep,
+ hourly = paste0("var date = new Date(x);
+ var res;
+ try {
+ res = date.toLocaleDateString('", language, "', { weekday: 'short', month: 'short', day: 'numeric', hour : '2-digit', minute:'2-digit', timeZone : 'UTC' });
+ } catch (e) {
+ res = date.toLocaleDateString('en', { weekday: 'short', month: 'short', day: 'numeric', hour : '2-digit', minute:'2-digit', timeZone : 'UTC' })
+ };
+ // bug in Rstudio viewer / old browser
+ if(res == date.toLocaleDateString()){
+ var day = date.toUTCString().slice(0, 11);
+ var h = date.toUTCString().slice(17, 22);
+ res = day + '
' + h;
+ }
+ return res"),
+ daily = paste0("var date = new Date(x);
+ var res;
+ try {
+ res = date.toLocaleDateString('", language, "', { weekday: 'short', month: 'short', day: 'numeric', timeZone : 'UTC' });
+ } catch (e) {
+ res = date.toLocaleDateString('en', { weekday: 'short', month: 'short', day: 'numeric', timeZone : 'UTC' })
+ };
+ // bug in Rstudio viewer / old browser
+ if(res == date.toLocaleDateString()){
+ res = date.toUTCString().slice(0, 11);
+ }
+ return res"),
+ weekly = paste0("var date = new Date(x);
+ var res;
+ try {
+ res = date.toLocaleDateString('", language, "', { weekday: 'short', month: 'short', day: 'numeric', timeZone : 'UTC' });
+ } catch (e) {
+ res = date.toLocaleDateString('en', { weekday: 'short', month: 'short', day: 'numeric', timeZone : 'UTC' })
+ };
+ // bug in Rstudio viewer / old browser
+ if(res == date.toLocaleDateString()){
+ res = date.toUTCString().slice(0, 11);
+ }
+ return res"),
+ monthly = paste0("var date = new Date(x);
+ var res;
+ try {
+ res = date.toLocaleDateString('", language, "', {month: 'long', year: 'numeric', timeZone : 'UTC' });
+ } catch (e) {
+ res = date.toLocaleDateString('en', {month: 'long', year: 'numeric', timeZone : 'UTC' })
+ };
+ // bug in Rstudio viewer / old browser
+ if(res == date.toLocaleDateString()){
+ res = return date.toUTCString().slice(7, 16);
+ }
+ return res"),
+ annual = paste0("var date = new Date(x);
+ var res;
+ try {
+ res = date.toLocaleDateString('", language, "', {year: 'numeric', timeZone : 'UTC' });
+ } catch (e) {
+ res = date.toLocaleDateString('en', {year: 'numeric', timeZone : 'UTC' })
+ };
+ // bug in Rstudio viewer / old browser
+ if(res == date.toLocaleDateString()){
+ res = date.toUTCString().slice(12, 16);
+ }
+ return res"),
+ "return x"
+ )
script <-"
function(e, timestamp, data) {
function timeToLab(x) {%s}
@@ -183,7 +238,7 @@ function(e, timestamp, data) {
if (!values.hasOwnProperty(k)) continue;
var el = document.getElementById(k + '%s');
if (el) {
- if (Math.abs(values[k]) > 100) {
+ if (Math.abs(values[k]) > 100 || values[k] === 0) {
el.innerHTML = Math.round(values[k]);
} else {
el.innerHTML = values[k].toPrecision(3);
diff --git a/R/zzz.R b/R/zzz.R
index d41efcb..c4cd9c8 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -69,7 +69,8 @@ needed <- strsplit(needed, ",")
variables = formulas[var],
colors = unname(colors[var]),
lines = formulas[lines],
- lineColors = unname(colors[lines])
+ lineColors = unname(colors[lines]),
+ lineWidth = 2
)
}
@@ -117,10 +118,72 @@ pkgEnv$prodStackAliases <- list(
rm(graphicalCharter, formulas, colors)
+# message limit size
+antaresVizSizeGraphError = "Too much data, please reduce selection. If you work with hourly data, you can reduce dateRange selection.
+You can also use 'limitSizeGraph' function in R or 'Memory Controls' panel in shiny (if present) to update this."
+
+antaresVizSizeGraphError_fr = "Trop de données,veuillez réduire votre sélection. Si vous travaillez en données horaire, vous pouvez réduire la période de visualisation.
+Il est également possible d'utiliser la fonction 'limitSizeGraph' en R ou l'onglet 'Memory Controls' dans shiny (si présent) pour changer la limite."
+
+# language for labels
+language_labels <- fread(input=system.file("language_labels.csv", package = "antaresViz"), encoding = "UTF-8")
+
+availableLanguages_labels <- colnames(language_labels)
+
+.getLabelLanguage <- function(label, language = "en"){
+ if(language %in% colnames(language_labels)){
+ up_label <- language_labels[en %in% label, get(language)]
+ if(length(up_label) == 0){
+ up_label <- label
+ }
+ } else {
+ up_label <- label
+ }
+ up_label
+}
+
+# language for columns
+language_columns <- fread(input=system.file("language_columns.csv", package = "antaresViz"), encoding = "UTF-8")
+
+language_columns$en <- as.character(language_columns$en)
+
+language_columns$fr <- as.character(language_columns$fr)
+# Encoding(language_columns$fr) <- "latin1"
+
+expand_language_columns <- copy(language_columns)
+#add _std _min _max
+language_columns[, tmp_row := 1:nrow(language_columns)]
+
+language_columns <- language_columns[, list(en = c(en, paste0(en, c("_std", "_min", "_max"))),
+ fr = c(fr, paste0(fr, c("_std", "_min", "_max")))), by = tmp_row]
+
+language_columns[, tmp_row := NULL]
+
+
+.getColumnsLanguage <- function(columns, language = "en"){
+ if(language %in% colnames(language_columns)){
+ ind_match <- match(columns, language_columns$en)
+ up_columns <- columns
+ if(any(!is.na(ind_match))){
+ up_columns[which(!is.na(ind_match))] <- language_columns[[language]][ind_match[!is.na(ind_match)]]
+ }
+ } else {
+ up_columns <- columns
+ }
+ up_columns
+}
+
+# map color
colorsVars <- fread(input=system.file("color.csv", package = "antaresViz"))
+colorsVars <- unique(colorsVars, by = "Column")
colorsVars$colors <- rgb(colorsVars$red, colorsVars$green, colorsVars$blue, maxColorValue = 255)
+# expand to fr name
+expand_language_columns <- expand_language_columns[en %in% colorsVars$Column]
+
+ind_match <- match(expand_language_columns$en, colorsVars$Column)
+rev_ind_match <- match(colorsVars$Column, expand_language_columns$en)
+
+col_fr <- colorsVars[Column %in% expand_language_columns$en][, Column := expand_language_columns$fr[rev_ind_match[!is.na(rev_ind_match)]]]
+colorsVars <- unique(rbindlist(list(colorsVars, col_fr)))
-# message limit size
-antaresVizSizeGraphError = "Too much data, please reduce selection. If you work with hourly data, you can reduce dateRange selection.
-You can also use 'limitSizeGraph' function in R or 'Memory Controls' panel in shiny to update this."
\ No newline at end of file
diff --git a/README.md b/README.md
index 9c4dc7f..cccd3c0 100644
--- a/README.md
+++ b/README.md
@@ -12,10 +12,6 @@ This package has been published on CRAN, so you can install it easily:
```r
install.packages("antaresViz")
```
-You can also install the last version from Github :
-```r
-devtools::install_github("rte-antares-rpackage/antaresViz")
-```
To install the last development version:
```r
diff --git a/inst/application/server.R b/inst/application/server.R
index f3cca99..820de65 100644
--- a/inst/application/server.R
+++ b/inst/application/server.R
@@ -14,7 +14,9 @@ function(input, output, session) {
# shared parameters
#----------------
- modules <- reactiveValues(prodStack = NULL, exchangesStack = NULL, plotts = NULL, plotMap = NULL)
+ modules <- reactiveValues(prodStack = NULL, exchangesStack = NULL, plotts = NULL, plotMap = NULL,
+ id_prodStack = NULL, id_exchangesStack = NULL, id_plotts = NULL, id_plotMap = NULL,
+ init_prodStack = FALSE, init_exchangesStack = FALSE, init_plotts = FALSE, init_plotMap = FALSE)
# all data loaded by user, with informations
list_data_all <- reactiveValues(antaresDataList = list(), params = list(),
diff --git a/inst/application/src/server/01_set_read_data.R b/inst/application/src/server/01_set_read_data.R
index e15baca..4f6d770 100644
--- a/inst/application/src/server/01_set_read_data.R
+++ b/inst/application/src/server/01_set_read_data.R
@@ -153,15 +153,15 @@ observe({
# links
links <- c("all", opts$linkList)
- updateSelectInput(session, "read_links", "Links :", choices = links, selected = NULL)
+ updateSelectInput(session, "read_links", "Links :", choices = links, selected = links[1])
# clusters
clusters <- c("all", opts$areasWithClusters)
- updateSelectInput(session, "read_clusters", "Clusters :", choices = clusters, selected = NULL)
+ updateSelectInput(session, "read_clusters", "Clusters :", choices = clusters, selected = clusters[1])
# districts
districts <- c("all", opts$districtList)
- updateSelectInput(session, "read_districts", "Districts :", choices = districts, selected = NULL)
+ updateSelectInput(session, "read_districts", "Districts :", choices = districts, selected = districts[1])
# mcYears
mcy <- c(opts$mcYears)
diff --git a/inst/application/src/server/05_modules.R b/inst/application/src/server/05_modules.R
index 0904045..0034636 100644
--- a/inst/application/src/server/05_modules.R
+++ b/inst/application/src/server/05_modules.R
@@ -19,14 +19,15 @@ observe({
input_data$data[grepl("^prodStack", input_id), input_id := paste0(id_prodStack, "-shared_", input)]
output[["prodStack_ui"]] <- renderUI({
- mwModuleUI(id = id_prodStack, height = "800px", fluidRow = TRUE)
+ mwModuleUI(id = id_prodStack, height = "800px")
})
.compare <- input$sel_compare_prodstack
if(input$sel_compare_mcyear){
.compare <- unique(c(.compare, "mcYear"))
}
- if(!is.null(.compare)){
+
+ if(length(.compare) > 0){
list_compare <- vector("list", length(.compare))
names(list_compare) <- .compare
# set main with study names
@@ -35,18 +36,26 @@ observe({
}
.compare <- list_compare
} else {
- .compare = NULL
+ if(length(ind_areas) > 1){
+ .compare <- list(main = names(list_data_all$antaresDataList[ind_areas]))
+ } else {
+ .compare = NULL
+ }
}
+
mod_prodStack <- prodStack(list_data_all$antaresDataList[ind_areas], xyCompare = "union",
h5requestFiltering = list_data_all$params[ind_areas],
unit = "GWh", interactive = TRUE, .updateBtn = TRUE,
+ language = "fr",
.updateBtnInit = TRUE, compare = .compare, .runApp = FALSE)
if("MWController" %in% class(modules$prodStack)){
modules$prodStack$clear()
}
- modules$prodStack <- mwModule(id = id_prodStack, mod_prodStack)
+ modules$prodStack <- mod_prodStack
+ modules$id_prodStack <- id_prodStack
+ modules$init_prodStack <- TRUE
# init / re-init module plotts
id_ts <- paste0("plotts_", round(runif(1, 1, 100000000)))
@@ -55,14 +64,15 @@ observe({
input_data$data[grepl("^plotts", input_id), input_id := paste0(id_ts, "-shared_", input)]
output[["plotts_ui"]] <- renderUI({
- mwModuleUI(id = id_ts, height = "800px", fluidRow = TRUE)
+ mwModuleUI(id = id_ts, height = "800px")
})
.compare <- input$sel_compare_tsPlot
if(input$sel_compare_mcyear){
.compare <- unique(c(.compare, "mcYear"))
}
- if(!is.null(.compare)){
+
+ if(length(.compare) > 0){
list_compare <- vector("list", length(.compare))
names(list_compare) <- .compare
# set main with study names
@@ -71,18 +81,25 @@ observe({
}
.compare <- list_compare
} else {
- .compare = NULL
+ if(length(ind_areas) > 1){
+ .compare <- list(main = names(list_data_all$antaresDataList[ind_areas]))
+ } else {
+ .compare = NULL
+ }
}
+
mod_plotts <- plot(list_data_all$antaresDataList[ind_areas], xyCompare = "union",
h5requestFiltering = list_data_all$params[ind_areas],
- interactive = TRUE, .updateBtn = TRUE,
+ interactive = TRUE, .updateBtn = TRUE, language = "fr",
.updateBtnInit = TRUE, compare = .compare, .runApp = FALSE)
if("MWController" %in% class(modules$plotts)){
modules$plotts$clear()
}
- modules$plotts <- mwModule(id = id_ts, mod_plotts)
+ modules$plotts <- mod_plotts
+ modules$id_plotts <- id_ts
+ modules$init_plotts <- TRUE
list_data_controls$n_areas <- length(ind_areas)
list_data_controls$have_areas <- TRUE
@@ -100,14 +117,15 @@ observe({
input_data$data[grepl("^exchangesStack", input_id), input_id := paste0(id_exchangesStack, "-shared_", input)]
output[["exchangesStack_ui"]] <- renderUI({
- mwModuleUI(id = id_exchangesStack, height = "800px", fluidRow = TRUE)
+ mwModuleUI(id = id_exchangesStack, height = "800px")
})
.compare <- input$sel_compare_exchangesStack
if(input$sel_compare_mcyear){
.compare <- unique(c(.compare, "mcYear"))
}
- if(!is.null(.compare)){
+
+ if(length(.compare) > 0){
list_compare <- vector("list", length(.compare))
names(list_compare) <- .compare
# set main with study names
@@ -116,18 +134,24 @@ observe({
}
.compare <- list_compare
} else {
- .compare = NULL
+ if(length(ind_links) > 1){
+ .compare <- list(main = names(list_data_all$antaresDataList[ind_links]))
+ } else {
+ .compare = NULL
+ }
}
mod_exchangesStack <- exchangesStack(list_data_all$antaresDataList[ind_links], xyCompare = "union",
h5requestFiltering = list_data_all$params[ind_links],
- interactive = TRUE, .updateBtn = TRUE,
+ interactive = TRUE, .updateBtn = TRUE, language = "fr",
.updateBtnInit = TRUE, compare = .compare, .runApp = FALSE)
if("MWController" %in% class(modules$exchangesStack)){
modules$exchangesStack$clear()
}
- modules$exchangesStack <- mwModule(id = id_exchangesStack, mod_exchangesStack)
+ modules$exchangesStack <- mod_exchangesStack
+ modules$id_exchangesStack <- id_exchangesStack
+ modules$init_exchangesStack <- TRUE
# save data and params
list_data_controls$n_links <- length(ind_links)
@@ -150,6 +174,41 @@ observe({
})
})
+# call module when click on tab if needed
+observe({
+ if(input[['nav-id']] == "prodStack" & modules$init_prodStack){
+ isolate({
+ if("MWController" %in% class(modules$prodStack) & modules$init_prodStack){
+ modules$prodStack <- mwModule(id = modules$id_prodStack, modules$prodStack)
+ modules$init_prodStack <- FALSE
+ }
+ })
+ }
+})
+
+observe({
+ if(input[['nav-id']] == "tsPlot"){
+ isolate({
+ if("MWController" %in% class(modules$plotts) & modules$init_plotts){
+ modules$plotts <- mwModule(id = modules$id_plotts, modules$plotts)
+ modules$init_plotts <- FALSE
+ }
+ })
+ }
+})
+
+observe({
+ if(input[['nav-id']] == "exchangesStack"){
+ isolate({
+ if("MWController" %in% class(modules$exchangesStack) & modules$init_exchangesStack){
+ modules$exchangesStack <- mwModule(id = modules$id_exchangesStack, modules$exchangesStack)
+ modules$init_exchangesStack <- FALSE
+ }
+ })
+ }
+})
+
+
# control : have link in data
output$have_data_links <- reactive({
list_data_controls$have_links
diff --git a/inst/application/src/server/06_module_map.R b/inst/application/src/server/06_module_map.R
index 21b61c5..6d3fc86 100644
--- a/inst/application/src/server/06_module_map.R
+++ b/inst/application/src/server/06_module_map.R
@@ -85,20 +85,21 @@ observe({
input_data$data[grepl("^plotMap", input_id), input_id := paste0(id_plotMap, "-shared_", input)]
output[["plotMap_ui"]] <- renderUI({
- mwModuleUI(id = id_plotMap, height = "800px", fluidRow = TRUE)
+ mwModuleUI(id = id_plotMap, height = "800px")
})
.compare <- input$sel_compare_plotMap
if(input$sel_compare_mcyear){
.compare <- unique(c(.compare, "mcYear"))
}
- if(!is.null(.compare)){
+
+ if(length(.compare) > 0){
list_compare <- vector("list", length(.compare))
names(list_compare) <- .compare
# set main with study names
- if(length(ind_map) != 1){
- list_compare$main <- names(list_data_all$antaresDataList[ind_map])
- }
+ # if(length(ind_map) != 1){
+ # list_compare$main <- names(list_data_all$antaresDataList[ind_map])
+ # }
.compare <- list_compare
} else {
.compare = NULL
@@ -107,6 +108,7 @@ observe({
mod_plotMap <- plotMap(list_data_all$antaresDataList[ind_map], ml,
interactive = TRUE, .updateBtn = TRUE,
.updateBtnInit = TRUE, compare = .compare,
+ language = "fr",
h5requestFiltering = list_data_all$params[ind_map],
xyCompare = "union", .runApp = FALSE)
@@ -114,7 +116,9 @@ observe({
modules$plotMap$clear()
}
- modules$plotMap <- mwModule(id = id_plotMap, mod_plotMap)
+ modules$plotMap <- mod_plotMap
+ modules$id_plotMap <- id_plotMap
+ modules$init_plotMap <- TRUE
# save data and params
list_data_controls$n_maps <- length(ind_map)
}
@@ -124,6 +128,18 @@ observe({
})
})
+
+observe({
+ if(input[['nav-id']] == "Map"){
+ isolate({
+ if("MWController" %in% class(modules$plotMap) & modules$init_plotMap){
+ modules$plotMap <- mwModule(id = modules$id_plotMap, modules$plotMap)
+ modules$init_plotMap <- FALSE
+ }
+ })
+ }
+})
+
# download layout
output$download_layout <- downloadHandler(
filename = function() {
diff --git a/inst/application/ui.R b/inst/application/ui.R
index 6bd73aa..ade3467 100644
--- a/inst/application/ui.R
+++ b/inst/application/ui.R
@@ -1,12 +1,12 @@
# Define UI for antaresViz app
navbarPage(title = "antaresViz", id = "nav-id", inverse= TRUE, collapsible = TRUE, position = "fixed-top",
- header = fluidRow(
- column(12,
+ header = div(
br(), br(), br(),
singleton(tags$script(src = 'events.js')),
+ singleton(tags$script(src = 'is.min.js')),
+ tags$script(type="text/javascript", 'if(is.ie()){ alert("Ce site n\'est pas optimisé pour Internet Explorer");};'),
div(id = "import_busy", tags$img(src= "spinner.gif", height = 100,
style = "position: fixed;top: 50%;z-index:10;left: 48%;"))
- )
), windowTitle = "antaresViz",
tabPanel("Data",
fluidRow(
diff --git a/inst/application/www/is.min.js b/inst/application/www/is.min.js
new file mode 100644
index 0000000..5b701f0
--- /dev/null
+++ b/inst/application/www/is.min.js
@@ -0,0 +1,5 @@
+/*!
+ * is.js 0.9.0
+ * Author: Aras Atasaygin
+ */
+(function(n,t){if(typeof define==="function"&&define.amd){define(function(){return n.is=t()})}else if(typeof exports==="object"){module.exports=t()}else{n.is=t()}})(this,function(){var n={};n.VERSION="0.8.0";n.not={};n.all={};n.any={};var t=Object.prototype.toString;var e=Array.prototype.slice;var r=Object.prototype.hasOwnProperty;function a(n){return function(){return!n.apply(null,e.call(arguments))}}function u(n){return function(){var t=c(arguments);var e=t.length;for(var r=0;r":function(n,t){return n>t},">=":function(n,t){return n>=t}};function f(n,t){var e=t+"";var r=+(e.match(/\d+/)||NaN);var a=e.match(/^[<>]=?|/)[0];return i[a]?i[a](n,r):n==r||r!==r}function c(t){var r=e.call(t);var a=r.length;if(a===1&&n.array(r[0])){r=r[0]}return r}n.arguments=function(n){return t.call(n)==="[object Arguments]"||n!=null&&typeof n==="object"&&"callee"in n};n.array=Array.isArray||function(n){return t.call(n)==="[object Array]"};n.boolean=function(n){return n===true||n===false||t.call(n)==="[object Boolean]"};n.char=function(t){return n.string(t)&&t.length===1};n.date=function(n){return t.call(n)==="[object Date]"};n.domNode=function(t){return n.object(t)&&t.nodeType>0};n.error=function(n){return t.call(n)==="[object Error]"};n["function"]=function(n){return t.call(n)==="[object Function]"||typeof n==="function"};n.json=function(n){return t.call(n)==="[object Object]"};n.nan=function(n){return n!==n};n["null"]=function(n){return n===null};n.number=function(e){return n.not.nan(e)&&t.call(e)==="[object Number]"};n.object=function(n){return Object(n)===n};n.regexp=function(n){return t.call(n)==="[object RegExp]"};n.sameType=function(e,r){var a=t.call(e);if(a!==t.call(r)){return false}if(a==="[object Number]"){return!n.any.nan(e,r)||n.all.nan(e,r)}return true};n.sameType.api=["not"];n.string=function(n){return t.call(n)==="[object String]"};n.undefined=function(n){return n===void 0};n.windowObject=function(n){return n!=null&&typeof n==="object"&&"setInterval"in n};n.empty=function(t){if(n.object(t)){var e=Object.getOwnPropertyNames(t).length;if(e===0||e===1&&n.array(t)||e===2&&n.arguments(t)){return true}return false}return t===""};n.existy=function(n){return n!=null};n.falsy=function(n){return!n};n.truthy=a(n.falsy);n.above=function(t,e){return n.all.number(t,e)&&t>e};n.above.api=["not"];n.decimal=function(t){return n.number(t)&&t%1!==0};n.equal=function(t,e){if(n.all.number(t,e)){return t===e&&1/t===1/e}if(n.all.string(t,e)||n.all.regexp(t,e)){return""+t===""+e}if(n.all.boolean(t,e)){return t===e}return false};n.equal.api=["not"];n.even=function(t){return n.number(t)&&t%2===0};n.finite=isFinite||function(t){return n.not.infinite(t)&&n.not.nan(t)};n.infinite=function(n){return n===Infinity||n===-Infinity};n.integer=function(t){return n.number(t)&&t%1===0};n.negative=function(t){return n.number(t)&&t<0};n.odd=function(t){return n.number(t)&&t%2===1};n.positive=function(t){return n.number(t)&&t>0};n.under=function(t,e){return n.all.number(t,e)&&te&&t=0&&t.indexOf(e,r)===r};n.endWith.api=["not"];n.include=function(n,t){return n.indexOf(t)>-1};n.include.api=["not"];n.lowerCase=function(t){return n.string(t)&&t===t.toLowerCase()};n.palindrome=function(t){if(n.not.string(t)){return false}t=t.replace(/[^a-zA-Z0-9]+/g,"").toLowerCase();var e=t.length-1;for(var r=0,a=Math.floor(e/2);r<=a;r++){if(t.charAt(r)!==t.charAt(e-r)){return false}}return true};n.space=function(t){if(n.not.char(t)){return false}var e=t.charCodeAt(0);return e>8&&e<14||e===32};n.startWith=function(t,e){return n.string(t)&&t.indexOf(e)===0};n.startWith.api=["not"];n.upperCase=function(t){return n.string(t)&&t===t.toUpperCase()};var F=["sunday","monday","tuesday","wednesday","thursday","friday","saturday"];var p=["january","february","march","april","may","june","july","august","september","october","november","december"];n.day=function(t,e){return n.date(t)&&e.toLowerCase()===F[t.getDay()]};n.day.api=["not"];n.dayLightSavingTime=function(n){var t=new Date(n.getFullYear(),0,1);var e=new Date(n.getFullYear(),6,1);var r=Math.max(t.getTimezoneOffset(),e.getTimezoneOffset());return n.getTimezoneOffset()e.getTime()};n.inDateRange=function(t,e,r){if(n.not.date(t)||n.not.date(e)||n.not.date(r)){return false}var a=t.getTime();return a>e.getTime()&&ae){return false}}return a===e};n.propertyCount.api=["not"];n.propertyDefined=function(t,e){return n.object(t)&&n.string(e)&&e in t};n.propertyDefined.api=["not"];n.inArray=function(t,e){if(n.not.array(e)){return false}for(var r=0;r="];for(var a=1;a\
\
\
\
\
\
-
Links
\
+
' + links_names + '
\
\
\
\