diff --git a/.travis.yml b/.travis.yml index e1ad58b..b50afc6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,31 +5,13 @@ dist: trusty sudo: required cache: packages -before_install: - sudo apt-get install -y libprotobuf-dev protobuf-compiler - -r: bioc-devel - -r_github_packages: - - hadley/devtools#1263 - - Bioconductor-mirror/zlibbioc - - Bioconductor-mirror/rhdf5 - - rte-antares-rpackage/manipulateWidget@develop - - rte-antares-rpackage/antaresMaps - - rte-antares-rpackage/antaresRead@develop - - rte-antares-rpackage/antaresProcessing@develop - addons: apt: - sources: - - sourceline: 'ppa:opencpu/jq' packages: - - libjq-dev - - valgrind - libgdal-dev - libproj-dev - libv8-3.14-dev - + include: - r: release - r: oldrel diff --git a/DESCRIPTION b/DESCRIPTION index 9e7dab2..3995a11 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,55 +1,48 @@ -Package: antaresViz -Type: Package -Title: Antares Visualizations -Version: 0.11.3 -Date: 2017-12-07 -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"), - person("Benoit", "Thieurmel", email = "benoit.thieurmel@datastorm.fr", role = "aut"), - person(given = "Titouan", family = "Robert", email = "titouan.robert@datastorm.fr", role = "aut"), - person("Baptiste", "SEGUINOT", , "baptiste.seguinot@rte-france.com", role = "ctb"), - person("RTE", role = "cph") - ) -Maintainer: Jalal-Edine ZAWAM -Description: Visualize results generated by Antares, a powerful software - developed by RTE to simulate and study electric power systems - (more information about Antares here: ). - This package provides functions that create interactive charts to help - Antares users visually explore the results of their simulations. -URL: https://github.com/rte-antares-rpackage/antaresViz -BugReports: https://github.com/rte-antares-rpackage/antaresViz/issues -License: GPL (>= 2) | file LICENSE -LazyData: TRUE -Encoding: UTF-8 -Depends: - antaresRead (>= 2.0.0), - antaresProcessing (>= 0.12.0), - spMaps (>= 0.1) -Imports: - dygraphs (>= 1.1.1), - shiny (>= 0.13.0), - magrittr, - plotly (>= 4.5.6), - htmltools, - htmlwidgets (>= 0.7.0), - manipulateWidget (>= 0.8.0), - leaflet (>= 1.1.0), - sp, - webshot, - data.table, - methods, - lubridate, - geojsonio, - graphics, - stats, - leaflet.minicharts (>= 0.5.2), - assertthat -RoxygenNote: 6.0.1 -Suggests: testthat, - covr, - rhdf5 (>= 2.20.2), - rbokeh, - knitr, - visNetwork -VignetteBuilder: knitr +Package: antaresViz +Type: Package +Title: Antares Visualizations +Version: 0.11.1 +Date: 2017-07-17 +Authors@R: c( + person("Francois", "Guillem", , "francois.guillem@rte-france.com", role = c("aut", "cre")), + person("Jalal-Edine", "ZAWAM", , "jalal-edine.zawam@rte-france.com", role = "ctb"), + person("RTE", role = "cph") + ) +Maintainer: Francois Guillem +Description: Visualize results generated by Antares, a powerful software + developed by RTE to simulate and study electric power systems + (more information about Antares here: ). + This package provides functions that create interactive charts to help + Antares users visually explore the results of their simulations. +URL: https://github.com/rte-antares-rpackage/antaresViz +BugReports: https://github.com/rte-antares-rpackage/antaresViz/issues +License: GPL (>= 2) | file LICENSE +LazyData: TRUE +Encoding: UTF-8 +Depends: + antaresRead (>= 0.14.0), + antaresProcessing (>= 0.11.0) +Imports: + dygraphs (>= 1.1.1), + shiny (>= 0.13.0), + miniUI, + magrittr, + plotly (>= 4.5.6), + tibble, + htmltools, + htmlwidgets (>= 0.7.0), + manipulateWidget (>= 0.7.0), + leaflet (>= 1.1.0), + sp, + webshot, + data.table, + methods, + lubridate, + geojsonio, + graphics, + stats, + leaflet.minicharts (>= 0.5.0) +RoxygenNote: 6.0.1 +Suggests: testthat, + covr + diff --git a/NAMESPACE b/NAMESPACE index 79f1b51..2ba2da2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,66 +1,47 @@ # Generated by roxygen2: do not edit by hand S3method(plot,antaresData) -S3method(plot,list) S3method(plot,mapLayout) -S3method(plot,simOptions) export(addShadows) export(colorScaleOptions) export(defaultTilesURL) export(exchangesStack) export(getInteractivity) -export(leafletDragPointsOutput) -export(limitSizeGraph) export(mapLayout) -export(modRpart) -export(modXY) export(plotMap) -export(plotMapLayout) export(plotMapOptions) -export(plotThermalGroupCapacities) -export(plotXY) export(prodStack) export(prodStackAliases) export(prodStackLegend) -export(renderLeafletDragPoints) -export(runAppAntaresViz) export(savePlotAsPng) export(setInteractivity) export(setProdStackAlias) -export(stackMap) export(tsLegend) export(tsPlot) import(antaresProcessing) import(antaresRead) -import(assertthat) import(data.table) import(dygraphs) import(htmltools) import(leaflet) import(leaflet.minicharts) import(manipulateWidget) +import(miniUI) import(shiny) -import(spMaps) importFrom(grDevices,col2rgb) importFrom(grDevices,colorRampPalette) importFrom(grDevices,colors) importFrom(grDevices,gray) importFrom(grDevices,rainbow) -importFrom(grDevices,rgb) importFrom(graphics,par) importFrom(graphics,plot) importFrom(methods,is) importFrom(plotly,add_bars) importFrom(plotly,add_heatmap) -importFrom(plotly,add_text) -importFrom(plotly,add_trace) importFrom(plotly,config) importFrom(plotly,layout) importFrom(plotly,plot_ly) -importFrom(shiny,runApp) -importFrom(stats,as.formula) importFrom(stats,density) importFrom(stats,lm) importFrom(stats,predict) importFrom(stats,quantile) -importFrom(utils,object.size) diff --git a/R/api_info.R b/R/api_info.R deleted file mode 100644 index db24422..0000000 --- a/R/api_info.R +++ /dev/null @@ -1,161 +0,0 @@ -.giveH5DataToApi <- function(sharerequest, infos, areas = NULL, links = NULL, clusters = NULL, districts = NULL){ - if(infos$isH5){ - gc() - if(length(sharerequest$mcYearh_l)==0) {mcYearh2 <- NULL}else{ - if("all"%in%sharerequest$mcYearh_l){ - mcYearh2 <- "all" - }else{ - mcYearh2 <- as.numeric(sharerequest$mcYearh_l) - } - } - if(!is.null(sharerequest$tables_l)) - { - if("areas" %in% sharerequest$tables_l){ - areas <- "all" - } - if("links" %in% sharerequest$tables_l){ - links <- "all" - } - if("clusters" %in% sharerequest$tables_l){ - clusters <- "all" - } - if("districts" %in% sharerequest$tables_l){ - districts <- "all" - } - } - readAntares(areas = areas, links = links, clusters = clusters,districts = districts , mcYears = mcYearh2, - timeStep = sharerequest$timeSteph5_l, opts = infos$dataInput) - }else{ - infos$dataInput - } -} - - - - - - - - -.giveDateInfos <- function(yD, params, xyCompare, minMax, tabl = NULL){ - use <- NULL - nulTab <- is.null(tabl) - if(!is.null(params)) - { - if(minMax == "min") - { - if(is.null(yD)){ - if(!nulTab) - { - use <- params$x[[1]][[tabl]]$dataDateRange[1] - } - else{ - use <- params$x[[1]]$dataDateRange[1] - } - }else if(xyCompare == "union"){ - use <- min( - do.call("c",(lapply(params$x, function(vv){ - if(nulTab){ - unique(vv$dataDateRange[1]) - }else{ - vv[[tabl]]$dataDateRange[1] - } - } - )))) - } else if(xyCompare == "intersect"){ - use <- max( - do.call("c",(lapply(params$x, function(vv){ - if(nulTab){ - unique(vv$dataDateRange[1]) - }else{ - vv[[tabl]]$dataDateRange[1] - } - } - )))) - } - } - if(minMax == "max") - { - if(is.null(yD)){ - if(!nulTab) - { - use <- params$x[[1]][[tabl]]$dataDateRange[2] - } - else{ - use <- params$x[[1]]$dataDateRange[2] - } - }else if(xyCompare == "union"){ - use <- max( - do.call("c",(lapply(params$x, function(vv){ - if(nulTab){ - unique(vv$dataDateRange[2]) - }else{ - vv[[tabl]]$dataDateRange[2] - } - } - )))) - } else if(xyCompare == "intersect"){ - use <- min( - do.call("c",(lapply(params$x, function(vv){ - if(nulTab){ - unique(vv$dataDateRange[2]) - }else{ - vv[[tabl]]$dataDateRange[2] - } - } - )))) - } - }} - use -} - -.giveParamH5 <- function(X_I, Y_I, xyCompare){ - if(X_I$isH5){ - opts <- X_I$dataInput - fid <- rhdf5::H5Fopen(opts$h5path) - timeStepS <- .getTimeStep(fid) - timeStepS <- as.character(timeStepS) - mcYearS <- opts$mcYears - tabl <- .getTableInH5(fid, timeStepS[1]) - rhdf5::H5Fclose(fid) - xPart = list( - timeStepS = timeStepS, - mcYearS = mcYearS, - tabl = tabl - ) - - }else{ - xPart = NULL - } - if(Y_I$isH5){ - opts <- Y_I$dataInput - fid <- rhdf5::H5Fopen(opts$h5path) - timeStepS <- .getTimeStep(fid) - timeStepS <- as.character(timeStepS) - mcYearS <- opts$mcYears - tabl <- .getTableInH5(fid, timeStepS[1]) - tabl <- tabl[tabl%in%c("areas", "districts")] - rhdf5::H5Fclose(fid) - yPart = list( - timeStepS = timeStepS, - mcYearS = mcYearS, - tabl = tabl - ) - }else{ - yPart = NULL - } - if(is.null(xPart) & is.null(yPart)){ - ret <- NULL - }else if(is.null(xPart)){ - ret <- yPart - }else if(is.null(yPart)){ - ret <- xPart - }else{ - ret <- list() - ret$timeStepS <- .compareOperation(list(xPart$timeStepS, yPart$timeStepS), xyCompare) - ret$mcYearS <- sort(.compareOperation(list(xPart$mcYearS, yPart$mcYearS), xyCompare)) - ret$tabl <- .compareOperation(list(xPart$tabl, yPart$tabl), xyCompare) - } - rhdf5::H5close() - ret -} \ No newline at end of file diff --git a/R/get_data_for_comp.R b/R/get_data_for_comp.R index 1f66a07..a26e64d 100644 --- a/R/get_data_for_comp.R +++ b/R/get_data_for_comp.R @@ -12,23 +12,15 @@ #' #' @noRd #' -.getDataForComp <- function(x, y = NULL, compare = NULL, compareOpts = NULL, processFun = as.antaresDataList, ...) { - - if(!is.list(x)){return(NULL)} +.getDataForComp <- function(x, y, compare, compareOpts, processFun = as.antaresDataList) { if (is.null(compareOpts)) compareOpts <- list() - - assert_that(is.function(processFun)) - - if (inherits(x, "antaresData")) { - x <- processFun(x, ...) + x <- processFun(x) if (!is.null(y)) { - assert_that(inherits(y, "antaresData")) - if (is.null(compare)) compare <- list() - y <- processFun(y, ...) + y <- processFun(y) x <- list(x, y) compareOpts$ncharts <- 2 } else { @@ -40,10 +32,7 @@ x <- replicate(compareOpts$ncharts, x, simplify = FALSE) } } else { - assert_that(is.list(x)) - assert_that(all(sapply(x, inherits, what = "antaresData")), - msg = "'x' is not an antaresData or a list of antaresData objects") - x <- lapply(x, processFun, ...) + x <- lapply(x, processFun) compareOpts$ncharts <- length(x) if (is.null(compare)) compare <- list() } diff --git a/R/graph_utils.R b/R/graph_utils.R deleted file mode 100644 index 4d4e2be..0000000 --- a/R/graph_utils.R +++ /dev/null @@ -1,323 +0,0 @@ -#' Compare options from length of data -#' -#' @param x list of data -#' @param compare character -#' -#' @noRd -.compOpts <- function(x, compare){ - - len <- 1 - - if("list" == class(x)[1]){ - len <- length(x) - } - if(length(x) > 1) - { - - ncol = ifelse(len > 2, 2 ,1) - nrow = floor((len-1)/2) + 1 + ifelse(len == 2, 1, 0) - return(list(ncharts = len, nrow = nrow, ncol = ncol)) - } - if(!is.null(compare)){ - return( - list(ncharts = 2, nrow = 2, ncol = 1) - ) - } - - return(list(ncharts = 1, nrow = 1, ncol = 1)) - -} - -#' Join date range -#' -#' @param params list of data -#' @param xyCompare character -#' @param minMax character -#' @param tabl character -#' -#' @noRd -.dateRangeJoin <- function(params, xyCompare, minMax, tabl = NULL){ - if(minMax == "min" & xyCompare == "union"){ - if(!is.null(tabl)) - { - date_range <- lapply(params$x, function(X){ - X[[tabl]]$dateRange[1] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(min(do.call("c",date_range))) - }else{ - date_range <- lapply(params$x, function(X){ - X$dateRange[1] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(min(do.call("c",date_range))) - } - } - if(minMax == "min" & xyCompare == "intersect"){ - if(!is.null(tabl)) - { - date_range <- lapply(params$x, function(X){ - X[[tabl]]$dateRange[1] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(max(do.call("c",date_range))) - }else{ - date_range <- lapply(params$x, function(X){ - X$dateRange[1] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(max(do.call("c",date_range))) - } - } - if(minMax == "max" & xyCompare == "union"){ - if(!is.null(tabl)) - { - date_range <- lapply(params$x, function(X){ - X[[tabl]]$dateRange[2] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(max(do.call("c",date_range))) - }else{ - date_range <- lapply(params$x, function(X){ - X$dateRange[2] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(max(do.call("c",date_range))) - } - } - if(minMax == "max" & xyCompare == "intersect"){ - if(!is.null(tabl)) - { - date_range <- lapply(params$x, function(X){ - X[[tabl]]$dateRange[2] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(min(do.call("c",date_range))) - }else{ - date_range <- lapply(params$x, function(X){ - X$dateRange[2] - }) - date_range <- date_range[which(sapply(date_range, function(x) !is.null(x)))] - - return(min(do.call("c",date_range))) - } - } -} - - - -#' Transform data -#' -#' @param x list of data -#' @param compare character -#' @param compareOpts list -#' @param processFun function -#' @param ... -#' -#' @noRd -.transformDataForComp <- function(x, compare = NULL, - compareOpts = NULL, - processFun = as.antaresDataList, ...) { - if(!is.list(x)){return(NULL)} - if (is.null(compareOpts)) compareOpts <- list() - assert_that(is.function(processFun)) - assert_that(is.list(x)) - assert_that(all(sapply(x, inherits, what = "antaresData")), - msg = "'x' is not an antaresData or a list of antaresData objects") - x <- lapply(x, processFun, ...) - compareOpts$ncharts <- length(x) - if (is.null(compare)) compare <- list() - compareOpts <- do.call(compareOptions, compareOpts) - list( - x = x, - compare = compare, - compareOpts = compareOpts - ) -} - -#' Transform x in homogeneous format, list of antaresdatalist / opts -#' -#' @param x list of data -#' -#' @noRd -.giveListFormat <- function(x){ - if(.isSimOpts(x) | "antaresData" %in% class(x)){ - list(.rescoverFormat(x)) - }else{ - if("list" %in% class(x)){ - lapply(x, .rescoverFormat) - }else{ - stop("class x must be antaresData or simOptions or list") - } - } -} - -#' Transform x in antaresdatalist / opts -#' -#' @param x data -#' -#' @noRd -.rescoverFormat <- function(x){ - if("antaresData" %in% class(x)) - { - re <- as.antaresDataList(x) - }else{ - if(.isSimOpts(x)){ - re <- x - }else{ - stop("class x must be antaresData or simOptions") - } - } - re -} - - -#' Test opst -#' -#' @param test if x is simOptions class -#' -#' @noRd -.isSimOpts <- function(x){ - "simOptions" %in% class(x) -} - - -#' Load h5 data -#' -#' @param sharerequest, list of mcYearh_l, tables_l and timeSteph5_l -#' @param dta, antaresdatalist or opts, if antaresdatalist do nothing, if opts load data -#' @param areas character -#' @param links character -#' @param clusters character -#' @param districts character -#' -#' @noRd -.loadH5Data <- function(sharerequest, dta, areas = NULL, links = NULL, clusters = NULL, - districts = NULL, h5requestFilter = list()){ - if(.isSimOpts(dta)){ - gc() - if(length(sharerequest$mcYearh_l)==0) {mcYearh2 <- NULL}else{ - if("all"%in%sharerequest$mcYearh_l){ - mcYearh2 <- "all" - }else{ - mcYearh2 <- as.numeric(sharerequest$mcYearh_l) - } - } - if(!is.null(sharerequest$tables_l)) - { - if("areas" %in% sharerequest$tables_l){ - areas <- "all" - } - if("links" %in% sharerequest$tables_l){ - links <- "all" - } - if("clusters" %in% sharerequest$tables_l){ - clusters <- "all" - } - if("districts" %in% sharerequest$tables_l){ - districts <- "all" - } - } - - - argS <- list(areas = areas, links = links, clusters = clusters,districts = districts , mcYears = mcYearh2, - timeStep = sharerequest$timeSteph5_l, opts = dta) - argS[names(h5requestFilter)] <- h5requestFilter - dt <- do.call(readAntares, - argS) - - dt <- as.antaresDataList(dt) - for(i in 1:length(dt)){ - if(all(names(dt[[i]])%in%.idCols(dt[[i]]))){ - dt[[i]] <- NULL - } - } - dt - }else{ - dta - } -} - - - - -#' List of h5 params -#' -#' @param X_I, list -#' @param xyCompare, character -#' -#' @noRd -.h5ParamList <- function(X_I, xyCompare, h5requestFilter = NULL){ - listParam <- lapply(1:length(X_I), function(i){ - x <- X_I[[i]] - if(.isSimOpts(x)){ - tmp <- .h5Inf(x) - h5_filter <- h5requestFilter[[i]] - h5_tables <- c("areas", "districts", "clusters", "links") - if(!is.null(h5_filter)){ - if(!(is.null(h5_filter$areas) & is.null(h5_filter$districts) & - is.null(h5_filter$links) & is.null(h5_filter$clusters))){ - h5_tables <- c("areas", "districts", "clusters", "links") - h5_tables <- h5_tables[which(c(!is.null(h5_filter$areas), !is.null(h5_filter$districts), - !is.null(h5_filter$clusters), !is.null(h5_filter$links)))] - } - } - tmp$tabl <- intersect(tmp$tabl, h5_tables) - rhdf5::H5close() - tmp - }else{ - mcY <- unique(unlist(lapply(x, function(y){unique(y$mcYears)}))) - timeStepS <- attributes(x)$timeStep - tabl <- names(x) - list( - timeStepS = timeStepS, - mcYearS = mcY, - tabl = tabl - ) - } - }) - res <- lapply(.transposeL(listParam), function(x){ - .compareOperation(x, xyCompare) - }) - - res$h5requestFilter <- h5requestFilter - res -} - -#' Load information from h5 file -#' -#' @param x, opts -#' -#' @noRd -.h5Inf <- function(x){ - fid <- rhdf5::H5Fopen(x$h5path) - timeStepS <- .getTimeStep(fid) - timeStepS <- as.character(timeStepS) - mcYearS <- x$mcYears - tabl <- .getTableInH5(fid, timeStepS[1]) - rhdf5::H5Fclose(fid) - xPart = list( - timeStepS = timeStepS, - mcYearS = mcYearS, - tabl = tabl - ) -} - - -.transposeL <- function(data){ - do.call(c, apply(do.call(rbind, data), 2, list)) -} - - -.testXclassAndInteractive <- function(x, interactive){ - if(!"antaresData" %in% class(x) & !interactive){ - stop("You can at moment only use no interactive mode with one no h5 antares study.") - } -} diff --git a/R/h5_utils.R b/R/h5_utils.R deleted file mode 100644 index c6718dc..0000000 --- a/R/h5_utils.R +++ /dev/null @@ -1,112 +0,0 @@ -.convertH5Filtering <- function(h5requestFiltering, x) -{ - if(length(h5requestFiltering)>0) - { - if(!is.list(h5requestFiltering[[1]])){ - if(!any(c("simOptions", "antaresDataTable") %in%class(x))) - { - h5requestFiltering <- rep(list(h5requestFiltering), length(x)) - }else{ - h5requestFiltering <- list(h5requestFiltering) - } - }else{ - if(class(x) == "list"){ - if(length(h5requestFiltering) != length(x)){ - h5requestFiltering <- h5requestFiltering[1:length(x)%%length(h5requestFiltering) + 1] - } - } - } - }else{ - if(!any(c("simOptions", "antaresDataTable") %in%class(x))) - { - h5requestFiltering <- replicate(length(x), list()) - }else{ - h5requestFiltering <- replicate(1, list()) - } - } - h5requestFiltering -} - - - -.getTableInH5 <- function(fid, timeStep){ - dataExist <- NULL - if(rhdf5::H5Lexists(fid, paste0(timeStep, "/areas"))) - { - dataExist <- c(dataExist, "areas") - } - if(rhdf5::H5Lexists(fid, paste0(timeStep, "/links"))) - { - dataExist <- c(dataExist, "links") - } - if(rhdf5::H5Lexists(fid, paste0(timeStep, "/clusters"))) - { - dataExist <- c(dataExist, "clusters") - } - if(rhdf5::H5Lexists(fid, paste0(timeStep, "/districts"))) - { - dataExist <- c(dataExist, "districts") - } - dataExist -} - -.getVariablesH5 <- function(fid, timeStep, tables){ - sapply(tables, function(X){ - struct <- .getstructure(fid, paste0(timeStep, "/", X, "/mcInd/", "/structure"))$variable - if("timeId"%in%struct){ - struct <- struct[struct!="timeId"] - } - struct - }, simplify = FALSE) -} - -.getClustersNames <- function(fid, timeStep){ - unique(unlist(lapply(strsplit(.getstructure(fid, paste0(timeStep, "/clusters/mcInd/structure"))$cluster, "/"), function(X)X[1]))) -} - -.getElements <- function(opts, tables, fid, timeStep){ - elements <- list() - if("areas" %in% tables) elements$areas <- opts$areaList - if("links" %in% tables) elements$links <- opts$linkList - if("districts" %in% tables) elements$districts <- opts$districtList - if("clusters" %in% tables){ - elements$clusters <- .getClustersNames(fid, timeStep) - } - elements -} - -.getDateRange <- function(opts, timeStep){ - tim <- .timeIdToDate(sort( - unique( - antaresRead::.h5ReadAntares(opts$h5path, timeStep = timeStep, select = "timeId", - areas = opts$areaList[1], mcYears = opts$mcYears[1], perf = FALSE)$timeId) - ), timeStep = timeStep, opts = opts) - dt <- as.Date(range(tim)) - dt -} - - -.getGraphFunction <- function(type){ - switch(type, - "ts" = .plotTS, - "barplot" = .barplot, - "monotone" = .plotMonotone, - "density" = .density, - "cdf" = .cdf, - "heatmap" = .heatmap, - stop("Invalid type") - ) -} - -.getTimeStep <- function(fid){ - timeSteps <- sapply(c("hourly", "daily", "weekly", "monthly", "annual"), function(X){ - rhdf5::H5Lexists(fid, X) - }) - names(timeSteps[which(timeSteps == TRUE)]) -} - -.compareOperation <- function(a, opType){ - if(length(a) == 1) return(unlist(unique(a))) - if(opType == "union") return(Reduce(union, a)) - if(opType == "intersect") return(Reduce(intersect, a)) -} diff --git a/R/h5_utils_plot.R b/R/h5_utils_plot.R deleted file mode 100644 index 4e81aa8..0000000 --- a/R/h5_utils_plot.R +++ /dev/null @@ -1,128 +0,0 @@ - -.getData <- function(path, table, mcYear, variable, elements, dateRange, timeStep){ - opts <- antaresRead::.getOptionsH5(path) - if(mcYear == "MC-All") - { - mcYear <- NULL - } - areas <- links <- clusters <- districts <- NULL - assign(table, as.character(elements)) - data <- antaresRead::.h5ReadAntares(path = path, - areas = areas, - links = links, - clusters = clusters, - districts = districts, - mcYears = mcYear, - select = variable, - timeStep = timeStep, - perf = FALSE) - if(nrow(data) == 0){return(data)} - - colsId <- antaresRead::getIdCols(data) - - if("cluster" %in% colsId){ - idV <- c("area", "cluster") - } else if ("area"%in%colsId){ - idV <- "area" - } else if ("link"%in%colsId){ - idV <- "link" - } else if ("district"%in%colsId){ - idV <- "district" - } - valueCol <- setdiff(names(data), colsId) - valueCol <- intersect(valueCol, variable) - - data <- data[,.SD, .SDcols = c("timeId", "time", valueCol, idV)] - if(length(idV) > 1){ - data[, "newKey" := paste0(lapply(.SD, as.character), collapse = " < "), .SDcols = idV,by=1:nrow(data)] - data[,c(idV) := NULL] - idV <- "newKey" - }else{ - setnames(data, idV, "newKey") - } - data$newKey <- as.character(data$newKey) - - if(ncol(data) > 4){ - data <- melt(data, c("newKey", "timeId", "time")) - data[, "newKey" := paste0(data$newKey, " - ", as.character(variable)),by=1:nrow(data)] - data[, variable := NULL] - valueCol <- "value" - } - - - odc <- c("timeId", "time", valueCol, "newKey") - setcolorder(data, odc) - setnames(data, names(data), c("timeId", "time", "value", "element")) - - data[,time := .timeIdToDate(timeId, timeStep, opts)] - data[time >= dateRange[1] & time <= dateRange[2]] - -} - -.doPlot <- function(.id, - path, - table, - mcYear, - variable, - elements, - timeStep, - data, - dateRange, - type, - minValue, - maxValue, - colors, - main, - ylab, - legend, - legendItemsPerRow, - width, - height, - opts, - colorScaleOpts, - group){ - - - data <- .getData(ifelse(length(path) == 1 , path , path[.id]), table, mcYear, variable, elements, dateRange, timeStep) - if(nrow(data) == 0){return(NULL)} - f <- .getGraphFunction(type) - - f( - data, - timeStep = timeStep, - variable = variable, - confInt = 0, - minValue = minValue, - maxValue = maxValue, - colors = colors, - main = if(length(main) <= 1) main else main[.id], - ylab = if(length(ylab) <= 1) ylab else ylab[.id], - legend = legend, - legendItemsPerRow = legendItemsPerRow, - width = width, - height = height, - opts = opts, - colorScaleOpts = colorScaleOpts, - group = group - ) - -} - - -.getstructure <- function(fid, strgp){ - gid <- rhdf5::H5Gopen(fid, strgp) - data <- rhdf5::h5dump(gid) - rhdf5::H5Gclose(gid) - if(length(which(data$reCalcVar!="")) > 0) - { - data$reCalcVar <- data$reCalcVar[which(data$reCalcVar!="")] - data$variable <- c(data$variable, data$reCalcVar) - data$reCalcVar <- NULL - } - data -} - -.tryCloseH5 <- function(){ - try(rhdf5::H5close(), silent = TRUE) -} - diff --git a/R/leafletDragPoints.R b/R/leafletDragPoints.R index 3dde8c6..3e6b4df 100644 --- a/R/leafletDragPoints.R +++ b/R/leafletDragPoints.R @@ -1,16 +1,13 @@ #' @noRd -leafletDragPoints <- function(geopoints, map = NULL, width = NULL, height = NULL, - init = FALSE, reset_map = FALSE, draggable = TRUE) { +leafletDragPoints <- function(geopoints, map = NULL, width = NULL, height = NULL) { if (!is.null(map)) map <- geojsonio::geojson_json(map) - if(!is.null(geopoints)){ - geopoints$avg <- (geopoints$lat + geopoints$lon) / 2 - - firstPoint <- which.min(geopoints$avg) - secondPoint <- which.max(geopoints$avg) - } + geopoints$avg <- (geopoints$lat + geopoints$lon) / 2 - x = list(geopoints = geopoints, map = map, init = init, reset_map = reset_map, draggable = draggable) + firstPoint <- which.min(geopoints$avg) + secondPoint <- which.max(geopoints$avg) + + x = list(geopoints = geopoints, map = map) attr(x, 'TOJSON_ARGS') <- list(dataframe = "rows") # create widget @@ -42,13 +39,13 @@ leafletDragPoints <- function(geopoints, map = NULL, width = NULL, height = NULL #' #' @name placeGeoPoints-shiny #' -#' @export +#' @noRd leafletDragPointsOutput <- function(outputId, width = '100%', height = '400px'){ htmlwidgets::shinyWidgetOutput(outputId, 'leafletDragPoints', width, height, package = 'antaresViz') } #' @rdname placeGeoPoints-shiny -#' @export +#' @noRd renderLeafletDragPoints <- function(expr, env = parent.frame(), quoted = FALSE) { if (!quoted) { expr <- substitute(expr) } # force quoted htmlwidgets::shinyRenderWidget(expr, leafletDragPointsOutput, env, quoted = TRUE) diff --git a/R/limitSizeGraph.R b/R/limitSizeGraph.R deleted file mode 100644 index 6d78631..0000000 --- a/R/limitSizeGraph.R +++ /dev/null @@ -1,24 +0,0 @@ -#' Use to change limit size of graph (in Mb) -#' -#' @param size \code{numeric} widget size autorized in modules (default 200) -#' @examples -#' \dontrun{ -#' limitSizeGraph(500) -#' } -#' -#' @export -limitSizeGraph <- function(size){ - options(antaresVizSizeGraph = size) -} - -controlWidgetSize <- function(widget){ - if(is.null(getOption("antaresVizSizeGraph"))){ - options(antaresVizSizeGraph = 200) - } - - if(round(as.numeric(object.size(widget)) / 1048000, 1) > getOption("antaresVizSizeGraph")){ - return(combineWidgets(antaresVizSizeGraphError)) - } else { - widget - } -} diff --git a/R/map.R b/R/map.R index a5b7aef..9ebc667 100644 --- a/R/map.R +++ b/R/map.R @@ -8,9 +8,7 @@ #' #' @param x #' Object of class \code{antaresDataList} created with -#' \code{\link[antaresRead]{readAntares}} and containing areas and links data. -#' It can be a list of \code{antaresData} objects. -#' In this case, one chart is created for each object. +#' \code{\link[antaresRead]{readAntares}} and containing areas and links data #' @param mapLayout #' Object created with function \code{\link{mapLayout}} #' @param colAreaVar @@ -64,26 +62,8 @@ #' @param options #' List of parameters that override some default visual settings. See the #' help of \code{\link{plotMapOptions}}. -#' @param sizeMiniPlot \code{boolean} variable size for miniplot #' @inheritParams prodStack #' -#' -#' @details -#' -#' compare argument can take following values : -#' \itemize{ -#' \item "mcYear" -#' \item "type" -#' \item "colAreaVar" -#' \item "sizeAreaVars" -#' \item "areaChartType" -#' \item "showLabels" -#' \item "popupAreaVars" -#' \item "labelAreaVar" -#' \item "colLinkVar" -#' \item "sizeLinkVar" -#' \item "popupLinkVars" -#' } #' @return #' An htmlwidget of class "leaflet". It can be modified with package #' \code{leaflet}. By default the function starts a shiny gadget that lets the @@ -100,41 +80,23 @@ #' # functions save and load #' #' layout <- readLayout() -#' ml <- mapLayout(layout = layout) +#' ml <- mapLayout(layout) #' save("ml", file = "ml.rda") #' -#' plotMap(x = mydata, mapLayout = ml) +#' plotMap(mydata, ml) #' #' # Specify the variables to use to control the color or size of elements. -#' plotMap(mydata, mapLayout = ml, +#' plotMap(mydata, ml, #' sizeAreaVars = c("WIND", "SOLAR", "H. ROR"), #' sizeLinkVar = "FLOW LIN.") #' #' # Change default graphical properties -#' plotMap(x = mydata, mapLayout = ml, options = list(colArea="red", colLink = "orange")) -#' plotMap(x = list(mydata, mydata), mapLayout = ml) -#' -#' # Use h5 for dynamic request / exploration in a study -#' # Set path of simulaiton -#' setSimulationPath(path = path1) -#' -#' # Convert your study in h5 format -#' writeAntaresH5(path = mynewpath) -#' -#' # Redefine sim path with h5 file -#' opts <- setSimulationPath(path = mynewpath) -#' plotMap(x = opts, mapLayout = ml) -#' -#' # Compare elements in a single study -#' plotMap(x = opts, mapLayout = ml, .compare = "mcYear") -#' -#' # Compare 2 studies -#' plotMap(x = list(opts, opts2), mapLayout = ml) +#' plotMap(mydata, ml, options = list(colArea="red", colLink = "orange")) #' #' } #' #' @export -plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), +plotMap <- function(x, y = NULL, mapLayout, colAreaVar = "none", sizeAreaVars = c(), areaChartType = c("bar", "pie", "polar-area", "polar-radius"), uniqueScale = FALSE, showLabels = FALSE, @@ -150,59 +112,15 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), compareOpts = list(), interactive = getInteractivity(), options = plotMapOptions(), - width = NULL, height = NULL, dateRange = NULL, xyCompare = c("union","intersect"), - h5requestFiltering = list(), - timeSteph5 = "hourly", - mcYearh5 = NULL, - tablesh5 = c("areas", "links"), - sizeMiniPlot = FALSE,...) { - - - if(!is.null(compare) && !interactive){ - stop("You can't use compare in no interactive mode") - } - - Column <- optionsT <- NULL - tpMap <- plotMapOptions() - - #Check compare - .validCompare(compare, c("mcYear", "type", "colAreaVar", "sizeAreaVars", "areaChartType", "showLabels", - "popupAreaVars", "labelAreaVar","colLinkVar", "sizeLinkVar", "popupLinkVars")) - - runScale <- ifelse(!identical(options[names(options)!="preprocess"] , - tpMap[names(tpMap)!="preprocess"]), FALSE, TRUE) + width = NULL, height = NULL) { type <- match.arg(type) areaChartType <- match.arg(areaChartType) - xyCompare <- match.arg(xyCompare) - - if(colAreaVar != "none" & colAreaVar%in%colorsVars$Column & runScale) - { - raw <- colorsVars[Column == 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))) - - } + options <- do.call(plotMapOptions, options) if (is.null(mcYear)) mcYear <- "average" - - if(!is.null(compare) && "list" %in% class(x)){ - if(length(x) == 1) x <- list(x[[1]], x[[1]]) - } - if(!is.null(compare) && ("antaresData" %in% class(x) | "simOptions" %in% class(x))){ - x <- list(x, x) - } - # .testXclassAndInteractive(x, interactive) - - h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x) - - - compareOptions <- .compOpts(x, compare) - if(is.null(compare)){ - if(compareOptions$ncharts > 1){ - compare <- "" - } + if (inherits(y, "mapLayout")) { + mapLayout <- y + y <- NULL } group <- paste0("map-group-", sample(1e9, 1)) @@ -210,26 +128,11 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), # Check that parameters have the good class if (!is(mapLayout, "mapLayout")) stop("Argument 'mapLayout' must be an object of class 'mapLayout' created with function 'mapLayout'.") - init_dateRange <- dateRange - - # new_env for save and control mapLayout - env_plotFun <- new.env() - - processFun <- function(x, mapLayout) { + params <- .getDataForComp(x, y, compare, compareOpts, function(x) { if (!is(x, "antaresData")) { stop("Argument 'x' must be an object of class 'antaresData' created with function 'readAntares'.") } else { x <- as.antaresDataList(x) - if(!is.null(x$areas)){ - if(nrow(x$areas) == 0){ - x$areas <- NULL - } - } - if(!is.null(x$links)){ - if(nrow(x$links) == 0){ - x$links <- NULL - } - } if (is.null(x$areas) && is.null(x$links)) stop("Argument 'x' should contain at least area or link data.") } @@ -263,41 +166,19 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), oldkeys <- lapply(x, key) if (attr(x, "synthesis")) { - - if(mcYear != "average"){ - .printWarningMcYear() - } - mcYear <- "average" } else { if (areas) setkeyv(x$areas, "mcYear") if (links) setkeyv(x$links, "mcYear") } - opts <- simOptions(x) - if(!is.null(x$areas)){ - x$areas[,time := .timeIdToDate(x$areas$timeId, attr(x, "timeStep"), opts)] - } - - if(!is.null(x$links)){ - x$links[,time := .timeIdToDate(x$links$timeId, attr(x, "timeStep"), opts)] - } - - if(is.null(init_dateRange)){ - if(!is.null(x$areas)){ - init_dateRange <- range(as.Date(x$areas$time)) - }else{ - init_dateRange <- range(as.Date(x$links$time)) - } - } - # Function that draws the final map when leaving the shiny gadget. plotFun <- function(t, colAreaVar, sizeAreaVars, popupAreaVars, areaChartType, uniqueScale, showLabels, labelAreaVar, colLinkVar, sizeLinkVar, popupLinkVars, type = c("detail", "avg"), mcYear, - initial = TRUE, session = NULL, outputId = "output1", - dateRange = NULL, sizeMiniPlot = FALSE, options = NULL) { + initial = TRUE, session = NULL, outputId = "output1") { + type <- match.arg(type) if (type == "avg") t <- NULL else if (is.null(t)) t <- 0 @@ -305,48 +186,16 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), # Prepare data if (mcYear == "average") x <- syntx - # print("dateRange") - # print(dateRange) - if(!is.null(dateRange)){ - dateRange <- sort(dateRange) - # xx <<- copy(x$areas) - # dd <<- dateRange - if(!is.null(x$areas)) - { - # in case of missing transformation... - if("character" %in% class(x$areas$time)){ - x$areas[,time := .timeIdToDate(x$areas$timeId, attr(x, "timeStep"), simOptions(x))] - } - x$areas <- x$areas[time >= as.POSIXlt(dateRange[1], tz = "UTC") & time < as.POSIXlt(dateRange[2] + 1, tz = "UTC")] - } - if(!is.null(x$links)) - { - # in case of missing transformation... - if("character" %in% class(x$links$time)){ - x$links[,time := .timeIdToDate(x$links$timeId, attr(x, "timeStep"), simOptions(x))] - } - 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) - } else if(!isTRUE(all.equal(mapLayout, get("currentMapLayout", envir = env_plotFun)))){ - assign("currentMapLayout", mapLayout) map <- .initMap(x, mapLayout, options) %>% 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 <- leafletProxy(outputId, session) } + map %>% .redrawLinks(x, mapLayout, mcYear, t, colLinkVar, sizeLinkVar, popupLinkVars, options) %>% .redrawCircles(x, mapLayout, mcYear, t, colAreaVar, sizeAreaVars, popupAreaVars, - uniqueScale, showLabels, labelAreaVar, areaChartType, options, sizeMiniPlot) + uniqueScale, showLabels, labelAreaVar, areaChartType, options) } # Create the interactive widget @@ -375,290 +224,78 @@ plotMap <- function(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), linkValColums = linkValColums, linkNumValColumns = linkNumValColumns, hideTimeIdSlider = hideTimeIdSlider, - timeId = timeId, - dateRange = init_dateRange + timeId = timeId ) - } + }) if (!interactive) { - x <- .cleanH5(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering) - + map <- params$x[[1]]$plotFun(timeId, colAreaVar, sizeAreaVars, popupAreaVars, areaChartType, + uniqueScale, showLabels, labelAreaVar, colLinkVar, + sizeLinkVar, popupLinkVars, type = type, mcYear = mcYear) + return(combineWidgets(map, title = main, width = width, height = height)) + } else { - params <- .getDataForComp(.giveListFormat(x), NULL, compare, compareOpts, processFun = processFun, mapLayout = mapLayout) - L_w <- lapply(params$x, function(X){ - X$plotFun(t = 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, dateRange = dateRange, - sizeMiniPlot = sizeMiniPlot, options = options) - }) - return(combineWidgets(list = L_w, title = main, width = width, height = height)) - - - } - - ##remove notes - mcYearH5 <- NULL - paramsH5 <- NULL - sharerequest <- NULL - timeStepdataload <- NULL - timeSteph5 <- NULL - x_in <- NULL - x_tranform <- NULL - - manipulateWidget( - { - if(!is.null(params)) + manipulateWidget( { - if(.id <= length(params$x)){ - .tryCloseH5() - - tmp_options <- optionsT - if(is.null(tmp_options)){ - 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) - - - } else { - combineWidgets("No data for this selection") - } - }else{ - combineWidgets() - } - }, - - x = mwSharedValue({x}), - 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({ - paramsH5List <- .h5ParamList(X_I = x_in, xyCompare = xyCompare, h5requestFilter = h5requestFiltering) - rhdf5::H5close() - 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)))} - ), - sharerequest = mwSharedValue({ - list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables) - }), - x_tranform = mwSharedValue({ - sapply(1:length(x_in),function(zz){ - .loadH5Data(sharerequest, x_in[[zz]], h5requestFilter = paramsH5$h5requestFilter[[zz]]) - }, simplify = FALSE) - }), - - ##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}))) - ), - type = mwRadio(list("By time id"="detail", "Average" = "avg"), value = type), - dateRange = mwDateRange( - value = { - if(.initial) params$x[[1]]$dateRange - else NULL + params$x[[.id]]$plotFun(params$x[[.id]]$timeId, colAreaVar, sizeAreaVars, popupAreaVars, areaChartType, + uniqueScale, showLabels, labelAreaVar, + colLinkVar, sizeLinkVar, popupLinkVars, type, mcYear, .initial, .session, + .output) }, - min = params$x[[1]]$dateRange[1], - max = params$x[[1]]$dateRange[2],label = "Daterange" - ), - - Areas = mwGroup( - colAreaVar = 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))) - } - }, - value = { - if(.initial) colAreaVar - else NULL - }, - label = "Color" - ), - sizeAreaVars = mwSelect( - { - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv$areaNumValColumns) - }), xyCompare)) - }, - value = { - if(.initial) sizeAreaVars - else NULL - }, label = "Size", multiple = TRUE), - miniPlot = mwGroup( + + mcYear = mwSelect(c("average", unique(x[[1]]$mcYear)), mcYear, .display = params$x[[.id]]$showMcYear), + type = mwRadio(list("By time id"="detail", "Average" = "avg"), value = type), + + Areas = mwGroup( + colAreaVar = mwSelect( + choices = { + if (mcYear == "average") c("none", params$x[[.id]]$areaValColumnsSynt) + else c("none", params$x[[.id]]$areaValColumns) + }, + value = colAreaVar, + label = "Color" + ), + sizeAreaVars = mwSelect(params$x[[.id]]$areaNumValColumns, sizeAreaVars, label = "Size", multiple = TRUE), 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), + value = areaChartType, .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), popupAreaVars = 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))) - } - }, - value = { - if(.initial) popupAreaVars - else NULL + choices = { + if (mcYear == "average") c("none", params$x[[.id]]$areaValColumnsSynt) + else c("none", params$x[[.id]]$areaValColumns) }, + popupAreaVars, label = "Popup", multiple = TRUE ), 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 (mcYear == "average") c("none", params$x[[.id]]$areaValColumnsSynt) + else c("none", params$x[[.id]]$areaValColumns) }, - value = { - if(.initial) labelAreaVar - else NULL - }, label = "Label", + labelAreaVar, label = "Label", .display = length(sizeAreaVars) < 2 - ), - .display = any(sapply(params$x, function(p) {"areas" %in% names(p$x)})) + ) ), Links = mwGroup( - colLinkVar = mwSelect( - { - c("none", - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv$linkValColums) - }), xyCompare))) - }, - 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)})) + colLinkVar = mwSelect(c("none", params$x[[.id]]$linkValColums), colLinkVar, label = "Color"), + sizeLinkVar = mwSelect(c("none", params$x[[.id]]$linkNumValColumns), sizeLinkVar, label = "Width"), + popupLinkVars = mwSelect(params$x[[.id]]$linkValColums, popupLinkVars, label = "Popup", multiple = TRUE) ), - mapLayout = mwSharedValue(mapLayout), - main = mwText(main, label = "title"), - params = mwSharedValue({ - .getDataForComp(x_tranform, NULL, compare, compareOpts, - processFun = processFun, mapLayout = mapLayout) - }), + .viewer = "browser", .width = width, .height = height, - .compare = { - compare - }, - .compareOpts = { - compareOptions - }, - .return = function(w, e) {combineWidgets(w, title = main, width = width, height = height)}, - ... + .return = function(w, e) combineWidgets(w, title = main, width = width, height = height), + .compare = params$compare, + .compareOpts = params$compareOpts ) - + } } - - diff --git a/R/map_helpers.R b/R/map_helpers.R index 14322bf..4f1ba4c 100644 --- a/R/map_helpers.R +++ b/R/map_helpers.R @@ -29,8 +29,6 @@ #' @noRd .getColAndSize <- function(data, coords, mergeBy, mcy, t, colVar, sizeVar, popupVars, colorScaleOpts, labelVar = NULL) { - - if (mcy != "average") data <- data[J(as.numeric(mcy))] @@ -62,25 +60,13 @@ if (colVar != "none") { if (is.numeric(data[[colVar]])) { rangevar <- range(data[[colVar]]) - if(length(colorScaleOpts$breaks) > 1 ){ - if(min(rangevar) < min(colorScaleOpts$breaks)){ - colorScaleOpts$breaks <- c(min(rangevar), colorScaleOpts$breaks) - colorScaleOpts$colors <- c("noColor", colorScaleOpts$colors) - } - - if(max(rangevar) > max(colorScaleOpts$breaks)){ - colorScaleOpts$breaks <- c( colorScaleOpts$breaks, max(rangevar)) - colorScaleOpts$colors <- c( colorScaleOpts$colors, "noColor") - } - } - # 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)) + domain <- c(-max(abs(rangevar)), max(abs(rangevar))) } if (colVar == "FLOW LIN.") colorScaleOpts$x <- abs(data[[colVar]]) @@ -133,7 +119,7 @@ timeStep, hourly = "%a %d %b %Y
%H:%M", daily = "%a %d %b %Y", - weekly = "W%V %Y", + weekly = "W%w %Y", monthly = "%b %Y", yearly = "%Y" ) @@ -159,12 +145,9 @@ .redrawCircles <- function(map, x, mapLayout, mcy, t, colAreaVar, sizeAreaVars, popupAreaVars, uniqueScale, showLabels, labelAreaVar, areaChartType, - options, sizeMiniPlot = FALSE) { + options) { if (is.null(x$areas)) return(map) - if (nrow(x$areas) == 0) return(map) - - timeStep <- attr(x, "timeStep") # Just in case, we do not want to accidentally modify the original map layout. @@ -176,7 +159,6 @@ options$areaColorScaleOpts, labelVar = labelAreaVar) ml$coords <- optsArea$coords - # Use default values if needed. if (is.null(optsArea$color)) optsArea$color <- options$areaDefaultCol @@ -231,41 +213,10 @@ } } - if(sizeMiniPlot) - { - if(is.matrix(optsArea$size)) - { - if(ncol(optsArea$size) > 1 ) - { - optsArea$Va <- rowSums(optsArea$size) - optsArea$VaP <- optsArea$Va / max(optsArea$Va) - fM <- 3 - optsArea$Ra <- 15 + (optsArea$VaP * fM * 30)/2 - } - } - } - - if(is.null(optsArea$Ra)){optsArea$Ra <- width} # Update areas - - #Apply colors defined in color.csv - if(is.null(options$areaChartColors)) - { - varS <- names(optsArea$maxSize) - colorDef <- colorsVars$colors[match(varS, colorsVars$Column)] - defCol <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd", "#8c564b", - "e377c2", "#7f7f7f", "#bcbd22", "#17becf") - nbNa <- sum(is.na(colorDef)) - if(nbNa > 0) - { - colorDef[is.na(colorDef)] <- defCol[1:nbNa] - } - options$areaChartColors <- colorDef - } - map <- updateMinicharts(map, optsArea$coords$area, chartdata = optsArea$size, time = optsArea$coords$time, - maxValues = optsArea$maxSize, width = optsArea$Ra, + maxValues = optsArea$maxSize, width = width, height = options$areaMaxHeight, showLabels = showLabels, labelText = labels, type = areaChartType[[1]], @@ -314,8 +265,6 @@ .redrawLinks <- function(map, x, mapLayout, mcy, t, colLinkVar, sizeLinkVar, popupLinkVars, options) { if (is.null(x$links)) return(map) - if (nrow(x$links) == 0) return(map) - timeStep <- attr(x, "timeStep") @@ -348,7 +297,7 @@ labels = sizeLinkVar, digits = 2, supValues = optsLink$coords[, optsLink$popupVars, with = FALSE] - ), + ), opacity = 1) # Update the legend diff --git a/R/map_layout.R b/R/map_layout.R index eeab209..299f860 100644 --- a/R/map_layout.R +++ b/R/map_layout.R @@ -14,10 +14,8 @@ #' on the map. #' @param map #' An optional \code{\link[sp]{SpatialPolygons}} or -#' \code{\link[sp]{SpatialPolygonsDataFrame}} object. See \code{\link[spMaps]{getSpMaps}} +#' \code{\link[sp]{SpatialPolygonsDataFrame}} object. #' -#' @param map_builder \code{logical} Add inputs for build custom map ? Defaut to TRUE. -#' #' @return #' An object of class \code{mapLayout}. #' @@ -28,353 +26,179 @@ #' layout <- readLayout() #' ml <- mapLayout(layout) #' -#' # visualize mapLayout -#' plotMapLayout(ml) -#' #' # Save the result for future use #' save(ml, file = "ml.rda") -#' #' } #' #' @export -#' @import spMaps -#' -#' @seealso \code{\link{plotMapLayout}} -mapLayout <- function(layout, what = c("areas", "districts"), map = getSpMaps(), map_builder = TRUE) { - +#' +mapLayout <- function(layout, what = c("areas", "districts"), map = NULL) { what <- match.arg(what) - ui <- fluidPage( - changeCoordsUI("ml", map_builder = map_builder) - ) - - server <- function(input, output, session) { - callModule(changeCoordsServer, "ml", reactive(layout), what = reactive(what), - map = reactive(map), map_builder = map_builder, stopApp = TRUE) + if (what == "areas") { + coords <- copy(layout$areas) + info <- coords$area + links <- copy(layout$links) + } else { + coords <- copy(layout$districts) + info <- coords$district + links <- copy(layout$districtLinks) } - mapCoords <- shiny::runApp(shiny::shinyApp(ui = ui, server = server)) + links$x0 <- as.numeric(links$x0) + links$x1 <- as.numeric(links$x1) + links$y0 <- as.numeric(links$y0) + links$y1 <- as.numeric(links$y1) - mapCoords -} - -#' Visualize mapLayout output. -#' -#' @param mapLayout -#' object returned by function \code{\link{mapLayout}} -#' -#' @examples -#' -#' \dontrun{ -#' # Read the coordinates of the areas in the Antares interface, then convert it -#' # in a map layout. -#' layout <- readLayout() -#' ml <- mapLayout(layout) -#' -#' # visualize mapLayout -#' plotMapLayout(ml) -#' -#' } -#' -#' @export -#' -#' @seealso \code{\link{mapLayout}} -plotMapLayout <- function(mapLayout){ + mapCoords <- changeCoords(coords$x, coords$y, coords$color, info, map) + coords$x <- sp::coordinates(mapCoords)[, 1] + coords$y <- sp::coordinates(mapCoords)[, 2] - if(!is.null(mapLayout$all_coords)){ - coords <- data.frame(mapLayout$all_coords) - colnames(coords) <- gsub("^x$", "lon", colnames(coords)) - colnames(coords) <- gsub("^y$", "lat", colnames(coords)) - coords$info <- coords$area - } else if(is.null(mapLayout$all_coords)){ - coords <- data.frame(mapLayout$coords) - colnames(coords) <- gsub("^x$", "lon", colnames(coords)) - colnames(coords) <- gsub("^y$", "lat", colnames(coords)) - coords$info <- coords$area + if (what == "areas") { + links[coords, `:=`(x0 = x, y0 = y),on=c(from = "area")] + links[coords, `:=`(x1 = x, y1 = y),on=c(to = "area")] } else { - stop("No coordinates found in layout") + links[coords, `:=`(x0 = x, y0 = y),on=c(fromDistrict = "district")] + links[coords, `:=`(x1 = x, y1 = y),on=c(toDistrict = "district")] } - leafletDragPoints(coords, map = mapLayout$map, init = TRUE, draggable = FALSE) + if (!is.null(map)) { + coords$geoAreaId <- mapCoords$geoAreaId + coords <- coords[!is.na(coords$geoAreaId),] + + map <- map[coords$geoAreaId,] + } + + res <- list(coords = coords, links = links, map = map) + class(res) <- "mapLayout" + attr(res, "type") <- what + res } -# changeCoords Module UI function -changeCoordsUI <- function(id, map_builder = TRUE) { - # Create a namespace function using the provided id - ns <- NS(id) - - ref_map_table <- spMaps::getEuropeReferenceTable() - choices_map <- c("all", ref_map_table$code) - names(choices_map) <- c("all", ref_map_table$name) - - tagList( - fluidRow( - column(5, - if(map_builder){ - selectInput(ns("ml_countries"), "Countries : ", width = "100%", - choices = choices_map, selected = "all", multiple = TRUE) - } - ), - column(5, - if(map_builder){ - selectInput(ns("ml_states"), "States : ", width = "100%", - choices = choices_map, selected = NULL, multiple = TRUE) - } - ), - column(2, - if(map_builder){ - div(br(), actionButton(ns("set_map_ml"), "Set map"), align = "center") - } - ) - ), - fluidRow( - column(2, - div(br(), actionButton(ns("reset_ml"), "Re-Init layout"), align = "center") - - ), - column(width = 8, div(h3("Map Layout"), align = "center")), - column(2, - conditionalPanel( - condition = paste0("output['", ns("control_state"), "'] >= 2"), - div(br(), actionButton(ns("done"), "Done"), align = "center") - ) +#' Modify coordinates interactively +#' +#' This function helps to correct the coordinates of a set of spatial points by +#' creating an interactive map. Moreover, the function can be used to visually +#' associate points with polygons from a \code{\link[sp]{SpatialPolygons}} or +#' \code{\link[sp]{SpatialPolygonsDataFrame}} object. +#' +#' @param lon +#' Longitude of the points (x-axis) +#' @param lat +#' Latitude of the points (y-axis) +#' @param col +#' Vector of colors +#' @param info +#' A character vector that is displayed when one clicks on a marker. This helps +#' identify the points on the map. +#' @param map +#' A \code{\link[sp]{SpatialPolygons}} or +#' \code{\link[sp]{SpatialPolygonsDataFrame}} object +#' +#' @return +#' An object of class \code{\link[sp]{SpatialPoints}}. If parameter \code{map} +#' has been provided then the function returns a +#' \code{\link[sp]{SpatialPointsDataFrame}} with a column geoAreaId containing +#' the number of the polygon a point belongs to. +#' +#' @noRd +#' +changeCoords <- function(lon, lat, col = "blue", info = paste(lon, ",", lat), map = NULL) { + + points <- data.frame(lon = lon, lat = lat, oldLon = lon, oldLat = lat, + color = col, info = as.character(info), + stringsAsFactors = FALSE) + + # Find the bottom-left most and top right-most points + avgCoord <- rowMeans(points[, c("lon", "lat")]) + pt1 <- which.min(avgCoord) + pt2 <- which.max(avgCoord) + + # Keep a copy of the initial coordinates + points$oldLon <- points$lon + points$oldLat <- points$lat + + ui <- miniPage( + gadgetTitleBar("My Gadget"), + miniContentPanel( + fillRow( + flex = c(NA, 1), + tags$div( + style = "width:200px;", + tags$p(textOutput("order")), + htmlOutput("info"), + conditionalPanel( + condition = "input.state < 2", + imageOutput("preview", height="150px"), + tags$p(), + actionButton("state", "Next") + ) + ), + leafletDragPointsOutput("map", height = "100%") ) - ), - - hr(), - - fillRow( - flex = c(NA, 1), - tags$div( - style = "width:200px;", - tags$p(textOutput(ns("order"))), - htmlOutput(ns("info")), - conditionalPanel( - condition = paste0("output['", ns("control_state"), "'] < 2"), - imageOutput(ns("preview"), height="150px"), - tags$p(), - actionButton(ns("state"), "Next") - ) - ), - leafletDragPointsOutput(ns("map"), height = "700px") ) ) -} - -# changeCoords Module SERVER function -changeCoordsServer <- function(input, output, session, - layout, what = reactive("areas"), - map = reactive(NULL), map_builder = TRUE, stopApp = FALSE){ - - ns <- session$ns - - lfDragPoints <- reactiveValues(map = NULL, init = FALSE) - - current_state <- reactiveValues(state = -1) - output$control_state <- reactive({ - current_state$state - }) - - outputOptions(output, "control_state", suspendWhenHidden = FALSE) - - current_map <- reactive({ - if(!map_builder){ - map() - } else { - if(!is.null(map()) & input$set_map_ml == 0){ - map() - } else { - getSpMaps(countries = isolate(input$ml_countries), states = isolate(input$ml_states)) - } - } - }) - - data <- reactive({ - input$reset_ml - if(!is.null(layout())){ - if (what() == "areas") { - coords <- copy(layout()$areas) - info <- coords$area - links <- copy(layout()$links) - } else { - coords <- copy(layout()$districts) - info <- coords$district - links <- copy(layout()$districtLinks) - } - - links$x0 <- as.numeric(links$x0) - links$x1 <- as.numeric(links$x1) - links$y0 <- as.numeric(links$y0) - links$y1 <- as.numeric(links$y1) - - current_state$state <- 0 - - list(coords = coords, info = info, links = links) - } else { - NULL - } - }) - - data_points <- reactiveValues() - - observe({ - if(!is.null(data())){ - cur_points <- data.frame(lon = data()$coords$x, lat = data()$coords$y, - oldLon = data()$coords$x, oldLat = data()$coords$y, - color = data()$coords$color, info = as.character(data()$info), stringsAsFactors = FALSE) - isolate({ - data_points$points <- cur_points - - avgCoord <- rowMeans(data_points$points[, c("lon", "lat")]) - pt1 <- which.min(avgCoord) - pt2 <- which.max(avgCoord) - - data_points$points$lon[pt1] <- data_points$points$lat[pt1] <- 0 - - data_points$pt1 <- pt1 - data_points$pt2 <- pt2 - - }) - } - }) renderPreview <- function(pt) { renderPlot({ - points <- isolate(data_points$points) - if(!is.null(points)){ - col <- rep("#cccccc", nrow(points)) - col[pt] <- "red" - cex <- rep(1, nrow(points)) - cex[pt] <- 2 - par (mar = rep(0.1, 4)) - plot(points$oldLon, points$oldLat, bty = "n", xaxt = "n", yaxt = "n", - xlab = "", ylab = "", main = "", col = col, asp = 1, pch = 19, cex = cex) - } + col <- rep("#cccccc", nrow(points)) + col[pt] <- "red" + cex <- rep(1, nrow(points)) + cex[pt] <- 2 + par (mar = rep(0.1, 4)) + plot(points$oldLon, points$oldLat, bty = "n", xaxt = "n", yaxt = "n", + xlab = "", ylab = "", main = "", col = col, asp = 1, pch = 19, cex = cex) }) } - observeEvent(input$state, { - if(input$state > 0){ - current_state$state <- current_state$state + 1 - } - }) - - observeEvent(input$reset_ml, { - if(input$state >= 0){ - current_state$state <- 0 - } - }) - - observe({ - if (current_state$state == 0) { - lfDragPoints$map <- leafletDragPoints(data_points$points[data_points$pt1, ], isolate(current_map()), init = TRUE) - } - }) - - observe({ - if (current_state$state == 1) { - lfDragPoints$map <- leafletDragPoints(data_points$points[data_points$pt2, ]) - } - }) - - observe({ - if (current_state$state == 2) { - lfDragPoints$map <- leafletDragPoints(data_points$points[-c(data_points$pt1, data_points$pt2), ]) - } - }) - - observe({ - if(!is.null(input$map_init)){ - if(input$map_init){ - lfDragPoints$map <- leafletDragPoints(NULL, current_map(), reset_map = TRUE) - } - } - }) - - # Initialize outputs - output$map <- renderLeafletDragPoints({lfDragPoints$map}) - - coords <- reactive({ - coords <- matrix(input[[paste0("map", "_coords")]], ncol = 2, byrow = TRUE) - colnames(coords) <- c("lat", "lon") - as.data.frame(coords) - }) - - observe({ - if (current_state$state == 0) { - output$order <- renderText("Please place the following point on the map.") - output$info <- renderUI(HTML(data_points$points$info[data_points$pt1])) - output$preview <- renderPreview(data_points$pt1) - } else if (current_state$state == 1) { - isolate({ - data_points$points$lat[data_points$pt2] <- input[[paste0("map", "_mapcenter")]]$lat - data_points$points$lon[data_points$pt2] <- input[[paste0("map", "_mapcenter")]]$lng - output$info <- renderUI(HTML(data_points$points$info[data_points$pt2])) - output$preview <- renderPreview(data_points$pt2) - }) - } else if (current_state$state == 2) { - isolate({ - data_points$points <- .changeCoordinates(data_points$points, coords(), c(data_points$pt1, data_points$pt2)) - output$order <- renderText("Drag the markers on the map to adjust coordinates then click the 'Done' button") - output$info <- renderUI(HTML("

You can click on a marker to display information about the corresponding point.

")) - - }) - } - }) - - # get coord - cur_coords <- reactiveValues(data = NULL) - - # When the Done button is clicked, return a value - observeEvent(input$done, { - coords <- sp::SpatialPoints(coords()[, c("lon", "lat")], - proj4string = sp::CRS("+proj=longlat +datum=WGS84")) - map <- current_map() - if (!is.null(map)) { - map <- sp::spTransform(map, sp::CRS("+proj=longlat +datum=WGS84")) - map$geoAreaId <- 1:length(map) - coords$geoAreaId <- sp::over(coords, map)$geoAreaId - } - - # Put coords in right order - ord <- order(c(data_points$pt1, data_points$pt2, (1:length(coords))[-c(data_points$pt1, data_points$pt2)])) - mapCoords <- coords[ord,] - - final_coords <- data()$coords - final_links <- data()$links + server <- function(input, output, session) { + # Initialize outputs + points$lon[pt1] <- points$lat[pt1] <- 0 + output$map <- renderLeafletDragPoints({leafletDragPoints(points[pt1, ], map)}) + output$order <- renderText("Please place the following point on the map.") + output$info <- renderUI(HTML(points$info[pt1])) + output$preview <- renderPreview(pt1) - final_coords$x <- sp::coordinates(mapCoords)[, 1] - final_coords$y <- sp::coordinates(mapCoords)[, 2] + coords <- reactive({ + coords <- matrix(input$map_coords, ncol = 2, byrow = TRUE) + colnames(coords) <- c("lat", "lon") + as.data.frame(coords) + }) - if (what() == "areas") { - final_links[final_coords, `:=`(x0 = x, y0 = y),on=c(from = "area")] - final_links[final_coords, `:=`(x1 = x, y1 = y),on=c(to = "area")] - } else { - final_links[final_coords, `:=`(x0 = x, y0 = y),on=c(fromDistrict = "district")] - final_links[final_coords, `:=`(x1 = x, y1 = y),on=c(toDistrict = "district")] - } + observeEvent(input$state, { + if (input$state == 1) { + points$lat[pt2] <- input$map_mapcenter$lat + points$lon[pt2] <- input$map_mapcenter$lng + output$map <- renderLeafletDragPoints({leafletDragPoints(points[pt2, ])}) + output$info <- renderUI(HTML(points$info[pt2])) + output$preview <- renderPreview(pt2) + } else if (input$state == 2) { + points <- .changeCoordinates(points, coords(), c(pt1, pt2)) + output$map <- renderLeafletDragPoints({leafletDragPoints(points[-c(pt1, pt2), ])}) + output$order <- renderText("Drag the markers on the map to adjust coordinates then click the 'Done' button") + output$info <- renderUI(HTML("

You can click on a marker to display information about the corresponding point.

")) + } + }) - if (!is.null(map)) { - final_coords$geoAreaId <- mapCoords$geoAreaId - final_coords_map <- final_coords[!is.na(final_coords$geoAreaId),] - map <- map[final_coords_map$geoAreaId,] + # When the Done button is clicked, return a value + observeEvent(input$done, { + coords <- sp::SpatialPoints(coords()[, c("lon", "lat")], + proj4string = sp::CRS("+proj=longlat +datum=WGS84")) + if (!is.null(map)) { + map <- sp::spTransform(map, sp::CRS("+proj=longlat +datum=WGS84")) + map$geoAreaId <- 1:length(map) + coords$geoAreaId <- sp::over(coords, map)$geoAreaId + } - res <- list(coords = final_coords_map, links = final_links, map = map, all_coords = final_coords) - } else { - res <- list(coords = final_coords, links = final_links, map = map, all_coords = final_coords) - } - - class(res) <- "mapLayout" - attr(res, "type") <- what() - - cur_coords$data <- res - - if(stopApp){ - stopApp(res) - } - }) + # Put coords in right order + ord <- order(c(pt1, pt2, (1:length(coords))[-c(pt1, pt2)])) + coords <- coords[ord,] + + stopApp(coords) + }) + } - return(reactive(cur_coords$data)) + runGadget(ui, server, viewer = browserViewer()) } .changeCoordinates <- function(points, coords, pts = 1:nrow(points)) { @@ -438,8 +262,6 @@ changeCoordsServer <- function(input, output, session, #' be stored in a variable and modified with package #' \code{\link[leaflet]{leaflet}} #' -#' @method plot mapLayout -#' #' @examples #' \dontrun{ #' # Read the coordinates of the areas in the Antares interface, then convert it @@ -495,9 +317,7 @@ plot.mapLayout <- function(x, colAreas = x$coords$color, dataAreas = 1, } # Add custom elements - if(is.function(preprocess)){ - map <- preprocess(map) - } + map <- preprocess(map) # Add links if (links) { @@ -510,18 +330,17 @@ plot.mapLayout <- function(x, colAreas = x$coords$color, dataAreas = 1, if (areas) { areaChartType <- match.arg(areaChartType) - - # fix bug if set map wihout any intersection with areas...! - map <- tryCatch(addMinicharts(map, lng = x$coords$x, lat = x$coords$y, - chartdata = dataAreas, fillColor = colAreas, - showLabels = !is.null(labelArea), - labelText = labelArea, - width = areaMaxSize, - height = areaMaxHeight, - layerId = x$coords$area, - opacity = opacityArea, - labelMinSize = labelMinSize, - labelMaxSize = labelMaxSize), error = function(e) map) + + map <- addMinicharts(map, lng = x$coords$x, lat = x$coords$y, + chartdata = dataAreas, fillColor = colAreas, + showLabels = !is.null(labelArea), + labelText = labelArea, + width = areaMaxSize, + height = areaMaxHeight, + layerId = x$coords$area, + opacity = opacityArea, + labelMinSize = labelMinSize, + labelMaxSize = labelMaxSize) } diff --git a/R/mod_XY.R b/R/mod_XY.R deleted file mode 100644 index 4780ca4..0000000 --- a/R/mod_XY.R +++ /dev/null @@ -1,110 +0,0 @@ -# Copyright © 2016 RTE Réseau de transport d’électricité - -#' Make X-Y bockey plot, interactive version -#' -#' @param x optsH5 or list of optsH5 -#' @param xyCompare -#' Use when you compare studies, can be "union" or "intersect". If union, all -#' of mcYears in one of studies will be selectable. If intersect, only mcYears in all -#' studies will be selectable. -#' -#' -#' @examples -#' \dontrun{ -#' opts <- setSimulationPath("h5File") -#' modXY(opts) -#' modXY(list(opts, opts)) -#' -#' } -#' -#' @export -modXY <- function(x, xyCompare = c("union","intersect")) -{ - #remove notes - x_in <- timeSteph5 <- allVar <- NULL - transformFunction <- x_tranform <- dateRange <- variableX <- variableY <- paramsH5 <- mcYearh <- sharerequest <- NULL - compareOptions <- .compOpts(x, NULL) - compare <- NULL - if(compareOptions$ncharts>1)compare<-"" - xyCompare <- match.arg(xyCompare) - manipulateWidget( - { - transform <- NULL - if(transformFunction == "log"){ - transform <- log - } - dt <- list() - bock <- list() - if(!is.null(x_tranform[[.id]])) - { - try(plotXY(.selectByRange(x_tranform[[.id]], dateRange), - x = variableX,y = variableY, transform = transform), silent = TRUE) - } - }, - x = mwSharedValue({x}), - x_in = mwSharedValue({ - .giveListFormat(x) - }), - paramsH5 = mwSharedValue({ - paramsH5List <- .h5ParamList(X_I = x_in, xyCompare = xyCompare) - rhdf5::H5close() - paramsH5List - }), - H5request = mwGroup( - timeSteph5 = mwSelect(choices = paramsH5$timeStepS, - value = paramsH5$timeStepS[1], - label = "timeStep", - multiple = FALSE), - tables = mwSelect(choices = paramsH5[["tabl"]], - value = { - if(.initial) {paramsH5[["tabl"]]} else {NULL} - }, - label = "table", multiple = TRUE), - mcYearh = mwSelect(choices = c(paramsH5[["mcYearS"]]), - value = { - if(.initial){paramsH5[["mcYearS"]][1]}else{NULL} - }, - label = "mcYear", multiple = TRUE), - .display = {any(unlist(lapply(x_in, .isSimOpts)))} - ), - sharerequest = mwSharedValue({ - list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearh, tables_l = tables) - }), - x_tranform = mwSharedValue({ - sapply(1:length(x_in),function(zz){ - dta <- mergeAllAntaresData(.loadH5Data(sharerequest, x_in[[zz]])) - dta$timeId <- .timeIdToDate(dta$timeId, timeSteph5, x_in[[zz]]) - dta - }, simplify = FALSE) - - }), - transformFunction = mwSelect(c("None", "log")), - allVar = mwSharedValue({.compareOperation( - {var = lapply(x_tranform, function(X){names(X)[unlist(lapply(X, class)%in%c("numeric", "integer"))]}) - var} - , xyCompare)}), - variableX = mwSelect(choices = { - variableY - allVar - }), - variableY = mwSelect(choices = allVar[!allVar%in%variableX]), - dateRange = mwDateRange( - value = { - if(.initial & !is.null(x_tranform)) range(x_tranform[[1]]$timeId) - else NULL - }, - min = if(!is.null(x_tranform))range(x_tranform[[1]]$timeId)[1], - max = if(!is.null(x_tranform))range(x_tranform[[1]]$timeId)[2],label = "Daterange" - ), - .compare = { - compare - }, - .compareOpts = { - compareOptions - } - ) -} - -.selectByRange <- function(X, dateRange){ - X[timeId>=dateRange[1] & timeId<=dateRange[2]] -} diff --git a/R/mod_rpart.R b/R/mod_rpart.R deleted file mode 100644 index 4fdb34a..0000000 --- a/R/mod_rpart.R +++ /dev/null @@ -1,18 +0,0 @@ -# Copyright © 2016 RTE Réseau de transport d’électricité - -#' Make rpart from antares data -#' -#' @param data an antaresData after use of \code{\link[antaresProcessing]{mergeAllAntaresData}} -#' -#' @examples -#' \dontrun{ -#' setSimulationPath("Mystud", 1) -#' mydata <- readAntares(areas = "all", select = "OIL") -#' mydata <- mergeAllAntaresData(mydata) -#' modRpart(mydata) -#' } -#' -#' @export -modRpart <- function(data){ - visNetwork::visTreeEditor(data.frame(data)) -} \ No newline at end of file diff --git a/R/plot.R b/R/plot.R index b642240..a524da2 100644 --- a/R/plot.R +++ b/R/plot.R @@ -7,7 +7,7 @@ #' @param x #' Object of class \code{antaresData}. Alternatively, it can be a list of #' \code{antaresData} objects. In this case, one chart is created for each -#' object. Can also be opts object from h5 file or list of opts object from h5 file. +#' object. #' @param table #' Name of the table to display when \code{x} is an \code{antaresDataList} #' object. @@ -23,7 +23,6 @@ #' data, this parameter has to be the concatenation of the area name and the #' cluster name, separated by \code{" > "}. This is to prevent confusion #' when two clusters from different areas have the same name. -#' @param variable2Axe \code{character}, variables on second axis. #' @param type #' Type of plot to draw. "ts" creates a time series plot, "barplot" creates #' a barplot with one bar per element representing the average value of the @@ -52,7 +51,7 @@ #' @param aggregate #' When multiple elements are selected, should the data be aggregated. If #' "none", each element is represented separetly. If "mean" values are -#' averaged and if "sum" they are added. You can also compute mean ans sum by areas. +#' averaged and if "sum" they are added. #' @param colors #' Vector of colors #' @param ylab @@ -61,13 +60,9 @@ #' A list of parameters that control the creation of color scales. It is used #' only for heatmaps. See \code{\link{colorScaleOptions}}() for available #' parameters. -#' @param xyCompare -#' Use when you compare studies, can be "union" or "intersect". If union, all -#' of mcYears in one of studies will be selectable. If intersect, only mcYears in all -#' studies will be selectable. -#' @param highlight highlight curve when mouse over -#' @param secondAxis add second axis to graph -#' +#' +#' @param ... +#' currently unused #' @inheritParams prodStack #' #' @return @@ -84,100 +79,56 @@ #' If the input data has a annual time step, the function creates a barplot #' instead of a line chart. #' -#' compare argument can take following values : -#' \itemize{ -#' \item "mcYear" -#' \item "main" -#' \item "variable" -#' \item "type" -#' \item "confInt" -#' \item "elements" -#' \item "aggregate" -#' \item "legend" -#' \item "highlight" -#' \item "stepPlot" -#' \item "drawPoints" -#' \item "secondAxis" -#' } #' #' @examples #' \dontrun{ -#' setSimulationPath(path = path1) -#' mydata <- readAntares(areas = "all", timeStep = "hourly") -#' plot(x = mydata) +#' setSimulationPath() +#' mydata <- readAntares("all", timeStep = "monthly") +#' plot(mydata) +#' plot(mydata, "LOAD") #' #' # Plot only a few areas -#' plot(x = mydata[area %in% c("area1", "area2", "area3")]) +#' plot(mydata[area %in% c("area1", "area2", "area3")]) #' #' # If data contains detailed results, then the function adds a confidence #' # interval -#' dataDetailed <- readAntares(areas = "all", timeStep = "hourly", mcYears = 1:2) -#' plot(x = dataDetailed) +#' dataDetailed <- readAntares("all", timeStep = "monthly", synthesis = FALSE) +#' plot(dataDetailed) #' #' # If the time step is annual, the function creates a barplot instead of a #' # linechart -#' dataAnnual <- readAntares(areas = "all", timeStep = "annual") -#' plot(x = dataAnnual) +#' dataAnnual <- readAntares("all", timeStep = "Annual") +#' plot(dataAnnual) #' -#' # Compare two simulaitons #' # Compare the results of two simulations #' setSimulationPath(path1) -#' mydata1 <- readAntares(areas = "all", timeStep = "daily") +#' mydata1 <- readAntares("all", timeStep = "daily") #' setSimulationPath(path2) -#' mydata2 <- readAntares(areas = "all", timeStep = "daily") -#' -#' plot(x = list(mydata1, mydata2)) +#' mydata2 <- readAntares("all", timeStep = "daily") #' -#' # When you compare studies, you have 2 ways to defind inputs, union or intersect. -#' # for example, if you chose union and you have mcYears 1 and 2 in the first study -#' # and mcYears 2 and 3 in the second, mcYear input will be worth c(1, 2, 3) -#' # In same initial condition (study 1 -> 1,2 ans study 2 -> 2, 3) if you choose intersect, -#' # mcYear input will be wort 2. -#' # You must specify union or intersect with xyCompare argument (default union). -#' plot(x = list(mydata1[area %in% c("a", "b")], -#' mydata1[area %in% c("b", "c")]), xyCompare = "union") -#' plot(x = list(mydata1[area %in% c("a", "b")], -#' mydata1[area %in% c("b", "c")]), xyCompare = "intersect") +#' plot(mydata1, mydata2) #' -#' # Compare data in a single simulation #' # Compare two periods for the same simulation -#' plot(x = mydata1, compare = "dateRange") +#' plot(mydata1, compare = "dateRange") #' #' # Compare two Monte-Carlo scenarios -#' detailedData <- readAntares(areas = "all", mcYears = "all") -#' plot(x = detailedData, .compare = "mcYear") -#' -#' # Use h5 for dynamic request / exploration in a study -#' # Set path of simulaiton -#' setSimulationPath(path = path1) -#' -#' # Convert your study in h5 format -#' writeAntaresH5(path = mynewpath) -#' -#' # Redefine sim path with h5 file -#' opts <- setSimulationPath(path = mynewpath) -#' plot(x = opts) -#' -#' # Compare elements in a single study -#' plot(x = opts, .compare = "mcYear") -#' # Compare 2 studies -#' plot(x = list(opts, opts2)) +#' detailedData <- readAntares("all", mcYears = "all") +#' plot(detailedData[mcYear == 1], detailedData[mcYear == 2]) #' +#' # To do the same thing, with antaresDataList objects, one can use 'subset' +#' detailedData <- readAntares(areas = "all" links = "all", mcYears = "all") +#' plot(subset(detailedData, mcYears = 1), subset(detailedData, mcYears = 2)) #' } #' -#' -#' -#' #' @export -tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL, - variable2Axe = NULL, +tsPlot <- function(x, y = NULL, table = NULL, variable = NULL, elements = NULL, mcYear = "average", type = c("ts", "barplot", "monotone", "density", "cdf", "heatmap"), dateRange = NULL, confInt = 0, minValue = NULL, maxValue = NULL, - aggregate = c("none", "mean", "sum", "mean by areas", "sum by areas"), + aggregate = c("none", "mean", "sum"), compare = NULL, compareOpts = list(), interactive = getInteractivity(), @@ -187,51 +138,12 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL, legend = TRUE, legendItemsPerRow = 5, colorScaleOpts = colorScaleOptions(20), - width = NULL, height = NULL, xyCompare = c("union","intersect"), - h5requestFiltering = list(), highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, - secondAxis = FALSE, - timeSteph5 = "hourly", - mcYearh5 = NULL, - tablesh5 = c("areas", "links"),...) { - + width = NULL, height = NULL, ...) { - if(!is.null(compare) && !interactive){ - stop("You can't use compare in no interactive mode") - } - - #Check compare - .validCompare(compare, c("mcYear", "main", "variable", "type", "confInt", "elements", "aggregate", "legend", - "highlight", "stepPlot", "drawPoints", "secondAxis")) - - if(is.list(compare)){ - if("secondAxis" %in% names(compare)){ - compare <- c(compare, list(variable2Axe = NULL)) - } - } else if(is.vector(compare)){ - if("secondAxis" %in% compare){ - compare <- c(compare, "variable2Axe") - } - } - - xyCompare <- match.arg(xyCompare) type <- match.arg(type) aggregate <- match.arg(aggregate) colorScaleOpts <- do.call(colorScaleOptions, colorScaleOpts) - init_elements <- elements - init_dateRange <- dateRange - - if(!is.null(compare) && "list" %in% class(x)){ - if(length(x) == 1) x <- list(x[[1]], x[[1]]) - } - if(!is.null(compare) && ("antaresData" %in% class(x) | "simOptions" %in% class(x))){ - x <- list(x, x) - } - # .testXclassAndInteractive(x, interactive) - - h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x) - - # Generate a group number for dygraph objects if (!("dateRange" %in% compare)) { group <- sample(1e9, 1) @@ -239,443 +151,188 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL, group <- NULL } - compareOptions <- .compOpts(x, compare) - if(is.null(compare)){ - if(compareOptions$ncharts > 1){ - compare <- list() + # Preprocess data for comparison + tmp <- .getDataForComp(x, y, compare, compareOpts) + x <- tmp$x + compare <- tmp$compare + compareOpts <- tmp$compareOpts + + timeStep <- attr(x[[1]], "timeStep") + opts <- simOptions(x[[1]]) + + .prepareParams <- function(x) { + idCols <- .idCols(x) + + dt <- x[, .( + timeId = timeId, + time = .timeIdToDate(timeId, timeStep, simOptions(x)), + value = 0) + ] + + if ("cluster" %in% idCols) { + dt$element <- paste(x$area, x$cluster, sep = " > ") + } else if ("district" %in% idCols) { + dt$element <- x$district + } else if ("link" %in% idCols) { + dt$element <- x$link + } else if ("area" %in% idCols) { + dt$element <- x$area + } else stop("No Id column") + + if ("mcYear" %in% names(x) && length(unique(x$mcYear)) > 1) { + dt$mcYear <- x$mcYear } + + dataDateRange <- as.Date(range(dt$time)) + if (is.null(dateRange) || length(dateRange) < 2) dateRange <- dataDateRange + + uniqueElem <- sort(as.character(unique(dt$element))) + if (is.null(elements)) { + elements <- uniqueElem + if (length(elements) > 5) elements <- elements[1:5] + } + + list( + dt = dt, + idCols = idCols, + valueCols = setdiff(names(x), idCols), + showConfInt = !is.null(x$mcYear) && length(unique(x$mcYear) > 1), + dataDateRange = dataDateRange, + dateRange = dateRange, + uniqueElem = uniqueElem, + uniqueMcYears = unique(x$mcYear), + elements = elements + ) } + + params <- lapply(x, function(o) lapply(o, .prepareParams)) - processFun <- function(x, elements = NULL, dateRange = NULL) { - assert_that(inherits(x, "antaresData")) - x <- as.antaresDataList(x) + # Function that generates the desired graphic. + plotFun <- function(table, mcYear, id, variable, elements, type, confInt, dateRange, + minValue, maxValue, aggregate, legend) { - lapply(x, function(x) { - idCols <- .idCols(x) - valueCols <- setdiff(names(x), idCols) - timeStep <- attr(x, "timeStep") - opts <- simOptions(x) - - dt <- x[, .( - timeId = timeId, - time = .timeIdToDate(timeId, attr(x, "timeStep"), simOptions(x)), - value = 0) - ] - - if ("cluster" %in% idCols) { - dt$element <- paste(x$area, x$cluster, sep = " > ") - } else if ("district" %in% idCols) { - dt$element <- x$district - } else if ("link" %in% idCols) { - dt$element <- x$link - } else if ("area" %in% idCols) { - dt$element <- x$area - } else stop("No Id column") - - if ("mcYear" %in% names(x)) { - dt$mcYear <- x$mcYear - } - - dataDateRange <- as.Date(range(dt$time)) - if (is.null(dateRange) || length(dateRange) < 2) dateRange <- dataDateRange - - uniqueElem <- sort(as.character(unique(dt$element))) - if (is.null(elements)) { - elements <- uniqueElem - # if (length(elements) > 5) elements <- elements[1:5] - } - - # Function that generates the desired graphic. - plotFun <- function(mcYear, id, variable, variable2Axe, elements, type, confInt, dateRange, - minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main) { - if (is.null(variable)) variable <- valueCols[1] - if (is.null(dateRange)) dateRange <- dateRange - if (is.null(type) || !variable %in% names(x)) { - return(combineWidgets()) - } - if(variable[1] == "No Input") {return(combineWidgets("No data"))} - dt <- .getTSData( - x, dt, - variable = c(variable, variable2Axe), elements = elements, - uniqueElement = uniqueElem, - mcYear = mcYear, dateRange = dateRange, aggregate = aggregate - ) - - if (nrow(dt) == 0) return(combineWidgets("No data")) - - if(type == "ts"){ - if(!is.null(dateRange)) - { - if(dt$time[1] > dateRange[1]){ - dt <- dt[c(NA, 1:nrow(dt))] - dt$time[1] <- dateRange[1] - } - nrowTp <- nrow(dt) - if(dt$time[nrowTp] < dateRange[2]){ - dt <- dt[c(1:nrow(dt), NA)] - dt$time[nrowTp + 1] <- dateRange[2] - } - } - - } - - f <- switch(type, - "ts" = .plotTS, - "barplot" = .barplot, - "monotone" = .plotMonotone, - "density" = .density, - "cdf" = .cdf, - "heatmap" = .heatmap, - stop("Invalid type") - ) - - variable2Axe <- apply(expand.grid(elements, variable2Axe), 1, function(X){paste(X, collapse = " __ ")}) - - - f( - dt, - timeStep = timeStep, - variable = variable, - variable2Axe = variable2Axe, - confInt = confInt, - minValue = minValue, - maxValue = maxValue, - colors = colors, - main = main, - ylab = if(length(ylab) == 1) ylab else ylab[id], - legend = legend, - legendItemsPerRow = legendItemsPerRow, - width = width, - height = height, - opts = opts, - colorScaleOpts = colorScaleOpts, - group = group, - highlight = highlight, - stepPlot = stepPlot, - drawPoints = drawPoints - ) - + if (is.null(variable)) variable <- params[[id]][[table]]$valueCols[1] + if (is.null(dateRange)) dateRange <- params[[id]][[table]]$dateRange + if (is.null(type) || is.null(table) || !variable %in% names(x[[id]][[table]])) { + return(combineWidgets()) + } + if (length(elements) == 0) { + return(combineWidgets("Choose at least one element")) + } + + dt <- params[[id]][[table]]$dt + dt$value <- x[[id]][[table]][, get(variable)] + + if (!is.null(mcYear) && mcYear != "average") { + mcy <- mcYear # Just to avoid name confusion in the next line + dt <- dt[mcYear == mcy] + } + + if (length(elements) == 0) { + elements <- params[[id]][[table]]$uniqueElem[1:5] + } + if (!"all" %in% elements) dt <- dt[element %in% elements] + dt <- dt[as.Date(time) %between% dateRange] + + if (nrow(dt) == 0) return(combineWidgets()) + + if (aggregate != "none" && length(params[[id]][[table]]$uniqueElem) > 1) { + if (aggregate == "mean") { + dt <- dt[, .(element = as.factor(variable), value = mean(value)), + by = c(.idCols(dt))] + } else if (aggregate == "sum") { + dt <- dt[, .(element = as.factor(variable), value = sum(value)), + by = c(.idCols(dt))] } - list( - plotFun = plotFun, - dt = dt, - x = x, - idCols = idCols, - valueCols = valueCols, - showConfInt = !is.null(x$mcYear) && length(unique(x$mcYear) > 1), - dataDateRange = dataDateRange, - dateRange = dateRange, - uniqueElem = uniqueElem, - uniqueMcYears = unique(x$mcYear), - elements = elements, - timeStep = timeStep, - opts = opts - ) - }) + } + + f <- switch(type, + "ts" = .plotTS, + "barplot" = .barplot, + "monotone" = .plotMonotone, + "density" = .density, + "cdf" = .cdf, + "heatmap" = .heatmap, + stop("Invalid type") + ) + f( + dt, + timeStep = timeStep, + variable = variable, + confInt = confInt, + minValue = minValue, + maxValue = maxValue, + colors = colors, + main = if(length(main) == 1) main else main[id], + ylab = if(length(ylab) == 1) ylab else ylab[id], + legend = legend, + legendItemsPerRow = legendItemsPerRow, + width = width, + height = height, + opts = opts, + colorScaleOpts = colorScaleOpts, + group = group + ) + } + if (is.null(table)) table <- names(params[[1]])[1] + if (is.null(mcYear)) mcYear <- "average" # If not in interactive mode, generate a simple graphic, else create a GUI # to interactively explore the data if (!interactive) { - - - x <- .cleanH5(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering) - params <- .transformDataForComp(.giveListFormat(x), compare, compareOpts, - processFun = processFun, - elements = elements, dateRange = dateRange) - - # paramCoe <- .testParamsConsistency(params = params, mcYear = mcYear) - # mcYear <- paramCoe$mcYear - if (is.null(table)) table <- names(params$x[[1]])[1] - if (is.null(mcYear)) mcYear <- "average" - L_w <- lapply(params$x, function(X){ - X[[table]]$plotFun(mcYear, 1, variable, variable2Axe, elements, type, confInt, dateRange, - minValue, maxValue, aggregate, legend, highlight, stepPlot, drawPoints, main) - }) - return(combineWidgets(list = L_w)) - + return(plotFun(table, mcYear, 1, variable, elements, type, confInt, dateRange, + minValue, maxValue, aggregate, legend)) } typeChoices <- c("time series" = "ts", "barplot", "monotone", "density", "cdf", "heatmap") - ##remove notes - table <- NULL - x_in <- NULL - paramsH5 <- NULL - timeSteph5 <- NULL - mcYearH5 <- NULL - sharerequest <- NULL - timeStepdataload <- NULL - x_tranform <- NULL - - manipulateWidget({ - .tryCloseH5() - if(.id <= length(params$x)){ - - if(length(variable) == 0){return(combineWidgets(paste0("Please select some variables")))} - - if(length(elements) == 0){return(combineWidgets(paste0("Please select some elements")))} - - if(length(params[["x"]][[max(1,.id)]]) == 0){return(combineWidgets(paste0("No data")))} - - if(is.null(params[["x"]][[max(1,.id)]][[table]])){return(combineWidgets(paste0("Table ", table, " not exists in this study")))} - - if(!secondAxis){ - variable2Axe <- NULL - } else { - aggregate <- "none" - } - widget <- params[["x"]][[max(1,.id)]][[table]]$plotFun(mcYear, .id, variable, variable2Axe, elements, type, confInt, - dateRange, minValue, maxValue, aggregate, legend, - highlight, stepPlot, drawPoints, main) - controlWidgetSize(widget) - } else { - combineWidgets("No data for this selection") - } - }, - x = mwSharedValue({x}), - - # #Output - # outPutGraph = mwSharedValue({ - # ls() - # }), - - - x_in = mwSharedValue({ - .giveListFormat(x) - }), - - h5requestFiltering = mwSharedValue({h5requestFiltering}), - - paramsH5 = mwSharedValue({ - .h5ParamList(X_I = x_in, xyCompare = xyCompare, h5requestFilter = h5requestFiltering) - }), - - - H5request = mwGroup( - timeSteph5 = mwSelect(choices = paramsH5$timeStepS, - value = paramsH5$timeStepS[1], - label = "timeStep", - multiple = FALSE + manipulateWidget( + plotFun(table, mcYear, .id, variable, elements, type, confInt, dateRange, minValue, + maxValue, aggregate, legend), + + table = mwSelect(names(params[[.id]]), value = table, .display = length(params[[.id]]) > 1), + mcYear = mwSelect( + choices = c("average", params[[.id]][[table]]$uniqueMcYears) , + mcYear, + .display = params[[.id]][[table]]$showConfInt ), - tables = mwSelect(choices = paramsH5[["tabl"]], - value = { - if(.initial) {paramsH5[["tabl"]][1]}else{NULL} - }, - label = "table", multiple = TRUE + variable = mwSelect( + choices = params[[.id]][[table]]$valueCols, + value = variable ), - mcYearH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]), - value = { - if(.initial){paramsH5[["mcYearS"]][1]}else{NULL} - }, - label = "mcYear", multiple = TRUE + type = mwSelect( + choices = { + if (timeStep == "annual") "barplot" + else if (timeStep %in% c("hourly", "daily")) typeChoices + else typeChoices[1:5] + }, + value = type, + .display = timeStep != "annual" ), - .display = { - any(unlist(lapply(x_in, .isSimOpts))) - }), - - sharerequest = mwSharedValue({ - list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = tables) - }), - - x_tranform = mwSharedValue({ - dataInApp <- sapply(1:length(x_in),function(zz){ - .loadH5Data(sharerequest, x_in[[zz]], h5requestFilter = paramsH5$h5requestFilter[[zz]]) - }, simplify = FALSE) - dataInApp - }), - - table = mwSelect( - { - if(!is.null(params)){ - out <- as.character(.compareOperation( - lapply(params$x, function(vv){ - unique(names(vv)) - }), xyCompare)) - if(length(out) > 0){out}else{"No Input"} - } - }, - value = { - if(.initial) table - else NULL - }, .display = length(as.character(.compareOperation( - lapply(params$x, function(vv){ - unique(names(vv)) - }), xyCompare))) > 1 - ), - - mcYear = mwSelect( - choices = { - c("average", if(!is.null(params)){ - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv[[table]]$uniqueMcYears) - }), xyCompare)) - }) - }, - value = { - if(.initial) "average" - else NULL - }, multiple = FALSE - ), - - variable = mwSelect( - choices = { - if(!is.null(params)){ - out <- as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv[[table]]$valueCols) - }), xyCompare)) - if(length(out) > 0){out} else {"No Input"} - } - }, - value = { - if(.initial) 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){ - unique(vv[[table]]$valueCols) - }), xyCompare)) - out <- out[!out%in%variable] - if(length(out) > 0){out} else {"No Input"} - } - }, - value = { - if(.initial) NULL - else NULL - }, multiple = TRUE, .display = secondAxis - ), - type = mwSelect( - choices = { - if (timeStepdataload == "annual") "barplot" - else if (timeStepdataload %in% c("hourly", "daily")) typeChoices - else typeChoices[1:5] - }, - value = { - if(.initial) type - else NULL - }, - .display = timeStepdataload != "annual" - ), - - dateRange = mwDateRange(value = { - if(.initial){ - res <- NULL - if(!is.null(params) & ! is.null(table)){ - res <- c(.dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table), - .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table)) - if(any(is.infinite(c(res)))) - {res <- NULL} - } - ##Lock 7 days for hourly data - if(!is.null(params$x[[1]][[table]]$timeStep)) - { - if(params$x[[1]][[table]]$timeStep == "hourly"){ - if(params$x[[1]][[table]]$dateRange[2] - params$x[[1]][[table]]$dateRange[1]>7){ - res[1] <- params$x[[1]][[table]]$dateRange[2] - 7 - } - } - - } - - res - }else{NULL} - }, - min = { - if(!is.null(params) & ! is.null(table)){ - R <- .dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table) - if(is.infinite(R)){NULL}else{R} - } - }, - max = { - if(!is.null(params) & ! is.null(table)){ - R <- .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table) - if(is.infinite(R)){NULL}else{R} - } - }, - .display = timeStepdataload != "annual" - ), - - confInt = mwSlider(0, 1, confInt, step = 0.01, - label = "confidence interval", - .display = params$x[[max(1,.id)]][[table]]$showConfInt & mcYear == "average" - ), - - minValue = mwNumeric(minValue, "min value", - .display = type %in% c("density", "cdf") - ), - - maxValue = mwNumeric(maxValue, "max value", - .display = type %in% c("density", "cdf") - ), - - elements = mwSelect( - choices = { - c( if(!is.null(params)){ - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv[[table]]$uniqueElem) - }), xyCompare)) - }) - }, - value = { - if(.initial) {as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv[[table]]$uniqueElem) - }), xyCompare))[1]} - }, - multiple = TRUE - ), - - aggregate = mwSelect(c("none", "mean", "sum", "mean by areas", "sum by areas"), - value ={ - if(.initial) aggregate - else NULL - }, .display = !secondAxis - ), - - legend = mwCheckbox(legend, .display = type %in% c("ts", "density", "cdf")), - highlight = mwCheckbox(highlight), - stepPlot = mwCheckbox(stepPlot), - drawPoints = mwCheckbox(drawPoints), - timeStepdataload = mwSharedValue({ - attributes(x_tranform[[1]])$timeStep - }), - - main = mwText(main, label = "title"), - - params = mwSharedValue({ - .transformDataForComp(x_tranform, compare, compareOpts, processFun = processFun, - elements = init_elements, dateRange = init_dateRange) - }), - - .compare = { - compare - }, - .compareOpts = { - compareOptions - }, - ... + dateRange = mwDateRange( + value = params[[1]][[table]]$dateRange, + min = params[[.id]][[table]]$dataDateRange[1], + max = params[[.id]][[table]]$dataDateRange[2], + .display = timeStep != "annual" + ), + confInt = mwSlider(0, 1, confInt, step = 0.01, label = "confidence interval", + .display = params[[.id]][[table]]$showConfInt & mcYear == "average"), + minValue = mwNumeric(minValue, "min value", .display = type %in% c("density", "cdf")), + maxValue = mwNumeric(maxValue, "max value", .display = type %in% c("density", "cdf")), + elements = mwSelect( + choices = c("all", params[[.id]][[table]]$uniqueElem), + value = elements, + multiple = TRUE + ), + aggregate = mwSelect(c("none", "mean", "sum"), aggregate), + legend = mwCheckbox(legend, .display = type %in% c("ts", "density", "cdf")), + .compare = compare, + .compareOpts = compareOpts ) + } - #' @export #' @rdname tsPlot -#' @method plot antaresData plot.antaresData <- tsPlot - -#' @export -#' @rdname tsPlot -#' @method plot simOptions -plot.simOptions <- tsPlot - -#' @export -#' @rdname tsPlot -#' @method plot list -plot.list <- tsPlot - diff --git a/R/plot_XY.R b/R/plot_XY.R deleted file mode 100644 index e002895..0000000 --- a/R/plot_XY.R +++ /dev/null @@ -1,49 +0,0 @@ -# Copyright © 2016 RTE Réseau de transport d’électricité - -#' Plot density between X et Y with rbokeh -#' -#' This function take somes arguments from rbokeh and make plot. -#' -#' @param data \code{data.frame} can be antaresData object -#' @param x \code{character}, x variable -#' @param y \code{character}, y variable -#' @param precision \code{numeric} precision for plot -#' @param sizeOnCount \code{boolean}, should addapt size of object based on count -#' @param outLine \code{boolean}, add outline on your shape -#' @param transform \code{funciton}, transform function apply on count (by cells), can be log -#' -#' @examples -#' \dontrun{ -#' -#' setSimulationPath("myStudy") -#' myData <- readAntares() -#' -#' plotXY(myData, "NODU", "LOAD", precision = 50, -#' sizeOnCount = FALSE) -#' -#' myData <- readAntares(areas = "all", links = "all") -#' myData <- mergeAllAntaresData(myData) -#' plotXY(myData, "OP. COST_max_b", "OP. COST_max_c", precision = 50, -#' sizeOnCount = FALSE) -#' -#' -#' } -#' -#' @export -plotXY <- function(data, x, y, precision = 30, sizeOnCount = FALSE, outLine = TRUE, - transform = NULL) -{ - if(!requireNamespace("rbokeh")){ - stop("You should install 'rbokeh' library") - } - if(!"data.frame"%in%class(data)){ - stop("data should be a data.frame") - } - - suppressWarnings(p <- rbokeh::figure() %>% - rbokeh::ly_hexbin(x, y, data, xbins = precision, - style = ifelse(sizeOnCount,"lattice", "colorramp"), - palette = c("Spectral10"), line = !outLine, trans = transform)) - - p -} diff --git a/R/plot_barplot.R b/R/plot_barplot.R index d62e8a5..0a9d731 100644 --- a/R/plot_barplot.R +++ b/R/plot_barplot.R @@ -4,7 +4,7 @@ #' value over time steps. #' #' @noRd -#' +#' .barplot <- function(dt, timeStep, variable, confInt = 0, maxValue, colors = NULL, main = NULL, @@ -32,13 +32,11 @@ dt <- dt[, .getConfInt(value), by = .(element)] } } - # print(dt) - 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)) main <- paste("Comparison of", variable) - g <- plot_ly(dt, textfont = list(color = '#000000')) %>% + g <- plot_ly(dt) %>% config(displayModeBar = FALSE) %>% layout(title = main, yaxis = list(title = ylab)) @@ -56,8 +54,6 @@ ) ) } - g <- g %>% add_text(x = ~element, y = ~value, text = ~round(value, 2))%>% - layout(showlegend = FALSE) combineWidgets(g, width = width, height = height) } diff --git a/R/plot_heatmap.R b/R/plot_heatmap.R index 76fcc2d..b5aee77 100644 --- a/R/plot_heatmap.R +++ b/R/plot_heatmap.R @@ -108,7 +108,6 @@ res } - variable <- paste0(variable, collapse = " ; ") if (is.null(ylab)) ylab <- variable plot_ly(x) %>% config(displayModeBar = FALSE) %>% diff --git a/R/plot_stats.R b/R/plot_stats.R index 1e29415..355e08a 100644 --- a/R/plot_stats.R +++ b/R/plot_stats.R @@ -1,5 +1,5 @@ -.plotMonotone <- function(dt, timeStep, variable, variable2Axe = NULL, confInt = NULL, maxValue, - main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) { +.plotMonotone <- function(dt, timeStep, variable, confInt = NULL, maxValue, + main = NULL, ylab = NULL, ...) { uniqueElements <- sort(unique(dt$element)) plotConfInt <- FALSE @@ -29,17 +29,15 @@ } } - 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)) main <- paste("Monotone of", variable) - .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, variable2Axe = variable2Axe, - highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, ...) + .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, ...) } -.density <- function(dt, timeStep, variable, variable2Axe = NULL, minValue = NULL, maxValue = NULL, - main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) { +.density <- function(dt, timeStep, variable, minValue = NULL, maxValue = NULL, + main = NULL, ylab = NULL, ...) { uniqueElements <- sort(unique(dt$element)) @@ -53,17 +51,15 @@ 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(main)) main <- paste("Density of", variable) - .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements,variable2Axe = variable2Axe, - highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints,...) + .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, ...) } -.cdf <- function(dt, timeStep, variable, variable2Axe = NULL, minValue = NULL, maxValue = NULL, - main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) { +.cdf <- function(dt, timeStep, variable, minValue = NULL, maxValue = NULL, + main = NULL, ylab = NULL, ...) { uniqueElements <- sort(unique(dt$element)) @@ -76,12 +72,10 @@ 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(main)) main <- paste("Cumulated distribution of", variable) - .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, variable2Axe = variable2Axe, - highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, ...) + .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, ...) } @@ -113,8 +107,7 @@ .plotStat <- function(dt, ylab, main, colors, uniqueElements, legend, legendItemsPerRow, width, height, - plotConfInt = FALSE, highlight = FALSE, - stepPlot = FALSE, drawPoints = FALSE,variable2Axe = NULL, ...) { + plotConfInt = FALSE, ...) { dt <- dcast(dt, x ~ element, value.var = "y") if (is.null(colors)) { @@ -131,9 +124,7 @@ gridLineColor = gray(0.8), axisLineColor = gray(0.6), axisLabelColor = gray(0.6), - labelsKMB = TRUE, - stepPlot = stepPlot, - drawPoints = drawPoints + labelsKMB = TRUE ) %>% dyAxis("y", label = ylab, pixelsPerLabel = 60) %>% dyLegend(show = "never") %>% @@ -142,31 +133,9 @@ unhighlightCallback = JS_resetLegend(legendId) ) - - if(length(variable2Axe)>0){ - for( i in variable2Axe) - { - g <- g %>% dySeries(i, axis = 'y2') - } - } - - - if(highlight) - { - g <- g %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) - } - if (plotConfInt) { for (v in uniqueElements) { - axis = NULL - if(length(variable2Axe)>0) - { - if(v%in%variable2Axe) - { - axis <- "y2" - } - } - g <- g %>% dySeries(paste0(v, c("_l", "", "_u")), axis = axis) + g <- g %>% dySeries(paste0(v, c("_l", "", "_u"))) } } diff --git a/R/plot_thermal_group_capacities.R b/R/plot_thermal_group_capacities.R deleted file mode 100644 index 9b3cc60..0000000 --- a/R/plot_thermal_group_capacities.R +++ /dev/null @@ -1,29 +0,0 @@ -#' Plot for Thermal Group Capacities -#' -#' @param data data.table of Thermal Group capacities -#' @param area areas to select, default all -#' @param main title -#' -#' @examples -#' \dontrun{ -#' opts <- setSimulationPath(getwd()) -#' plotThermalGroupCapacities( thermalGroupCapacities(opts)) -#' } -#' -#' @export -plotThermalGroupCapacities <- function(data, area = 'all', main = "Thermal group capacities"){ - if(area != 'all'){ - areaTp <- area - data <- data[area %in% areaTp] - } - data <- data.table::dcast(data, area~group, value.var = "thermalGroupCapacity") - data <- data[,lapply(.SD, function(X){X[is.na(X)] <- 0;X}), .SDcols = 1:ncol(data)] - toPLot <- names(data)[names(data)!="area"] - p <- plot_ly(data, type = 'bar') %>% - layout(title = main, yaxis = list(title = 'MWh'), barmode = 'stack') - for(i in toPLot){ - p <- p %>% add_trace(x = ~area,y = as.formula(paste0("~`", i, "`")), name = i) - } - suppressWarnings(print(p)) -} - diff --git a/R/plot_ts.R b/R/plot_ts.R index ec47cba..1525485 100644 --- a/R/plot_ts.R +++ b/R/plot_ts.R @@ -16,15 +16,14 @@ #' #' @noRd #' -.plotTS <- function(dt, timeStep, variable, variable2Axe = NULL, confInt = 0, maxValue, +.plotTS <- function(dt, timeStep, variable, confInt = 0, maxValue, colors = NULL, main = NULL, ylab = NULL, legend = TRUE, legendItemsPerRow = 5, group = NULL, - width = NULL, height = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, ...) { - + width = NULL, height = NULL, ...) { uniqueElements <- sort(unique(dt$element)) plotConfInt <- FALSE @@ -50,16 +49,8 @@ dt <- dcast(dt, time ~ element, value.var = "value") # Graphical parameters - if(length(uniqueElements)> 1) - { - variable <- paste0(uniqueElements, collapse = " ; ") - }else{ - variable <- paste0(uniqueElements, " - ", variable) - - } - if (is.null(ylab)) ylab <- variable - if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Evolution of", variable) + if (is.null(main)) main <- paste("Evolution of", variable) if (is.null(colors)) { colors <- substring(rainbow(length(uniqueElements), s = 0.7, v = 0.7), 1, 7) } else { @@ -76,9 +67,7 @@ axisLabelColor = gray(0.6), labelsKMB = TRUE, colors = colors, - useDataTimezone = TRUE, - stepPlot = stepPlot, - drawPoints = drawPoints + useDataTimezone = TRUE ) %>% dyAxis("x", rangePad = 10) %>% dyAxis("y", label = ylab, pixelsPerLabel = 60, rangePad = 10) %>% @@ -88,30 +77,10 @@ highlightCallback = JS_updateLegend(legendId, timeStep), unhighlightCallback = JS_resetLegend(legendId) ) - if(length(variable2Axe)>0){ - for( i in variable2Axe) - { - g <- g %>% dySeries(i, axis = 'y2') - } - } - - - if(highlight) - { - g <- g %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) - } if (plotConfInt) { for (v in uniqueElements) { - axis = NULL - if(length(variable2Axe)>0) - { - if(v%in%variable2Axe) - { - axis <- "y2" - } - } - g <- g %>% dySeries(paste0(v, c("_l", "", "_u")), axis = axis) + g <- g %>% dySeries(paste0(v, c("_l", "", "_u"))) } } diff --git a/R/plot_utils.R b/R/plot_utils.R deleted file mode 100644 index 4d84a65..0000000 --- a/R/plot_utils.R +++ /dev/null @@ -1,134 +0,0 @@ -#' Return a table representing a time series. -#' -#' @param x a table of class antaresDataTable -#' @param tpl template of a time series. It must contain columns element, timeId, -#' time, value and eventually column mcYear -#' @param variable name of one column in x -#' @param uniqueElement a vector containing the unique elements present in x. -#' @param mcYear Monte-Carlo year to keep -#' @param dateRange a vector of two dates -#' @param aggregate type of aggregation to perform -#' -#' @return A table containing the same columns as tpl: element, timeId, -#' time, value and eventually column mcYear -#' -#' @noRd -.getTSData <- function(x, tpl, variable, elements, - uniqueElement = unique(tpl$element), - mcYear = NULL, - dateRange = NULL, aggregate = c("none", "mean", "sum", "mean by areas", "sum by areas")) { - - if(length(variable) == 0){return(tpl[0])} - if("all" %in% elements) elements <- uniqueElement - aggregate <- match.arg(aggregate) - assert_that(inherits(x, "data.table")) - assert_that(inherits(tpl, "data.table")) - assert_that(are_equal(nrow(x), nrow(tpl))) - assert_that(all(sapply(variable, is.string))) - - variable <- variable[variable%in%names(x)] - if (!is.null(dateRange)) assert_that(are_equal(length(dateRange), 2)) - - listVar <- sapply(variable, function(V){ - tpl$value <- x[,.SD, .SDcols = V] - tpl - }, simplify = FALSE) - if(length(listVar) > 1){ - sapply(names(listVar), function(N){ - listVar[[N]][,element := paste(element, '__' , N)] - }) - tpl <- rbindlist(listVar) - elements <- as.vector(sapply(elements, function(X){paste(X, "__", variable)})) - }else{ - tpl <- listVar[[1]] - } - - # Filtering data if required - if (!is.null(mcYear) && mcYear != "average") { - mcy <- mcYear # Just to avoid name confusion in the next line - tpl <- tpl[mcYear %in% mcy] - }else{ - if(!"mcYear" %in% names(tpl)) - if(mcYear != "average") - { - .printWarningMcYear() - } - } - - # if (length(elements) == 0) elements <- uniqueElement[1:5] - if (!"all" %in% elements) tpl <- tpl[element %in% elements] - if (!is.null(dateRange)) tpl <- tpl[as.Date(time) %between% dateRange] - - # Aggregating values - if (aggregate != "none" && length(uniqueElement) > 1) { - if (aggregate == "mean") { - if(length(variable) == 1){ - tpl <- tpl[, .(element = as.factor(variable), value = mean(value)), - by = c(.idCols(tpl))] - }else{ - tpl <- tpl[, .(element = as.factor("Mean"), value = mean(value)), - by = c(.idCols(tpl))] - } - - } else if (aggregate == "sum") { - - if(length(variable) == 1){ - tpl <- tpl[, .(element = as.factor(variable), value = sum(value)), - by = c(.idCols(tpl))] - }else{ - tpl <- tpl[, .(element = as.factor("Sum"), value = sum(value)), - by = c(.idCols(tpl))] - } - } else if (aggregate == "mean by areas"){ - - tpl$areas <- unlist(lapply(strsplit(tpl$element, "__"),function(X) X[1])) - tpl$element <- unlist(lapply(strsplit(tpl$element, "__"),function(X) X[2])) - - tpl <- tpl[, .(value = mean(value)), - by = c(.idCols(tpl), "element")] - } else if (aggregate == "sum by areas"){ - - tpl$areas <- unlist(lapply(strsplit(tpl$element, "__"),function(X) X[1])) - tpl$element <- unlist(lapply(strsplit(tpl$element, "__"),function(X) X[2])) - - tpl <- tpl[, .(value = sum(value)), - by = c(.idCols(tpl), "element")] - } - } - - tpl -} - -.printWarningMcYear <- function(){ - warning("You have mc-all data and you specify mcYear, it will be ignored") -} - - -.cleanH5 <- function(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering) -{ - share <- list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearh5, tables_l = tablesh5) - x <- .giveListFormat(x) - x <- sapply(1:length(x),function(zz){ - .loadH5Data(share, x[[zz]], h5requestFilter = h5requestFiltering[[zz]]) - }, simplify = FALSE) - x -} - - -.validCompare <- function(compare, values){ - if(!is.null(compare)){ - if(is.list(compare)){ - compare_values <- names(compare) - } else if(is.vector(compare)){ - compare_values <- compare - } else { - stop("'compare' must be a vector or a named list") - } - if(!all(compare_values %in% values)){ - invalid <- compare_values[!compare_values %in% values] - stop(paste0("Invalid arguments for 'compare' : '", paste0(invalid, collapse = "', '"), - "'. Possible values : '", paste0(values, collapse = "', '"), "'.")) - } - } - invisible(TRUE) -} \ No newline at end of file diff --git a/R/runApp.R b/R/runApp.R deleted file mode 100644 index b2c8ef5..0000000 --- a/R/runApp.R +++ /dev/null @@ -1,16 +0,0 @@ -#' Run app antaresViz -#' -#' \code{runAppAntaresViz} run antaresViz App. -#' -#' @return -#' an App Shiny. -#' -#' @importFrom shiny runApp -#' @export -runAppAntaresViz <- function() { - ctrl <- shiny::runApp(system.file("application", package = "antaresViz") , launch.browser = TRUE) - suppressWarnings(try(rm(list = c("directoryInput", "readDirectoryInput", - "updateDirectoryInput"), envir = .GlobalEnv), silent = TRUE)) - gc(reset = TRUE) - invisible(TRUE) -} \ No newline at end of file diff --git a/R/stack.R b/R/stack.R index 7c32b1b..92e6916 100644 --- a/R/stack.R +++ b/R/stack.R @@ -43,7 +43,7 @@ #' @noRd .plotStack <- function(x, timeStep, opts, colors, lines = NULL, lineColors = NULL, legendId = "", groupId = legendId, main = "", ylab = "", - width = NULL, height = NULL, dateRange = NULL, stepPlot = FALSE, drawPoints = FALSE) { + width = NULL, height = NULL) { variables <- setdiff(names(x), c("timeId", lines)) @@ -84,21 +84,6 @@ dt$totalNeg <- dt$totalNeg + negValues } - ##Add first and last row of not in range - if(!is.null(dateRange)) - { - if(dt$time[1] > dateRange[1]){ - dt <- dt[c(NA, 1:nrow(dt))] - dt$time[1] <- dateRange[1] - } - nrowTp <- nrow(dt) - - if(dt$time[nrowTp] < dateRange[2]){ - dt <- dt[c(1:nrow(dt), NA)] - dt$time[nrowTp + 1] <- dateRange[2] - } - } - # 5- Finally plot !! colors <- unname(c("#FFFFFF", rev(colors), colors)) @@ -112,12 +97,10 @@ axisLineColor = gray(0.6), axisLabelColor = gray(0.6), strokeWidth = 0, - useDataTimezone = TRUE , - stepPlot = stepPlot, - drawPoints = drawPoints + useDataTimezone = TRUE ) %>% dyAxis("x", rangePad = 10) %>% - dyAxis("y", label = ylab, rangePad = 10, pixelsPerLabel = 50, valueRange = c(min(dt$totalNeg, na.rm = TRUE) * 1.1, NA)) %>% + dyAxis("y", label = ylab, rangePad = 10, pixelsPerLabel = 50, valueRange = c(min(dt$totalNeg) * 1.1, NA)) %>% dyLegend(show = "never") %>% dyCallbacks( highlightCallback = JS_updateLegend(legendId, timeStep), diff --git a/R/stack_exchanges.R b/R/stack_exchanges.R index cedae9e..1e40952 100644 --- a/R/stack_exchanges.R +++ b/R/stack_exchanges.R @@ -21,97 +21,30 @@ #' A htmlwidget of class \code{dygraph}. It can be modified with functions from #' package \code{dygraphs}. #' -#' -#' @details -#' Compare argument can take following values : -#' \itemize{ -#' \item "mcYear" -#' \item "main" -#' \item "unit" -#' \item "area" -#' \item "legend" -#' \item "stepPlot" -#' \item "drawPoints" -#' } -#' #' @examples #' \dontrun{ #' mydata <- readAntares(links = "all", timeStep = "daily") -#' exchangesStack(mydata) +#' exchangeStack(mydata) #' #' # Also display exchanges with the rest of the world #' mydata <- readAntares(areas = "all", links = "all", timeStep = "daily") #' exchangesStack(mydata) -#' -#' # Use compare : -#' exchangesStack(mydata, compare = "mcYear") -#' exchangesStack(mydata, compare = "area") -#' exchangesStack(mydata, compare = "unit") -#' exchangesStack(mydata, compare = "legend") -#' #' } #' #' @export -exchangesStack <- function(x, area = NULL, mcYear = "average", +exchangesStack <- function(x, y = NULL, area = NULL, mcYear = "average", dateRange = NULL, colors = NULL, main = NULL, ylab = NULL, unit = c("MWh", "GWh", "TWh"), compare = NULL, compareOpts = list(), interactive = getInteractivity(), legend = TRUE, legendId = sample(1e9, 1), groupId = legendId, legendItemsPerRow = 5, - width = NULL, height = NULL, - xyCompare = c("union","intersect"), - h5requestFiltering = list(), - stepPlot = FALSE, drawPoints = FALSE, - timeSteph5 = "hourly", - mcYearh5 = NULL, - tablesh5 = c("areas", "links"), ...) { - - - if(!is.null(compare) && !interactive){ - stop("You can't use compare in no interactive mode") - } - + width = NULL, height = NULL) { - - #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 - - if(!is.null(compare) && "list" %in% class(x)){ - if(length(x) == 1) x <- list(x[[1]], x[[1]]) - } - if(!is.null(compare) && ("antaresData" %in% class(x) | "simOptions" %in% class(x))){ - x <- list(x, x) - } - # .testXclassAndInteractive(x, interactive) - - - h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x) - - # Generate a group number for dygraph objects - if (!("dateRange" %in% compare)) { - group <- sample(1e9, 1) - } else { - group <- NULL - } - - compareOptions <- .compOpts(x, compare) - if(is.null(compare)){ - if(compareOptions$ncharts > 1){ - compare <- list() - } - } - - processFun <- function(x) { + params <- .getDataForComp(x, y, compare, compareOpts, function(x) { if (!is(x, "antaresData")) stop("'x' should be an object of class 'antaresData created with readAntares()'") row <- NULL # exchanges with rest of the world @@ -129,6 +62,7 @@ exchangesStack <- function(x, area = NULL, mcYear = "average", row <- x$areas[, .(area, link = paste(area, " - ROW"), timeId, flow = - `ROW BAL.`, to = "ROW", direction = 1)] } + } x <- x$links } @@ -140,15 +74,15 @@ exchangesStack <- function(x, area = NULL, mcYear = "average", opts <- simOptions(x) dataDateRange <- as.Date(.timeIdToDate(range(x$timeId), timeStep, opts)) - if (length(init_dateRange) < 2) init_dateRange <- dataDateRange + if (length(dateRange) < 2) dateRange <- dataDateRange linksDef <- getLinks(namesOnly = FALSE, withDirection = TRUE, opts = opts) linksDef <- linksDef[link %in% x$link] areaList <- linksDef[, unique(area)] - if (is.null(init_area)) init_area = areaList[1] + if (is.null(area)) area = areaList[1] - plotFun <- function(id, area, dateRange, unit, mcYear, legend, stepPlot, drawPoints, main) { + plotFun <- function(id, area, dateRange, unit, mcYear, legend) { # Prepare data for stack creation a <- area linksDef <- getLinks(area, opts = simOptions(x), namesOnly = FALSE, @@ -163,25 +97,21 @@ exchangesStack <- function(x, area = NULL, mcYear = "average", mcy <- mcYear dt <- dt[mcYear == mcy] 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.`)], - linksDef, by = "link") + linksDef, + by = "link") if (!is.null(row)) { row <- row[as.Date(.timeIdToDate(timeId, timeStep, simOptions(x))) %between% dateRange] dt <- rbind(dt, row[area == a]) } dt[, flow := flow * direction / switch(unit, MWh = 1, GWh = 1e3, TWh = 1e6)] - if(nrow(dt) == 0){return(combineWidgets("No data"))} - dt <- dcast(dt, timeId ~ to, value.var = "flow") # Graphical parameters - if (is.null(main) | isTRUE(all.equal("", main))) main <- paste("Flows from/to", area) + if (is.null(main)) main <- paste("Flows from/to", area) if (is.null(ylab)) ylab <- sprintf("Flows (%s)", unit) if (is.null(colors)) { colors <- substring(rainbow(ncol(dt) - 1, s = 0.7, v = 0.7), 1, 7) @@ -192,7 +122,7 @@ exchangesStack <- function(x, area = NULL, mcYear = "average", # 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) if (legend) { # Add a nice legend @@ -201,186 +131,37 @@ exchangesStack <- function(x, area = NULL, mcYear = "average", legendId = legendId + id - 1) } else legend <- NULL + combineWidgets(g, footer = legend, width = width, height = height) + } list( plotFun = plotFun, areaList = areaList, - area = init_area, + area = area, dataDateRange = dataDateRange, - dateRange = init_dateRange, + dateRange = dateRange, displayMcYear = displayMcYear, x = x ) - } - - if (!interactive) { - x <- .cleanH5(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering) - - params <- .getDataForComp(.giveListFormat(x), NULL, compare, compareOpts, processFun = processFun) - L_w <- lapply(params$x, function(X){ - X$plotFun(1, X$area, X$dateRange, unit, mcYear, legend, stepPlot, drawPoints, main) - }) - return(combineWidgets(list = L_w)) - - - } - - table <- NULL - - ##remove notes - mcYearH5 <- NULL - paramsH5 <- NULL - sharerequest <- NULL - timeStepdataload <- NULL - timeSteph5 <- NULL - x_in <- NULL - x_tranform <- NULL + }) + if (!interactive) return(params$x[[1]]$plotFun(1, params$x[[1]]$area, params$x[[1]]$dateRange, unit, mcYear, legend)) manipulateWidget( - { - .tryCloseH5() - if(.id <= length(params$x)){ - widget <- params$x[[max(1,.id)]]$plotFun(.id, area, dateRange, unit, mcYear, legend, stepPlot, drawPoints, main) - controlWidgetSize(widget) - } else { - combineWidgets("No data for this selection") - } - }, - x = mwSharedValue(x), - h5requestFiltering = mwSharedValue({h5requestFiltering}), - - x_in = mwSharedValue({ - .giveListFormat(x) - }), - - paramsH5 = mwSharedValue({ - .h5ParamList(X_I = x_in, xyCompare = xyCompare, h5requestFilter = h5requestFiltering) - }), - - H5request = mwGroup( - timeSteph5 = mwSelect(choices = paramsH5$timeStepS, - value = paramsH5$timeStepS[1], - label = "timeStep", - multiple = FALSE - ), - 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))) - } - ), - - sharerequest = mwSharedValue({ - list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearH5, tables_l = NULL) - }), - - - x_tranform = mwSharedValue({ - areas = "all" - links = "all" - if(length(paramsH5$h5requestFilt[[1]]) > 0){ - areas <- NULL - links <- NULL - } - sapply(1:length(x_in),function(zz){ - .loadH5Data(sharerequest, x_in[[zz]], areas = areas, links = links, h5requestFilter = paramsH5$h5requestFilter[[zz]]) - }, simplify = FALSE) - }), - - mcYear = mwSelect({ - allMcY <- c("average", if(!is.null(params)){ - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv$x$mcYear) - }), xyCompare))}) - 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} - ), - - area = mwSelect({ - if(!is.null(params)){ - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv$areaList) - }), xyCompare))} - }, - value = { - if(.initial) area - else NULL - }), - - dateRange = mwDateRange(value = { - if(.initial){ - res <- NULL - if(!is.null(params)){ - res <- c(.dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = NULL), - .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = NULL)) - } - - ##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 - } - } - } - - res - }else{NULL} - }, - min = { - if(!is.null(params)){ - .dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = NULL) - } - }, - max = { - if(!is.null(params)){ - .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = NULL) - } - }, - .display = timeStepdataload != "annual" - ), - + params$x[[.id]]$plotFun(.id, area, dateRange, unit, mcYear, legend), + mcYear = mwSelect(c("average", unique(params$x[[.id]]$x$mcYear)), + mcYear, + .display = params$x[[.id]]$displayMcYear), + area = mwSelect(params$x[[.id]]$areaList, area), + dateRange = mwDateRange(params$x[[1]]$dateRange, + min = params$x[[.id]]$dataDateRange[1], + max = params$x[[.id]]$dataDateRange[2]), unit = mwSelect(c("MWh", "GWh", "TWh"), unit), - legend = mwCheckbox(legend), - stepPlot = mwCheckbox(stepPlot), - drawPoints = mwCheckbox(drawPoints), - timeStepdataload = mwSharedValue({ - attributes(x_tranform[[1]])$timeStep - }), - - main = mwText(main, label = "title"), - - params = mwSharedValue({ - .getDataForComp(x_tranform, NULL, compare, compareOpts, - processFun = processFun) - }), - - .compare = { - compare - }, - .compareOpts = { - compareOptions - }, - ... + .compare = params$compare, + .compareOpts = params$compareOpts ) } diff --git a/R/stack_map.R b/R/stack_map.R deleted file mode 100644 index 336cfc8..0000000 --- a/R/stack_map.R +++ /dev/null @@ -1,98 +0,0 @@ - -# Copyright © 2016 RTE Réseau de transport d’électricité - -#' plot stack and map -#' -#' -#' @param x \code{antaresDataList} antaresDataList contian areas ans links. -#' @param mapLayout -#' Object created with function \code{\link{mapLayout}} -#' -#' @examples -#' \dontrun{ -#' mydata <- readAntares(areas = "all", links = "all") -#' -#' layout <- readLayout() -#' ml <- mapLayout(layout = layout) -#' -#' stackMap(x = mydata, mapLayout = ml) -#' } -#' -#' @export -stackMap <- function(x, mapLayout) -{ - colorArea <- colorLink <- sizeArea <- dateRange <- NULL - manipulateWidget(.expr = { - ColorArea2 <- colorArea - if(is.null(ColorArea2)){ - ColorArea2 <- "none" - } - - colorLink2 <- colorLink - if(is.null(colorLink2)){ - colorLink2 <- "none" - } - - - sizeArea2 <- sizeArea - if(is.null(sizeArea2)){ - sizeArea2 <- "none" - } - combineWidgets(nrow = 1, ncol = 2, - exchangesStack(x, area = area, interactive = FALSE, dateRange = dateRange), - plotMap(x, mapLayout = mapLayout, colLinkVar = colorLink2, - colAreaVar = ColorArea2, interactive = FALSE, - dateRange = dateRange, sizeAreaVars = sizeArea2, - areaChartType = areaChartType, sizeMiniPlot = sizeMiniPlot)) - - }, - area = mwSelect(label = "area", levels(x$areas$area)), - dateRange = mwDateRange(value = { - if(attr(x, "timeStep") != "hourly") - { - ra <- range(x$areas$time) - }else{ - if(max(x$areas$time)-min(x$areas$time)>3){ - ra = c(max(x$areas$time)-3600*24*3, max(x$areas$time)) - }else{ - ra <- range(x$areas$time) - - } - } - - ra - }, - min = min(x$areas$time), max = max(x$areas$time)), - Area = mwGroup( - colorArea = mwSelect(choices = { - names(x$areas)[!names(x$areas) %in% getIdCols(x$areas)] - },value = "LOAD", label = "Color"), - - - sizeArea = mwSelect(choices = { - names(x$areas)[!names(x$areas) %in% getIdCols(x$areas)] - }, label = "Size", multiple = TRUE), - - - 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 = TRUE), - - Link = mwGroup( - colorLink = mwSelect(choices = { - names(x$links)[!names(x$links) %in% getIdCols(x$links)] - },value = "FLOW LIN.", label = "Color"), - - .display = TRUE) - ) -} diff --git a/R/stack_prod.R b/R/stack_prod.R index 2e3df4c..48dc8f8 100644 --- a/R/stack_prod.R +++ b/R/stack_prod.R @@ -9,9 +9,10 @@ #' @param x #' An object of class \code{antaresData} created with function #' \code{\link[antaresRead]{readAntares}} containing data for areas and or -#' districts. it can be a list of \code{antaresData} objects. -#' In this case, one chart is created for each object. -#' Can also contains opts who refer to a h5 file or list of opts. +#' districts. +#' @param y +#' Optional object of class \code{antaresData}. If it is specified, then two +#' charts are generated. #' @param stack #' Name of the stack to use. One can visualize available stacks with #' \code{prodStackAliases} @@ -34,8 +35,7 @@ #' An optional character vector containing names of parameters. When it is set, #' two charts are outputed with their own input controls. Alternatively, it can #' be a named list with names corresponding to parameter names and values being -#' list with the initial values of the given parameter for each chart. See details -#' if you are drawing a map. +#' list with the initial values of the given parameter for each chart. #' @param compareOpts #' List of options that indicates the number of charts to create and their #' position. Check out the documentation of @@ -84,21 +84,9 @@ #' @param description #' Description of the stack. It is displayed by function #' \code{prodStackAliases}. -#' @param xyCompare -#' Use when you compare studies, can be "union" or "intersect". If union, all -#' of mcYears in one of studies will be selectable. If intersect, only mcYears in all -#' studies will be selectable. -#' @param h5requestFiltering Contains arguments used by default for h5 request, -#' typically h5requestFiltering = list(select = "NUCLEAR") -#' @param stepPlot \code{boolean}, step style for curves. -#' @param drawPoints \code{boolean}, add points on graph -#' @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 ... Other arguments for \code{\link{manipulateWidget}} #' #' @return -#' \code{prodStack} returns an interactive html graphic. If argument +#' \code{prodStackAliases} returns an interactive html graphic. If argument #' \code{interactive} is \code{TRUE}, then a shiny gadget is started and the #' function returns an interactive html graphic when the user clicks on button #' "Done". @@ -109,27 +97,15 @@ #' #' @seealso \code{\link{prodStackLegend}} #' -#' @details -#' compare argument can take following values : -#' \itemize{ -#' \item "mcYear" -#' \item "main" -#' \item "unit" -#' \item "areas" -#' \item "legend" -#' \item "stack" -#' \item "stepPlot" -#' \item "drawPoints" -#' } #' @examples #' \dontrun{ #' mydata <- readAntares(areas = "all", timeStep = "daily") #' #' # Start a shiny gadget that permits to choose areas to display. -#' prodStack(x = mydata, unit = "GWh") +#' prodStack(mydata, unit = "GWh") #' #' # Use in a non-interactive way -#' prodStack(x = mydata, unit = "GWh", areas = "fr", interactive = FALSE) +#' prodStack(mydata, unit = "GWh", areas = "fr", interactive = FALSE) #' #' # Define a custom stack #' setProdStackAlias( @@ -138,7 +114,7 @@ #' colors = c("green", "orange") #' ) #' -#' prodStack(x = mydata, unit = "GWh", stack = "Wind and solar") +#' prodStack(mydata, unit = "GWh", stack = "Wind and solar") #' #' # In a custom stack it is possible to use computed values #' setProdStackAlias( @@ -152,46 +128,12 @@ #' lineColors = "#42EB09" #' ) #' -#' prodStack(x = mydata, unit = "GWh", stack = "renewable") -#' -#' # Use compare -#' prodStack(x = mydata, compare = "areas") -#' prodStack(x = mydata, unit = "GWh", compare = "mcYear") -#' prodStack(x = mydata, unit = "GWh", compare = "main") -#' prodStack(x = mydata, unit = "GWh", compare = "unit") -#' prodStack(x = mydata, unit = "GWh", compare = "areas") -#' prodStack(x = mydata, unit = "GWh", compare = "legend") -#' prodStack(x = mydata, unit = "GWh", compare = "stack") -#' prodStack(x = mydata, unit = "GWh", compare = c("mcYear", "areas")) -#' -#' -#' # Compare studies -#' prodStack(list(mydata, mydata)) -#' -#' -#' # Use h5 opts -#' # Set path of simulaiton -#' setSimulationPath(path = path1) -#' -#' # Convert your study in h5 format -#' writeAntaresH5(path = mynewpath) -#' -#' # Redefine sim path with h5 file -#' opts <- setSimulationPath(path = mynewpath) -#' prodStack(x = opts) -#' -#' # Compare elements in a single study -#' prodStack(x = opts, .compare = "mcYear") -#' -#' # Compare 2 studies -#' prodStack(x = list(opts, opts2)) -#' -#' +#' prodStack(mydata, unit = "GWh", stack = "renewable") #' #' } #' #' @export -prodStack <- function(x, +prodStack <- function(x, y = NULL, stack = "eco2mix", areas = NULL, mcYear = "average", @@ -203,46 +145,12 @@ prodStack <- function(x, legend = TRUE, legendId = sample(1e9, 1), groupId = legendId, legendItemsPerRow = 5, - width = NULL, height = NULL, xyCompare = c("union","intersect"), - h5requestFiltering = list(), stepPlot = FALSE, drawPoints = FALSE, - timeSteph5 = "hourly", - mcYearh5 = NULL, - tablesh5 = c("areas", "links"),...) { - - if(!is.null(compare) && !interactive){ - stop("You can't use compare in no interactive mode") - } + width = NULL, height = NULL) { - #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" - if(!is.null(compare) && "list" %in% class(x)){ - if(length(x) == 1) x <- list(x[[1]], x[[1]]) - } - if(!is.null(compare) && ("antaresData" %in% class(x) | "simOptions" %in% class(x))){ - x <- list(x, x) - } - - # .testXclassAndInteractive(x, interactive) - - h5requestFiltering <- .convertH5Filtering(h5requestFiltering = h5requestFiltering, x = x) - - compareOptions <- .compOpts(x, compare) - if(is.null(compare)){ - if(compareOptions$ncharts > 1){ - compare <- "" - } - } - - init_areas <- areas - init_dateRange <- dateRange - - processFun <- function(x) { - + params <- .getDataForComp(x, y, compare, compareOpts, function(x) { # Check that input contains area or district data if (!is(x, "antaresData")) stop("'x' should be an object of class 'antaresData created with readAntares()'") @@ -257,52 +165,40 @@ prodStack <- function(x, if (is.null(x$area)) x$area <- x$district timeStep <- attr(x, "timeStep") opts <- simOptions(x) - if (is.null(init_areas)) { - init_areas <- unique(x$area)[1] + if (is.null(areas)) { + areas <- unique(x$area)[1] } # should mcYear parameter be displayed on the UI? displayMcYear <- !attr(x, "synthesis") && length(unique(x$mcYear)) > 1 dataDateRange <- as.Date(.timeIdToDate(range(x$timeId), timeStep, opts)) - if (length(init_dateRange) < 2) init_dateRange <- dataDateRange + if (length(dateRange) < 2) dateRange <- dataDateRange - plotWithLegend <- function(id, areas, main = "", unit, stack, dateRange, mcYear, legend, stepPlot, drawPoints) { - if (length(areas) == 0) return (combineWidgets("Please choose an area")) + plotWithLegend <- function(id, areas, main = "", unit, stack, dateRange, mcYear, legend) { + if (length(areas) == 0) return ("Please choose an area") stackOpts <- .aliasToStackOptions(stack) + dt <- x[area %in% areas] if (mcYear == "average") dt <- synthesize(dt) else if ("mcYear" %in% names(dt)) { mcy <- mcYear dt <- dt[mcYear == mcy] - }else{ - .printWarningMcYear() } if (!is.null(dateRange)) { dt <- dt[as.Date(.timeIdToDate(dt$timeId, timeStep, opts = opts)) %between% dateRange] } - if(nrow(dt) == 0){ - return (combineWidgets("No data for this selection")) - } - p <- try(.plotProdStack(dt, - stackOpts$variables, - stackOpts$colors, - stackOpts$lines, - stackOpts$lineColors, - main = main, - unit = unit, - legendId = legendId + id - 1, - groupId = groupId, - dateRange = dateRange, - stepPlot = stepPlot, drawPoints = drawPoints), silent = TRUE) - - if("try-error" %in% class(p)){ - return (combineWidgets(paste0("Can't visualize stack '", stack, "'
", p[1]))) - } - + p <- .plotProdStack(dt, + stackOpts$variables, + stackOpts$colors, + stackOpts$lines, + stackOpts$lineColors, + main = main, + unit = unit, + legendId = legendId + id - 1, groupId = groupId) if (legend) { l <- prodStackLegend(stack, legendItemsPerRow, legendId = legendId + id - 1) } else { @@ -317,208 +213,34 @@ prodStack <- function(x, x = x, timeStep = timeStep, opts = opts, - areas = init_areas, + areas = areas, displayMcYear = displayMcYear, dataDateRange = dataDateRange, - dateRange = init_dateRange + dateRange = dateRange + ) - } + }) + if (!interactive) { - x <- .cleanH5(x, timeSteph5, mcYearh5, tablesh5, h5requestFiltering) - - - params <- .getDataForComp(x = .giveListFormat(x), - y = NULL, compare = compare, - compareOpts = compareOptions, - processFun = processFun) - - - - L_w <- lapply(params$x, function(X){ - X$plotWithLegend(1, areas, main, unit, - stack, params$x[[1]]$dateRange, - mcYear, legend, stepPlot, drawPoints) - }) - return(combineWidgets(list = L_w)) - - } else { - # just init for compare & compareOpts - # init_params <- .getDataForComp(x, y, compare, compareOpts, function(x) {}) + return(params$x[[1]]$plotWithLegend(1, areas, main, unit, stack, params$x[[1]]$dateRange, mcYear, legend)) } - - table <- NULL - - ##remove notes - mcYearhH5 <- NULL - paramsH5 <- NULL - sharerequest <- NULL - timeStepdataload <- NULL - timeSteph5 <- NULL - x_in <- NULL - x_tranform <- NULL - - manipulateWidget( - { - .tryCloseH5() - if(.id <= length(params$x)){ - widget <- params$x[[max(1,.id)]]$plotWithLegend(.id, areas, main, - unit, stack, dateRange, - mcYear, legend, - stepPlot, drawPoints) - controlWidgetSize(widget) - } else { - combineWidgets("No data for this selection") - } - }, - x = mwSharedValue({x}), - x_in = mwSharedValue({ - .giveListFormat(x) - }), - h5requestFiltering = mwSharedValue({ - h5requestFiltering - }), - paramsH5 = mwSharedValue({ - tmp <- .h5ParamList(X_I = x_in, xyCompare = xyCompare, - h5requestFilter = h5requestFiltering) - tmp - }), - 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", "districts")], - value = { - if(.initial) {paramsH5[["tabl"]][paramsH5[["tabl"]]%in%c("areas", "districts")][1]}else{NULL} - }, - label = "table", - multiple = FALSE - ), - mcYearhH5 = mwSelect(choices = c(paramsH5[["mcYearS"]]), - value = { - if(.initial){paramsH5[["mcYearS"]][1]}else{NULL} - }, - label = "mcYear", - multiple = TRUE - ), - .display = { - any(unlist(lapply(x_in, .isSimOpts))) - } - ), - - sharerequest = mwSharedValue({ - list(timeSteph5_l = timeSteph5, mcYearh_l = mcYearhH5, tables_l = tables) - }), - - - - x_tranform = mwSharedValue({ - - h5requestFilteringTp <- paramsH5$h5requestFilter - if(!is.null(sharerequest)) - { - for(i in 1:length(h5requestFilteringTp)) - { - if(sharerequest$tables == "areas"){ - h5requestFilteringTp[[i]]$districts = NULL - } - if(sharerequest$tables == "districts"){ - h5requestFilteringTp[[i]]$areas = NULL - } - } - } - - sapply(1:length(x_in),function(zz){ - .loadH5Data(sharerequest, x_in[[zz]], h5requestFilter = h5requestFilteringTp[[zz]]) - }, simplify = FALSE) - }), - - params = mwSharedValue({ - .getDataForComp(x_tranform, NULL, compare, - compareOpts = compareOptions, - processFun = processFun) - }), - - ##End h5 - mcYear = mwSelect({ - c("average", .compareOperation(lapply(params$x, function(vv){ - unique(vv$x$mcYear) - }), xyCompare)) - }), - + params$x[[.id]]$plotWithLegend(.id, areas, main, unit, stack, dateRange, mcYear, legend), + mcYear = mwSelect(c("average", unique(params$x[[.id]]$x$mcYear)), .display = params$x[[.id]]$displayMcYear), main = mwText(main, label = "title"), - - dateRange = mwDateRange(value = { - if(.initial){ - res <- NULL - if(!is.null(params)){ - res <- c(.dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table), - .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table)) - ##Lock 7 days for hourly data - 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} - }, - min = { - if(!is.null(params)){ - .dateRangeJoin(params = params, xyCompare = xyCompare, "min", tabl = table) - } - }, - max = { - if(!is.null(params)){ - .dateRangeJoin(params = params, xyCompare = xyCompare, "max", tabl = table) - } - } - ), - - - + dateRange = mwDateRange(params$x[[1]]$dateRange, + min = params$x[[.id]]$dataDateRange[1], + max = params$x[[.id]]$dataDateRange[2]), stack = mwSelect(names(pkgEnv$prodStackAliases), stack), - unit = mwSelect(c("MWh", "GWh", "TWh"), unit), - - areas = mwSelect({ - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv$x$area) - }), xyCompare)) - }, - value = { - if(.initial){ - as.character(.compareOperation(lapply(params$x, function(vv){ - unique(vv$x$area) - }), xyCompare))[1] - } - else{NULL}}, - multiple = TRUE - ), - + areas = mwSelect(as.character(unique(params$x[[.id]]$x$area)), areas, multiple = TRUE), legend = mwCheckbox(legend), - stepPlot = mwCheckbox(stepPlot), - drawPoints = mwCheckbox(drawPoints), - .compare = { - compare - }, - .compareOpts = { - compareOptions - }, - ... + .compare = params$compare, + .compareOpts = params$compareOpts ) } - #' Returns the variables and colors corresponding to an alias #' #' @param variables @@ -577,9 +299,9 @@ prodStack <- function(x, #' #' @noRd .plotProdStack <- function(x, variables, colors, lines, lineColors, - main = NULL, unit = "MWh", legendId = "", - groupId = legendId, - width = NULL, height = NULL, dateRange = NULL, stepPlot = FALSE, drawPoints = FALSE) { + main = NULL, unit = "MWh", legendId = "", + groupId = legendId, + width = NULL, height = NULL) { timeStep <- attr(x, "timeStep") @@ -591,17 +313,18 @@ 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, groupId, main = main, ylab = sprintf("Production (%s)", unit), - width = width, height = height, dateRange = dateRange, stepPlot = stepPlot, drawPoints = drawPoints) + width = width, height = height) } #' @rdname tsLegend #' @export prodStackLegend <- function(stack = "eco2mix", - legendItemsPerRow = 5, legendId = "") { - + legendItemsPerRow = 5, legendId = "") { + stackOpts <- .aliasToStackOptions(stack) tsLegend( @@ -612,7 +335,3 @@ prodStackLegend <- function(stack = "eco2mix", legendId = legendId ) } - - - - diff --git a/R/zzz.R b/R/zzz.R index d41efcb..df5f857 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,126 +1,109 @@ -#Copyright © 2016 RTE Réseau de transport d’électricité - -#' @import data.table -#' @import antaresRead -#' @import antaresProcessing -#' @import dygraphs -#' @import shiny -#' @import htmltools -#' @import manipulateWidget -#' @import leaflet -#' @import leaflet.minicharts -#' @import assertthat -#' @importFrom plotly plot_ly layout config add_bars add_heatmap add_text add_trace -#' @importFrom grDevices col2rgb colorRampPalette colors gray rainbow rgb -#' @importFrom graphics plot par -#' @importFrom methods is -#' @importFrom stats density quantile lm predict -#' @importFrom utils object.size -#' @importFrom stats as.formula -#' -globalVariables( - c("value", "element", "mcYear", "suffix", "time", "timeId", "dt", ".", - "x", "y", ".id", ".initial", ".session", "FLOW LIN.", "area", "direction", - "flow", "formulas", "link", ".output", "J", "ROW BAL.", "change", "to", - "wdayId", "weekId") -) - -.idCols <- antaresRead:::.idCols -.timeIdToDate <- antaresRead:::.timeIdToDate -.getTimeId <- antaresRead:::.getTimeId -.mergeByRef <- antaresRead:::.mergeByRef -.checkColumns <- antaresProcessing:::.checkColumns -.checkAttrs <- antaresProcessing:::.checkAttrs - -DEFAULT_CAT_COLORS <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd", - "#8c564b", "#e377c2", "#7f7f7f", "#bcbd22", "#17becf") - -# Private variables accessible only by functions from the package -pkgEnv <- antaresRead:::pkgEnv - -.onLoad <- function(libname, pkgname) { - setInteractivity("auto") - options(antaresVizSizeGraph = 200) -} - -# Generate the list of aliases for function prodStack() -# -# The definition of the variables used in aliases is stored in file -# "GraphicalCharter.csv" -graphicalCharter <- fread(input=system.file("GraphicalCharter.csv", package = "antaresViz")) - -formulas <- lapply(graphicalCharter$formula, function(s) parse(text = s)) -names(formulas) <- graphicalCharter$name - -colors <- graphicalCharter[, rgb(red, green, blue, maxColorValue = 255)] -names(colors) <- graphicalCharter$name - - -needed <- graphicalCharter$Needed_Col -names(needed) <- graphicalCharter$name -needed <- strsplit(needed, ",") -# Private function that generates a production stack alias, given a list of -# variable names. The variable names need to be present in file -# GraphicalCharter.csv -.getProdStackAlias <- function(description = "", var = NULL, lines = NULL) { - list( - description = description, - nedded_col = unique(unlist(needed[var])), - variables = formulas[var], - colors = unname(colors[var]), - lines = formulas[lines], - lineColors = unname(colors[lines]) - ) -} - -# List of aliases for parameter "variables" in function prodStack() -# -# Each element has five elements: -# - description: A concise description of the production stack. -# - variables: Definition of the variables to draw -# - colors: Vector of colors with same length as "variables" -# - lines: (optional) Definition of curves to draw on top of the stack -# - lineColors: Vector of colors with same length as lines. Mandatory only if -# "lines" is set -# -pkgEnv$prodStackAliases <- list( - - eco2mix = .getProdStackAlias( - description = "Production stack used on Eco2mix website: - http://www.rte-france.com/fr/eco2mix/eco2mix-mix-energetique", - var = c("pumpedStorage", "import/export", "bioenergy", "wind", "solar", - "nuclear", "hydraulic", "gas", "coal", "lignite", "oil", "other"), - lines = c("load", "totalProduction") - ), - - thermalFirst = .getProdStackAlias( - description = "thermal first", - var = c("pumpedStorage", "import/export", "nuclear", "lignite", "coal", "gas", - "oil", "mixFuel", "misc. DTG", "bioenergy", "wind", "solar", - "hydraulicRor", "hydraulicStor") - ), - - netLoad = .getProdStackAlias( - description = "netLoad", - var = c("pumpedStorage", "import/export", "nuclear", "lignite", "coal", "gas", - "oil", "mixFuel", "misc. DTG", "hydraulicStor"), - lines = c("netLoad") - ), - - mustRun = .getProdStackAlias( - description = "must-run", - var = c("pumpedStorage", "import/export", "mustRunTotal", "thermalDispatchable", - "hydraulicDispatchable", "renewableNoDispatchable") - ) -) - -rm(graphicalCharter, formulas, colors) - - -colorsVars <- fread(input=system.file("color.csv", package = "antaresViz")) -colorsVars$colors <- rgb(colorsVars$red, colorsVars$green, colorsVars$blue, maxColorValue = 255) - - -# 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 +#Copyright © 2016 RTE Réseau de transport d’électricité + +#' @import data.table +#' @import antaresRead +#' @import antaresProcessing +#' @import dygraphs +#' @import miniUI +#' @import shiny +#' @import htmltools +#' @import manipulateWidget +#' @import leaflet +#' @import leaflet.minicharts +#' @importFrom plotly plot_ly layout config add_bars add_heatmap +#' @importFrom grDevices col2rgb colorRampPalette colors gray rainbow +#' @importFrom graphics plot par +#' @importFrom methods is +#' @importFrom stats density quantile lm predict +#' +globalVariables( + c("value", "element", "mcYear", "suffix", "time", "timeId", "dt", ".", + "x", "y", ".id", ".initial", ".session", "FLOW LIN.", "area", "direction", + "flow", "formulas", "link", ".output", "J", "ROW BAL.", "change", "to", + "wdayId", "weekId") +) + +.idCols <- antaresRead:::.idCols +.timeIdToDate <- antaresRead:::.timeIdToDate +.getTimeId <- antaresRead:::.getTimeId +.mergeByRef <- antaresRead:::.mergeByRef +.checkColumns <- antaresProcessing:::.checkColumns +.checkAttrs <- antaresProcessing:::.checkAttrs + +DEFAULT_CAT_COLORS <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd", + "#8c564b", "#e377c2", "#7f7f7f", "#bcbd22", "#17becf") + +# Private variables accessible only by functions from the package +pkgEnv <- antaresRead:::pkgEnv + +.onLoad <- function(libname, pkgname) { + setInteractivity("auto") +} + +# Generate the list of aliases for function prodStack() +# +# The definition of the variables used in aliases is stored in file +# "GraphicalCharter.csv" +graphicalCharter <- fread(input=system.file("GraphicalCharter.csv", package = "antaresViz")) + +formulas <- lapply(graphicalCharter$formula, function(s) parse(text = s)) +names(formulas) <- graphicalCharter$name + +colors <- graphicalCharter[, rgb(red, green, blue, maxColorValue = 255)] +names(colors) <- graphicalCharter$name + +# Private function that generates a production stack alias, given a list of +# variable names. The variable names need to be present in file +# GraphicalCharter.csv +.getProdStackAlias <- function(description = "", var = NULL, lines = NULL) { + list( + description = description, + variables = formulas[var], + colors = unname(colors[var]), + lines = formulas[lines], + lineColors = unname(colors[lines]) + ) +} + +# List of aliases for parameter "variables" in function prodStack() +# +# Each element has five elements: +# - description: A concise description of the production stack. +# - variables: Definition of the variables to draw +# - colors: Vector of colors with same length as "variables" +# - lines: (optional) Definition of curves to draw on top of the stack +# - lineColors: Vector of colors with same length as lines. Mandatory only if +# "lines" is set +# +pkgEnv$prodStackAliases <- list( + + eco2mix = .getProdStackAlias( + description = "Production stack used on Eco2mix website: + http://www.rte-france.com/fr/eco2mix/eco2mix-mix-energetique", + var = c("pumpedStorage", "import/export", "bioenergy", "wind", "solar", + "nuclear", "hydraulic", "gas", "coal", "lignite", "oil", "other"), + lines = c("load", "totalProduction") + ), + + thermalFirst = .getProdStackAlias( + description = "thermal first", + var = c("pumpedStorage", "import/export", "nuclear", "lignite", "coal", "gas", + "oil", "mixFuel", "misc. DTG", "bioenergy", "wind", "solar", + "hydraulicRor", "hydraulicStor") + ), + + netLoad = .getProdStackAlias( + description = "netLoad", + var = c("pumpedStorage", "import/export", "nuclear", "lignite", "coal", "gas", + "oil", "mixFuel", "misc. DTG", "hydraulicStor"), + lines = c("netLoad") + ), + + mustRun = .getProdStackAlias( + description = "must-run", + var = c("pumpedStorage", "import/export", "mustRunTotal", "thermalDispatchable", + "hydraulicDispatchable", "renewableNoDispatchable") + ) +) + +rm(graphicalCharter, formulas, colors) \ No newline at end of file diff --git a/README.md b/README.md index cccd3c0..80d17f5 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/antaresViz)](https://cran.r-project.org/package=antaresViz) [![Travis-CI Build Status](https://travis-ci.org/rte-antares-rpackage/antaresViz.svg?branch=master)](https://travis-ci.org/rte-antares-rpackage/antaresViz) -[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/rte-antares-rpackage/antaresViz?branch=master&svg=true)](https://ci.appveyor.com/project/rte-antares-rpackage/antaresViz)[![codecov](https://codecov.io/gh/rte-antares-rpackage/antaresViz/branch/develop/graph/badge.svg)](https://codecov.io/gh/rte-antares-rpackage/antaresViz) +[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/rte-antares-rpackage/antaresViz?branch=master&svg=true)](https://ci.appveyor.com/project/rte-antares-rpackage/antaresViz) # The package antaresViz: visualize the results of an Antares simulation @@ -67,15 +67,10 @@ myData <- readAntares(areas = "all", links = "all") plotMap(myData, myMapLayout) ``` -You can use `spMaps` to set a map background or download some files at http://www.gadm.org/country. - ## Contributing: Contributions to the library are welcome and can be submitted in the form of pull requests to this repository. -## ANTARES : - Antares is a powerful software developed by RTE to simulate and study electric power systems (more information about Antares here : ). - ## License Information: Copyright 2015-2016 RTE (France) diff --git a/antaresViz.Rproj b/antaresViz.Rproj index df159b9..fec809a 100644 --- a/antaresViz.Rproj +++ b/antaresViz.Rproj @@ -12,8 +12,6 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX -LineEndingConversion: Posix - BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/appveyor.yml b/appveyor.yml index 4de1121..e32d316 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -14,12 +14,6 @@ install: build_script: - travis-tool.sh install_deps - - travis-tool.sh install_bioc zlibbioc - - travis-tool.sh install_bioc rhdf5 - - ./travis-tool.sh install_github rte-antares-rpackage/antaresRead@develop - - ./travis-tool.sh install_github rte-antares-rpackage/antaresProcessing@developTit - - ./travis-tool.sh install_github rte-antares-rpackage/manipulateWidget@develop - - ./travis-tool.sh install_github rte-antares-rpackage/antaresMaps test_script: - travis-tool.sh run_tests diff --git a/inst/AntaresViz.xlsx b/inst/AntaresViz.xlsx deleted file mode 100644 index 47b0150..0000000 Binary files a/inst/AntaresViz.xlsx and /dev/null differ diff --git a/inst/GraphicalCharter.csv b/inst/GraphicalCharter.csv index 19c2e20..b3a88fd 100644 --- a/inst/GraphicalCharter.csv +++ b/inst/GraphicalCharter.csv @@ -1,29 +1,29 @@ -name;red;green;blue;formula;Needed_Col -pumpedStorage;17;71;185;PSP;PSP -import/export;150;150;150;-(BALANCE + `ROW BAL.`);BALANCE,ROW BAL. -mustRunTotal;120;136;194;mustRunTotal;mustRunTotal -mustRunPartial;120;236;194;mustRunPartial;mustRunPartial -mustRun;220;236;94;mustRun;mustRun -bioenergy;22;106;87;`MISC. NDG`;MISC. NDG -wind;116;205;185;WIND;WIND -solar;242;116;6;SOLAR;SOLAR -nuclear;245;179;0;NUCLEAR;NUCLEAR -hydraulic;39;114;178;`H. ROR`+`H. STOR`;H. ROR,H. STOR -gas;243;10;10;GAS;GAS -coal;172;140;53;COAL;COAL -other;173;255;47;`MISC. DTG` + `MIX. FUEL`;MISC. DTG,MIX. FUEL -load;135;86;39;LOAD;LOAD -renewable;0;255;0;WIND+SOLAR+`H. ROR`+`H. STOR`+`MISC. NDG`;WIND,SOLAR,H. ROR,H. STOR,MISC. NDG -renewableNoDispatchable;0;255;0;WIND+SOLAR+`H. ROR`+`MISC. NDG`;WIND,SOLAR,H. ROR,MISC. NDG -thermal;77;77;77;NUCLEAR+LIGNITE+COAL+GAS+OIL+`MIX. FUEL`+`MISC. DTG`;NUCLEAR,LIGNITE,COAL,GAS,OIL,MIX. FUEL,MISC. DTG -thermalDispatchable;100;100;100;NUCLEAR+LIGNITE+COAL+GAS+OIL+`MIX. FUEL`+`MISC. DTG`;NUCLEAR,LIGNITE,COAL,GAS,OIL,MIX. FUEL,MISC. DTG -hydraulicDispatchable;39;114;178;`H. STOR`;H. STOR -lignite;180;130;43;LIGNITE;LIGNITE -oil;131;86;162;OIL;OIL -mixFuel;127;84;156;`MIX. FUEL`;MIX. FUEL -misc. DTG;173;255;47;`MISC. DTG`;MISC. DTG -hydraulicRor;61;96;125;`H. ROR`;H. ROR -hydraulicStor;84;151;208;`H. STOR`;H. STOR -totalProduction;235;155;166;NUCLEAR+LIGNITE+COAL+GAS+OIL+`MIX. FUEL`+`MISC. DTG`+WIND+SOLAR+`H. ROR`+`H. STOR`+`MISC. NDG` + pmax(0, PSP);NUCLEAR,LIGNITE,COAL,GAS,OIL,MIX. FUEL,MISC. DTG,WIND,SOLAR,H. ROR,H. STOR,MISC. NDG,PSP -netLoad;101;180;197;netLoad;netLoad -thermalAvailability;1;1;1;`AVL DTG`;AVL DTG +name red green blue formula +pumpedStorage 17 71 185 PSP +"import/export" 150 150 150 -(BALANCE + `ROW BAL.`) +mustRunTotal 120 136 194 mustRunTotal +mustRunPartial 120 236 194 mustRunPartial +mustRun 220 236 94 mustRun +bioenergy 22 106 87 `MISC. NDG` +wind 116 205 185 WIND +solar 242 116 6 SOLAR +nuclear 245 179 0 NUCLEAR +hydraulic 39 114 178 `H. ROR`+`H. STOR` +gas 243 10 10 GAS +coal 172 140 53 COAL +other 173 255 47 `MISC. DTG` + `MIX. FUEL` +load 135 86 39 LOAD +renewable 0 255 0 WIND+SOLAR+`H. ROR`+`H. STOR`+`MISC. NDG` +renewableNoDispatchable 0 255 0 WIND+SOLAR+`H. ROR`+`MISC. NDG` +thermal 77 77 77 NUCLEAR+LIGNITE+COAL+GAS+OIL+`MIX. FUEL`+`MISC. DTG` +thermalDispatchable 100 100 100 NUCLEAR+LIGNITE+COAL+GAS+OIL+`MIX. FUEL`+`MISC. DTG` +hydraulicDispatchable 39 114 178 `H. STOR` +lignite 180 130 43 LIGNITE +oil 131 86 162 OIL +mixFuel 127 84 156 `MIX. FUEL` +"misc. DTG" 173 255 47 `MISC. DTG` +hydraulicRor 61 96 125 `H. ROR` +hydraulicStor 84 151 208 `H. STOR` +totalProduction 235 155 166 NUCLEAR+LIGNITE+COAL+GAS+OIL+`MIX. FUEL`+`MISC. DTG`+WIND+SOLAR+`H. ROR`+`H. STOR`+`MISC. NDG` + pmax(0, PSP) +netLoad 101 180 197 netLoad +thermalAvailability 1 1 1 `AVL DTG` \ No newline at end of file diff --git a/inst/application/global.R b/inst/application/global.R deleted file mode 100644 index aa08f50..0000000 --- a/inst/application/global.R +++ /dev/null @@ -1,79 +0,0 @@ -require(shiny) -require(antaresRead) -require(antaresViz) -require(manipulateWidget) -require(data.table) - - -# choose a directory -source("src/scripts/directoryInput.R") - -# shared inputs -.global_shared_prodStack <- data.frame( - module = "prodStack", - panel = "prodStack", - input = c("dateRange", "unit", "mcYear", "mcYearh", "timeSteph5", "legend", "drawPoints", "stepPlot"), - type = c("dateRangeInput", "selectInput", "selectInput", "selectInput", "selectInput", - "checkboxInput", "checkboxInput", "checkboxInput"), stringsAsFactors = FALSE) - -.global_shared_plotts <- data.frame( - module = "plotts", - panel = "tsPlot", - input = c("dateRange", "mcYear", "mcYearh", "timeSteph5", "legend", "drawPoints", "stepPlot"), - type = c("dateRangeInput", "selectInput", "selectInput", "selectInput", - "checkboxInput", "checkboxInput", "checkboxInput"), stringsAsFactors = FALSE) - - -.global_shared_plotMap <- data.frame( - module = "plotMap", - panel = "Map", - input = c("dateRange", "mcYear", "mcYearh", "timeSteph5"), - type = c("dateRangeInput", "selectInput", "selectInput", "selectInput"), stringsAsFactors = FALSE) - -.global_shared_exchangesStack <- data.frame( - module = "exchangesStack", - panel = "exchangesStack", - input = c("dateRange", "unit", "mcYear", "mcYearh", "timeSteph5", "legend", "drawPoints", "stepPlot"), - type = c("dateRangeInput", "selectInput", "selectInput", "selectInput", "selectInput", - "checkboxInput", "checkboxInput", "checkboxInput"), stringsAsFactors = FALSE) - -.global_shared_input <- rbind(.global_shared_prodStack, .global_shared_plotts, .global_shared_plotMap, .global_shared_exchangesStack) - - -.global_build_input_data <- function(data){ - data$input_id <- paste0(data$module, "-shared_", data$input) - data$last_update <- NA - data$update_call <- "" - class(data$last_update) <- c("character") - data <- data.table(data) - data -} - -#------------ -# compare -#----------- - -.global_compare_prodstack <- c("mcYear", "main", "unit", "areas", "legend", - "stack", "stepPlot", "drawPoints") - -.global_compare_exchangesStack <- c("mcYear", "main", "unit", "area", - "legend", "stepPlot", "drawPoints") - -.global_compare_tsPlot <- c("mcYear", "main", "variable", "type", "confInt", "elements", - "aggregate", "legend", "highlight", "stepPlot", "drawPoints", "secondAxis") - -.global_compare_plotMap <- c("mcYear", "type", "colAreaVar", "sizeAreaVars", "areaChartType", "showLabels", - "popupAreaVars", "labelAreaVar","colLinkVar", "sizeLinkVar", "popupLinkVars") - - -#----- generate help for antaresRead function -# library(tools) -# add.html.help <- function(package, func, tempsave = paste0(getwd(), "/temp.html")) { -# pkgRdDB = tools:::fetchRdDB(file.path(find.package(package), "help", package)) -# topics = names(pkgRdDB) -# rdfunc <- pkgRdDB[[func]] -# tools::Rd2HTML(pkgRdDB[[func]], out = tempsave) -# } -# add.html.help("antaresRead", "readAntares", "inst/application/www/readAntares.html") -# add.html.help("antaresRead", "removeVirtualAreas", "inst/application/www/removeVirtualAreas.html") -# add.html.help("antaresRead", "writeAntaresH5", "inst/application/www/writeAntaresH5.html") diff --git a/inst/application/server.R b/inst/application/server.R deleted file mode 100644 index 23fae84..0000000 --- a/inst/application/server.R +++ /dev/null @@ -1,134 +0,0 @@ -function(input, output, session) { - - #---------------- - # Write h5 - #---------------- - source("src/server/07_write_h5.R", local = T) - - #---------------- - # set / read data - #---------------- - source("src/server/01_set_read_data.R", local = T) - - #---------------- - # shared parameters - #---------------- - - modules <- reactiveValues(prodStack = NULL, exchangesStack = NULL, plotts = NULL, plotMap = NULL) - - # all data loaded by user, with informations - list_data_all <- reactiveValues(antaresDataList = list(), params = list(), - have_links = c(), have_areas = c(), opts = list()) - - # set of controls - list_data_controls <- reactiveValues(have_links = FALSE, have_areas = FALSE, - n_links = -1, n_areas = -1, n_maps = -1) - - - #----------------- - # Importation de nouvelles donnees - #----------------- - - source("src/server/02_load_data.R", local = T) - - #---------------- - # Dataset selection - #---------------- - source("src/server/03_data_selection.R", local = T) - - #----------------- - # modules - #----------------- - - # launch when click on ""Launch Analysis" button - # and get back which opts / data to keep - ind_keep_list_data <- reactive({ - if(input$update_module > 0){ - isolate({ - names_input <- names(input) - keep_input <- names_input[grepl("^list_study_check", names_input)] - keep_input <- keep_input[as.numeric(gsub("list_study_check", "", keep_input)) <= length(list_data_all$antaresDataList)] - if(length(keep_input) > 0){ - keep_input <- sort(keep_input) - final_keep <- sapply(keep_input, function(x){ - input[[x]] - }) - - # all to keep - ind_all <- which(final_keep) - - # with areas - ind_areas <- intersect(which(list_data_all$have_areas), ind_all) - - # with links - ind_links <- intersect(which(list_data_all$have_links), ind_all) - - list(ind_all = ind_all, ind_areas = ind_areas, ind_links = ind_links) - } else { - NULL - } - }) - } else { - NULL - } - }) - - #------------------ - # prodStack, plotTS & stackExchange - #------------------ - - source("src/server/05_modules.R", local = T) - - #------------ - # plotMap - #------------ - - source("src/server/06_module_map.R", local = T) - - #---------------- - # shared inputs - #---------------- - - source("src/server/04_shared_input.R", local = T) - - #---------------- - # memory options - #---------------- - observe({ - if(!is.na(input$ram_limit)){ - antaresRead::setRam(input$ram_limit) - } - }) - - observe({ - if(!is.na(input$data_module)){ - limitSizeGraph(input$data_module) - } - }) - - #---------------- - # quit - #---------------- - - # in case of classic use : - observe({ - if(input$quit > 0){ - stopApp(returnValue = TRUE) - } - }) - - # in case of Rinno / packaging app for windows - # (and so comment previous observe....!) - # - # observe({ - # if(input$quit > 0){ - # stopApp() - # q("no") - # } - # }) - # - # session$onSessionEnded(function() { - # stopApp() - # q("no") - # }) -} diff --git a/inst/application/src/scripts/directoryInput.R b/inst/application/src/scripts/directoryInput.R deleted file mode 100644 index 3e0df04..0000000 --- a/inst/application/src/scripts/directoryInput.R +++ /dev/null @@ -1,169 +0,0 @@ -#' Choose a Folder Interactively (Mac OS X) -#' -#' Display a folder selection dialog under Mac OS X -#' -#' @param default which folder to show initially -#' @param caption the caption on the selection dialog -#' -#' @details -#' Uses an Apple Script to display a folder selection dialog. With \code{default = NA}, -#' the initial folder selection is determined by default behavior of the -#' "choose folder" Apple Script command. Otherwise, paths are expanded with -#' \link{path.expand}. -#' -#' @return -#' A length one character vector, character NA if 'Cancel' was selected. -#' -if (Sys.info()['sysname'] == 'Darwin') { - choose.dir = function(default = NA, caption = NA) { - command = 'osascript' - args = '-e "POSIX path of (choose folder{{prompt}}{{default}})"' - - if (!is.null(caption) && !is.na(caption) && nzchar(caption)) { - prompt = sprintf(' with prompt \\"%s\\"', caption) - } else { - prompt = '' - } - args = sub('{{prompt}}', prompt, args, fixed = T) - - if (!is.null(default) && !is.na(default) && nzchar(default)) { - default = sprintf(' default location \\"%s\\"', path.expand(default)) - } else { - default = '' - } - args = sub('{{default}}', default, args, fixed = T) - - suppressWarnings({ - path = system2(command, args = args, stderr = TRUE) - }) - if (!is.null(attr(path, 'status')) && attr(path, 'status')) { - # user canceled - path = NA - } - - return(path) - } -} else if (Sys.info()['sysname'] == 'Linux') { - choose.dir = function(default = NA, caption = NA) { - command = 'zenity' - args = '--file-selection --directory --title="Choose a folder"' - - suppressWarnings({ - path = system2(command, args = args, stderr = TRUE) - }) - - #Return NA if user hits cancel - if (!is.null(attr(path, 'status')) && attr(path, 'status')) { - # user canceled - return(default) - } - - #Error: Gtk-Message: GtkDialog mapped without a transient parent - if(length(path) == 2){ - path = path[2] - } - - return(path) - } -} - -#' Directory Selection Control -#' -#' Create a directory selection control to select a directory on the server -#' -#' @param inputId The \code{input} slot that will be used to access the value -#' @param label Display label for the control, or NULL for no label -#' @param value Initial value. Paths are exapnded via \code{\link{path.expand}}. -#' -#' @details -#' This widget relies on \link{\code{choose.dir}} to present an interactive -#' dialog to users for selecting a directory on the local filesystem. Therefore, -#' this widget is intended for shiny apps that are run locally - i.e. on the -#' same system that files/directories are to be accessed - and not from hosted -#' applications (e.g. from shinyapps.io). -#' -#' @return -#' A directory input control that can be added to a UI definition. -#' -#' @seealso -#' \link{updateDirectoryInput}, \link{readDirectoryInput}, \link[utils]{choose.dir} -directoryInput = function(inputId, label, value = NULL) { - if (!is.null(value) && !is.na(value)) { - value = path.expand(value) - } - - tagList( - singleton( - tags$head( - tags$script(src = 'js/directory_input_binding.js') - ) - ), - - div( - class = 'form-group directory-input-container', - shiny:::`%AND%`(label, tags$label(label)), - div( - span( - class = 'col-xs-9 col-md-11', - style = 'padding-left: 0; padding-right: 5px;', - div( - class = 'input-group shiny-input-container', - style = 'width:100%;', - div(class = 'input-group-addon', icon('folder-o')), - tags$input( - id = sprintf('%s__chosen_dir', inputId), - value = value, - type = 'text', - class = 'form-control directory-input-chosen-dir', - readonly = 'readonly' - ) - ) - ), - span( - class = 'shiny-input-container', - tags$button( - id = inputId, - class = 'btn btn-default directory-input', - '...' - ) - ) - ) - ) - - ) - -} - -#' Change the value of a directoryInput on the client -#' -#' @param session The \code{session} object passed to function given to \code{shinyServer}. -#' @param inputId The id of the input object. -#' @param value A directory path to set -#' @param ... Additional arguments passed to \link{\code{choose.dir}}. Only used -#' if \code{value} is \code{NULL}. -#' -#' @details -#' Sends a message to the client, telling it to change the value of the input -#' object. For \code{directoryInput} objects, this changes the value displayed -#' in the text-field and triggers a client-side change event. A directory -#' selection dialog is not displayed. -#' -updateDirectoryInput = function(session, inputId, value = NULL, ...) { - if (is.null(value)) { - value = choose.dir(...) - } - session$sendInputMessage(inputId, list(chosen_dir = value)) -} - -#' Read the value of a directoryInput -#' -#' @param session The \code{session} object passed to function given to \code{shinyServer}. -#' @param inputId The id of the input object -#' -#' @details -#' Reads the value of the text field associated with a \code{directoryInput} -#' object that stores the user selected directory path. -#' -readDirectoryInput = function(session, inputId) { - session$input[[sprintf('%s__chosen_dir', inputId)]] -} diff --git a/inst/application/src/server/01_set_read_data.R b/inst/application/src/server/01_set_read_data.R deleted file mode 100644 index 802dd44..0000000 --- a/inst/application/src/server/01_set_read_data.R +++ /dev/null @@ -1,228 +0,0 @@ -#---------------- -# set / read data -#---------------- - -# observe directory -observeEvent( - ignoreNULL = TRUE, - eventExpr = { - input$directory - }, - handlerExpr = { - if (input$directory > 0) { - # condition prevents handler execution on initial app launch - path = choose.dir(default = readDirectoryInput(session, 'directory')) - updateDirectoryInput(session, 'directory', value = path) - } - } -) - -output$directory_message <- renderText({ - if(input$directory == 0){ - "Please first choose a folder with antares output" - } else { - "No antares output found in directory" - } -}) - -# list files in directory -dir_files <- reactive({ - files = list.files(readDirectoryInput(session, 'directory'), full.names = T) - data.frame(name = basename(files), file.info(files)) -}) - -# have antares study in directory ? -is_antares_results <- reactive({ - dir_files <- dir_files() - is_h5 <- any(grepl(".h5$", dir_files$name)) - is_study <- all(c("output", "study.antares") %in% dir_files$name) - list(is_h5 = is_h5, is_study = is_study) -}) - -output$ctrl_is_antares_study <- reactive({ - is_antares_results()$is_study -}) - -output$ctrl_is_antares_h5 <- reactive({ - is_antares_results()$is_h5 -}) - -outputOptions(output, "ctrl_is_antares_study", suspendWhenHidden = FALSE) -outputOptions(output, "ctrl_is_antares_h5", suspendWhenHidden = FALSE) - -# if have study, update selectInput list -observe({ - is_antares_results <- is_antares_results() - if(is_antares_results$is_h5 | is_antares_results$is_study){ - isolate({ - if(is_antares_results$is_study){ - files = list.files(paste0(readDirectoryInput(session, 'directory'), "/output"), full.names = T) - } - if(is_antares_results$is_h5){ - files = list.files(readDirectoryInput(session, 'directory'), pattern = ".h5$", full.names = T) - } - if(length(files) > 0){ - files <- data.frame(name = basename(files), file.info(files)) - choices <- rownames(files) - names(choices) <- files$name - } else { - choices <- NULL - } - updateSelectInput(session, "study_path", "Select a simulation", choices = choices) - }) - } -}) - -# init opts after validation -opts <- reactive({ - if(input$init_sim > 0){ - opts <- - tryCatch({ - setSimulationPath(isolate(input$study_path)) - }, error = function(e){ - showModal(modalDialog( - title = "Error setting file", - easyClose = TRUE, - footer = NULL, - paste("Directory/file is not an Antares study : ", e, sep = "\n") - )) - NULL - }) - if(!is.null(opts)){ - if(is.null(opts$h5)){ - opts$h5 <- FALSE - } - # bad h5 control - if(opts$h5){ - if(length(setdiff(names(opts), c("h5", "h5path"))) == 0){ - showModal(modalDialog( - easyClose = TRUE, - footer = NULL, - "Invalid h5 file : not an Antares study." - )) - opts <- NULL - } - } - } - opts - } else { - NULL - } -}) - -output$current_opts_h5 <- reactive({ - opts()$h5 -}) - -outputOptions(output, "current_opts_h5", suspendWhenHidden = FALSE) - -current_study_path <- reactive({ - if(input$init_sim > 0){ - rev(unlist(strsplit(isolate(input$study_path), "/")))[1] - } -}) - -output$current_opts <- renderText({ - current_study_path() -}) - -# control : have not null opts ? -output$have_study <- reactive({ - !is.null(opts()) -}) - -outputOptions(output, "have_study", suspendWhenHidden = FALSE) - -observe({ - if(input$init_sim > 0){ - updateTabsetPanel(session, inputId = "args", selected = "Read data") - } -}) - - -#-------------------------------------- -# update readAntares / opts parameters -#-------------------------------------- -observe({ - opts <- opts() - if(!is.null(opts)){ - isolate({ - # areas - areas <- c("all", opts$areaList) - updateSelectInput(session, "read_areas", "Areas :", choices = areas, selected = areas[1]) - - # links - links <- c("all", opts$linkList) - updateSelectInput(session, "read_links", "Links :", choices = links, selected = NULL) - - # clusters - clusters <- c("all", opts$areasWithClusters) - updateSelectInput(session, "read_clusters", "Clusters :", choices = clusters, selected = NULL) - - # districts - districts <- c("all", opts$districtList) - updateSelectInput(session, "read_districts", "Districts :", choices = districts, selected = NULL) - - # mcYears - mcy <- c(opts$mcYears) - updateSelectInput(session, "read_mcYears", "mcYears :", choices = mcy, selected = mcy[1]) - - # select - slt <- unique(do.call("c", opts$variables)) - updateSelectInput(session, "read_select", "Select :", choices = slt, selected = NULL) - - # removeVirtualAreas - updateSelectInput(session, "rmva_storageFlexibility", "storageFlexibility :", choices = opts$areaList, selected = NULL) - updateSelectInput(session, "rmva_production", "production :", choices = opts$areaList, selected = NULL) - - }) - } -}) - -observe({ - RL <- input$read_links - isolate({ - if(!is.null(RL)) { - if(length(RL) == 0) { - updateCheckboxInput(session, "read_linkCapacity", "linkCapacity", FALSE) - } - } else { - updateCheckboxInput(session, "read_linkCapacity", "linkCapacity", FALSE) - } - }) - -}) - -observe({ - RC <- input$read_clusters - opts <- opts() - isolate({ - if(!is.null(RC)) { - if(length(RC) == 0) { - updateCheckboxInput(session, "read_thermalAvailabilities", "thermalAvailabilities", FALSE) - updateCheckboxInput(session, "read_thermalModulation", "thermalModulation", FALSE) - } - } else { - updateCheckboxInput(session, "read_thermalAvailabilities", "thermalAvailabilities", FALSE) - updateCheckboxInput(session, "read_thermalModulation", "thermalModulation", FALSE) - } - }) - -}) - -observe({ - opts <- opts() - if(!is.null(opts)) { - isolate({ - # browser() - if(!opts$parameters$general$`year-by-year`){ - updateRadioButtons(session, "read_type_mcYears", "mcYears :", - c("synthetic"), inline = TRUE) - updateCheckboxInput(session, "read_hydroStorage", "hydroStorage", FALSE) - } else { - updateRadioButtons(session, "read_type_mcYears", "mcYears :", - c("synthetic", "all", "custom"), inline = TRUE) - } - }) - } -}) \ No newline at end of file diff --git a/inst/application/src/server/02_load_data.R b/inst/application/src/server/02_load_data.R deleted file mode 100644 index 646e0c0..0000000 --- a/inst/application/src/server/02_load_data.R +++ /dev/null @@ -1,159 +0,0 @@ -#----------------- -# Importation de nouvelles donnees -#----------------- -observe({ - if(input$import_data > 0){ - isolate({ - if(!is.null(opts())){ - # not a .h5 file, so read data - if(!opts()$h5){ - # Treat mcYears - if(input$read_type_mcYears == "synthetic"){ - mcYears <- NULL - } else if(input$read_type_mcYears == "all"){ - mcYears <- "all" - } else { - mcYears <- as.numeric(input$read_mcYears) - } - - # import data - data <- withCallingHandlers({ - tryCatch({ - readAntares(areas = input$read_areas, links = input$read_links, clusters = input$read_clusters, - districts = input$read_districts, misc = input$read_misc, - thermalAvailabilities = input$read_thermalAvailabilities, - hydroStorage = input$read_hydroStorage, hydroStorageMaxPower = input$read_hydroStorageMaxPower, - reserve = input$read_reserve, linkCapacity = input$read_linkCapacity, - mustRun = input$read_mustRun, thermalModulation = input$read_thermalModulation, - select = input$read_select, mcYears = mcYears, timeStep = input$read_timeStep, - opts = opts(), - # parallel = input$read_parallel, - simplify = TRUE, showProgress = FALSE)}, - error = function(e){ - showModal(modalDialog( - title = "Error reading data", - easyClose = TRUE, - footer = NULL, - paste("Please update input. Error : ", e, sep = "\n") - )) - list() - })}, - warning = function(w){ - showModal(modalDialog( - title = "Warning reading data", - easyClose = TRUE, - footer = NULL, - w - )) - } - ) - - # removeVirtualAreas - if(input$rmva_ctrl){ - if(length(data) > 0){ - data <- withCallingHandlers({ - tryCatch({ - removeVirtualAreas(x = data, - storageFlexibility = input$rmva_storageFlexibility, - production = input$rmva_production, - reassignCosts = input$rmva_reassignCosts, - newCols = input$rmva_newCols)}, - error = function(e){ - showModal(modalDialog( - title = "removeVirtualAreas : error", - easyClose = TRUE, - footer = NULL, - paste("Please update input. Error : ", e, sep = "\n") - )) - list() - })}, - warning = function(w){ - showModal(modalDialog( - title = "removeVirtualAreas : warning", - easyClose = TRUE, - footer = NULL, - w - )) - } - ) - } - } - - if(length(data) > 0){ - # save params - params <- list( - areas = input$read_areas, links = input$read_links, clusters = input$read_clusters, - districts = input$read_districts, misc = input$read_misc, - thermalAvailabilities = input$read_thermalAvailabilities, - hydroStorage = input$read_hydroStorage, hydroStorageMaxPower = input$read_hydroStorageMaxPower, - reserve = input$read_reserve, linkCapacity = input$read_linkCapacity, - mustRun = input$read_mustRun, thermalModulation = input$read_thermalModulation, - select = input$read_select, mcYears = mcYears, timeStep = input$read_timeStep, - parallel = input$read_parallel - ) - - n_list <- length(list_data_all$antaresDataList) + 1 - list_data_all$antaresDataList[[n_list]] <- data - - # write params and links control - list_data_all$params[[n_list]] <- params - list_data_all$opts[[n_list]] <- opts() - if(!is.null(input$read_links)){ - list_data_all$have_links[n_list] <- TRUE - } else { - list_data_all$have_links[n_list] <- FALSE - } - have_areas <- is.null(input$read_areas) & is.null(input$read_links) & is.null(input$read_clusters) & - is.null(input$read_districts) | !is.null(input$read_areas) - if(have_areas){ - list_data_all$have_areas[n_list] <- TRUE - } else { - list_data_all$have_areas[n_list] <- FALSE - } - names(list_data_all$antaresDataList)[[n_list]] <- current_study_path() - } - - } else { - params <- list( - areas = input$read_areas, links = input$read_links, - clusters = input$read_clusters, districts = input$read_districts, - select = input$read_select - ) - - # a .h5 file, so return opts... - n_list <- length(list_data_all$antaresDataList) + 1 - list_data_all$antaresDataList[[n_list]] <- opts() - - # write params and links control - list_data_all$params[[n_list]] <- params - list_data_all$opts[[n_list]] <- opts() - if(!is.null(input$read_links)){ - list_data_all$have_links[n_list] <- TRUE - } else { - list_data_all$have_links[n_list] <- FALSE - } - have_areas <- is.null(input$read_areas) & is.null(input$read_links) & is.null(input$read_clusters) & - is.null(input$read_districts) | !is.null(input$read_areas) - if(have_areas){ - list_data_all$have_areas[n_list] <- TRUE - } else { - list_data_all$have_areas[n_list] <- FALSE - } - names(list_data_all$antaresDataList)[[n_list]] <- current_study_path() - } - } - }) - } -}) - -observe({ - if(input$import_data > 0){ - updateTabsetPanel(session, inputId = "tab_data", selected = "Analysis") - } -}) - -# control : have data -output$have_data <- reactive({ - length(list_data_all$antaresDataList) > 0 -}) -outputOptions(output, "have_data", suspendWhenHidden = FALSE) \ No newline at end of file diff --git a/inst/application/src/server/03_data_selection.R b/inst/application/src/server/03_data_selection.R deleted file mode 100644 index 33190c2..0000000 --- a/inst/application/src/server/03_data_selection.R +++ /dev/null @@ -1,106 +0,0 @@ -#------------------ -# gestion de la liste -#------------------ -output$info_list <- renderUI({ - list_data <- list_data_all$antaresDataList - if(length(list_data) > 0){ - isolate({ - # affichage du nom de l'etude - study <- lapply(1:length(list_data), function(i) { - study_name <- paste0("list_study_", i) - div( - h4(textOutput(study_name)), style = 'height:24px', align = "center") - }) - # checkbox de selection - check_list <- lapply(1:length(list_data), function(i) { - check_name <- paste0("list_study_check", i) - div( - checkboxInput(check_name, "Include study in analysis", value = TRUE), align = "center") - }) - # bouton pour afficher les parametres - params_list <- lapply(1:length(list_data), function(i) { - btn_name <- paste0("list_study_params", i) - div( - actionButton(btn_name, "View parameters"), align = "center") - }) - # bouton pour supprimer les donnees - rm_list <- lapply(1:length(list_data), function(i) { - btn_name <- paste0("list_study_rm", i) - div( - actionButton(btn_name, "Remove study"), align = "center") - }) - # format et retour - fluidRow( - column(3, do.call(tagList, study)), - column(3, do.call(tagList, params_list)), - column(3, do.call(tagList, check_list)), - column(3, do.call(tagList, rm_list)) - ) - }) - }else { - # element vide si pas de donnees - fluidRow() - } -}) - -# creation des outputs -# - titre de l'etude -# - print des parametres -observe({ - # lancement lors de la recuperation des donnees formatees - list_data_tmp <- list_data_all$antaresDataList - if(length(list_data_tmp) > 0){ - isolate({ - ctrl <- lapply(1:length(list_data_tmp), function(i) { - study_name <- paste0("list_study_", i) - study_params <- paste0("list_study_params", i) - output[[study_name]] <- renderText({ - paste0("Study : ", names(list_data_tmp)[i]) - }) - - output[[study_params]] <- renderPrint({ - str(list_data_all$params[[i]]) - }) - }) - }) - } -}) - -# observe locaux pour l'affichage des parametres -# et pour la suppression des etudes -for(j in 1:16){ - local({ - l_j <- j - observe({ - if(!is.null(input[[paste0("list_study_params", l_j)]])){ - if(input[[paste0("list_study_params", l_j)]] > 0){ - showModal(modalDialog( - easyClose = TRUE, - footer = NULL, - verbatimTextOutput(paste0("list_study_params", l_j)) - )) - } - } - }) - - observe({ - if(!is.null(input[[paste0("list_study_rm", l_j)]])){ - if(input[[paste0("list_study_rm", l_j)]] > 0){ - isolate({ - # print("remove") - # print(l_j) - # print(object_size(list_data_all$antaresDataList)) - # print(object_size(list_data_all$antaresDataList[l_j])) - # print(mem_change(list_data_all$antaresDataList[l_j] <- NULL)) - # print(object_size(list_data_all$antaresDataList)) - # print(object_size(list_data_all$antaresDataList[l_j])) - list_data_all$antaresDataList[l_j] <- NULL - list_data_all$params[l_j] <- NULL - gc(reset = TRUE) - - }) - } - } - }) - }) -} \ No newline at end of file diff --git a/inst/application/src/server/04_shared_input.R b/inst/application/src/server/04_shared_input.R deleted file mode 100644 index 28b450c..0000000 --- a/inst/application/src/server/04_shared_input.R +++ /dev/null @@ -1,77 +0,0 @@ -input_data <- reactiveValues(data = .global_build_input_data(.global_shared_input), cpt = 0) - -observe({ - input_data$cpt - current_input_data <- input_data$data - for (ii in 1:nrow(current_input_data)){ - local({ - i <- ii - observe({ - current_value <- input[[current_input_data[i, input_id]]] - if(!is.null(current_value) & input$is_shared_input){ - isolate({ - current_input_data[i, last_update := as.character(Sys.time())] - if(isolate(current_input_data$update_call[i]) != ""){ - eval(parse(text = isolate(current_input_data$update_call[i]))) - isolate(current_input_data[i, update_call := ""]) - } - }) - } - }) - }) - } -}) - -observe({ - current_nav <- input[['nav-id']] - current_input_data <- isolate(input_data$data) - data_shared_input <- current_input_data[panel %in% current_nav] - if(nrow(data_shared_input) > 0 & input$is_shared_input){ - for(ii in 1:nrow(data_shared_input)){ - local({ - i <- ii - last_update_input <- current_input_data[!panel %in% current_nav & - input%in%data_shared_input[i, input] & - !is.na(last_update)][order(last_update, decreasing = TRUE)] - if(nrow(last_update_input) >= 1){ - if(data_shared_input[i, type] %in% "dateRangeInput"){ - if(!is.null(isolate({input[[data_shared_input[i, input_id]]]}))){ - updateDateRangeInput(session, data_shared_input[i, input_id], - start = isolate({input[[last_update_input[1, input_id]]][1]}), - end = isolate({input[[last_update_input[1, input_id]]][2]})) - } else { - expr <- paste0("updateDateRangeInput(session, '", data_shared_input[i, input_id], - "', start = '", isolate({input[[last_update_input[1, input_id]]][1]}), - "', end = '", isolate({input[[last_update_input[1, input_id]]][2]}), "')") - isolate({ - input_data$data[input_id %in% data_shared_input[i, input_id], update_call := expr] - }) - - } - - } else if(data_shared_input[i, type] %in% "selectInput"){ - if(!is.null(isolate({input[[data_shared_input[i, input_id]]]}))){ - updateSelectInput(session, data_shared_input[i, input_id], - selected = isolate({input[[last_update_input[1, input_id]]]})) - } else { - expr <- paste0("updateSelectInput(session, '", data_shared_input[i, input_id], - "', selected = '", isolate({input[[last_update_input[1, input_id]]]}), "')") - isolate({ - input_data$data[input_id %in% data_shared_input[i, input_id], update_call := expr] - }) - } - }else if(data_shared_input[i, type] %in% "checkboxInput"){ - if(!is.null(isolate({input[[data_shared_input[i, input_id]]]}))){ - updateCheckboxInput(session, data_shared_input[i, input_id], - value = isolate({input[[last_update_input[1, input_id]]]})) - } else { - expr <- paste0("updateCheckboxInput(session, '", data_shared_input[i, input_id], - "', value = ", isolate({input[[last_update_input[1, input_id]]]}), ")") - input_data$data[input_id %in% data_shared_input[i, input_id], update_call := expr] - } - } - } - }) - } - } -}) \ No newline at end of file diff --git a/inst/application/src/server/05_modules.R b/inst/application/src/server/05_modules.R deleted file mode 100644 index 0904045..0000000 --- a/inst/application/src/server/05_modules.R +++ /dev/null @@ -1,174 +0,0 @@ -observe({ - ind_keep_list_data <- ind_keep_list_data() - isolate({ - if(input$update_module > 0){ - if(is.null(ind_keep_list_data)){ - showModal(modalDialog( - easyClose = TRUE, - footer = NULL, - "No study selected" - )) - } else { - # plotts and prodStack - ind_areas <- ind_keep_list_data$ind_areas - if(length(ind_areas) > 0){ - # init / re-init module prodStack - id_prodStack <- paste0("prodStack_", round(runif(1, 1, 100000000))) - - # update shared input table - 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) - }) - - .compare <- input$sel_compare_prodstack - if(input$sel_compare_mcyear){ - .compare <- unique(c(.compare, "mcYear")) - } - if(!is.null(.compare)){ - list_compare <- vector("list", length(.compare)) - names(list_compare) <- .compare - # set main with study names - if(length(ind_areas) != 1){ - list_compare$main <- names(list_data_all$antaresDataList[ind_areas]) - } - .compare <- list_compare - } 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, - .updateBtnInit = TRUE, compare = .compare, .runApp = FALSE) - - if("MWController" %in% class(modules$prodStack)){ - modules$prodStack$clear() - } - - modules$prodStack <- mwModule(id = id_prodStack, mod_prodStack) - - # init / re-init module plotts - id_ts <- paste0("plotts_", round(runif(1, 1, 100000000))) - - # update shared input table - 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) - }) - - .compare <- input$sel_compare_tsPlot - if(input$sel_compare_mcyear){ - .compare <- unique(c(.compare, "mcYear")) - } - if(!is.null(.compare)){ - list_compare <- vector("list", length(.compare)) - names(list_compare) <- .compare - # set main with study names - if(length(ind_areas) != 1){ - list_compare$main <- names(list_data_all$antaresDataList[ind_areas]) - } - .compare <- list_compare - } 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, - .updateBtnInit = TRUE, compare = .compare, .runApp = FALSE) - - if("MWController" %in% class(modules$plotts)){ - modules$plotts$clear() - } - - modules$plotts <- mwModule(id = id_ts, mod_plotts) - - list_data_controls$n_areas <- length(ind_areas) - list_data_controls$have_areas <- TRUE - } else { - list_data_controls$have_areas <- FALSE - } - - # exchange - ind_links <- ind_keep_list_data$ind_links - if(length(ind_links) > 0){ - # init / re-init module exchangesStack - id_exchangesStack <- paste0("exchangesStack_", round(runif(1, 1, 100000000))) - - # update shared input table - 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) - }) - - .compare <- input$sel_compare_exchangesStack - if(input$sel_compare_mcyear){ - .compare <- unique(c(.compare, "mcYear")) - } - if(!is.null(.compare)){ - list_compare <- vector("list", length(.compare)) - names(list_compare) <- .compare - # set main with study names - if(length(ind_links) != 1){ - list_compare$main <- names(list_data_all$antaresDataList[ind_links]) - } - .compare <- list_compare - } 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, - .updateBtnInit = TRUE, compare = .compare, .runApp = FALSE) - - if("MWController" %in% class(modules$exchangesStack)){ - modules$exchangesStack$clear() - } - - modules$exchangesStack <- mwModule(id = id_exchangesStack, mod_exchangesStack) - - # save data and params - list_data_controls$n_links <- length(ind_links) - list_data_controls$have_links <- TRUE - } else { - list_data_controls$have_links <- FALSE - } - - if(!list_data_controls$have_areas & !list_data_controls$have_links){ - showModal(modalDialog( - easyClose = TRUE, - footer = NULL, - "No study with at least one area and/or link selected" - )) - } - } - } - - input_data$cpt <- isolate(input_data$cpt) +1 - }) -}) - -# control : have link in data -output$have_data_links <- reactive({ - list_data_controls$have_links -}) -outputOptions(output, "have_data_links", suspendWhenHidden = FALSE) - -# control : have areas in data -output$have_data_areas <- reactive({ - list_data_controls$have_areas -}) -outputOptions(output, "have_data_areas", suspendWhenHidden = FALSE) - -# change page -observe({ - if(input$update_module > 0){ - if(list_data_controls$have_areas & list_data_controls$n_areas >= 1){ - updateNavbarPage(session, inputId = "nav-id", selected = "prodStack") - } else if(list_data_controls$have_links & list_data_controls$n_links >= 1){ - updateNavbarPage(session, inputId = "nav-id", selected = "exchangesStack") - } - } -}) \ No newline at end of file diff --git a/inst/application/src/server/06_module_map.R b/inst/application/src/server/06_module_map.R deleted file mode 100644 index 21b61c5..0000000 --- a/inst/application/src/server/06_module_map.R +++ /dev/null @@ -1,144 +0,0 @@ -# list of opts for set layout -layout <- reactive({ - ind_keep_list_data <- ind_keep_list_data() - isolate({ - if(!is.null(ind_keep_list_data)){ - ind_map <- unique(sort(c(ind_keep_list_data$ind_areas, ind_keep_list_data$ind_links))) - if(length(ind_map) > 0){ - if(packageVersion("antaresRead") <= '2.0.0'){ - readLayout(opts = list_data_all$opts[ind_map][[1]]) - } else { - readLayout(opts = list_data_all$opts[ind_map]) - } - }else{ - NULL - } - } else { - NULL - } - }) -}) - -ml <- reactiveVal() -# module for set and save layout -ml_builder <- callModule(antaresViz:::changeCoordsServer, "ml", layout, - what = reactive("areas"), stopApp = FALSE) - -observe({ - ml(ml_builder()) -}) - -observe({ - ml_file <- input$import_layout - if (!is.null(ml_file)){ - tmp_ml <- try(readRDS(ml_file$datapath), silent = TRUE) - if("mapLayout" %in% class(tmp_ml)){ - ml(tmp_ml) - } else { - showModal(modalDialog( - title = "Invalid map layout file", - easyClose = TRUE, - footer = NULL, - "Must be a valid .RDS file (class 'mapLayout')" - )) - } - } -}) - -# control : have a not null layout, and so print map module ? -print_map <- reactiveValues(value = FALSE) - -observe({ - if(!is.null(ml())){ - print_map$value <- TRUE - } else { - print_map$value <- FALSE - } -}) - - -output$current_layout <- renderLeafletDragPoints({ - if(!is.null(ml())){ - plotMapLayout(ml()) - } -}) - -output$must_print_map <- reactive({ - print_map$value -}) - -outputOptions(output, "must_print_map", suspendWhenHidden = FALSE) - -observe({ - ml <- ml() - ind_keep_list_data <- ind_keep_list_data() - isolate({ - if(input$update_module > 0){ - if(!is.null(ind_keep_list_data)){ - ind_map <- unique(sort(c(ind_keep_list_data$ind_areas, ind_keep_list_data$ind_links))) - if(length(ind_map) > 0){ - if(!is.null(ml)){ - # init / re-init module plotMap - id_plotMap <- paste0("plotMap_", round(runif(1, 1, 100000000))) - - # update shared input table - 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) - }) - - .compare <- input$sel_compare_plotMap - if(input$sel_compare_mcyear){ - .compare <- unique(c(.compare, "mcYear")) - } - if(!is.null(.compare)){ - 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]) - } - .compare <- list_compare - } else { - .compare = NULL - } - - mod_plotMap <- plotMap(list_data_all$antaresDataList[ind_map], ml, - interactive = TRUE, .updateBtn = TRUE, - .updateBtnInit = TRUE, compare = .compare, - h5requestFiltering = list_data_all$params[ind_map], - xyCompare = "union", .runApp = FALSE) - - if("MWController" %in% class(modules$plotMap)){ - modules$plotMap$clear() - } - - modules$plotMap <- mwModule(id = id_plotMap, mod_plotMap) - # save data and params - list_data_controls$n_maps <- length(ind_map) - } - } - } - } - }) -}) - -# download layout -output$download_layout <- downloadHandler( - filename = function() { - paste('mapLayout-', Sys.Date(), '.RDS', sep='') - }, - content = function(con) { - saveRDS(ml(), file = con) - } -) - -# change page -observe({ - if(!is.null(input[['ml-done']])){ - if(input[['ml-done']] > 0){ - updateNavbarPage(session, inputId = "nav-id", selected = "Map") - } - } -}) \ No newline at end of file diff --git a/inst/application/src/server/07_write_h5.R b/inst/application/src/server/07_write_h5.R deleted file mode 100644 index becfce3..0000000 --- a/inst/application/src/server/07_write_h5.R +++ /dev/null @@ -1,61 +0,0 @@ - - -observe({ - if(input$write_h5 > 0){ - isolate({ - print(readDirectoryInput(session, 'output_h5')) - # Write h5 - withCallingHandlers({ - tryCatch({ - writeAntaresH5( - path = readDirectoryInput(session, 'output_h5'), timeSteps = input$timeSteps_h5, - writeMcAll = input$writeMcAll_h5, misc = input$misc_h5, - thermalAvailabilities = input$thermalAvailabilities_h5, - hydroStorage = input$hydroStorage_h5, - hydroStorageMaxPower = input$hydroStorageMaxPower_h5, - reserve = input$reserve_h5, - linkCapacity = input$linkCapacity_h5, - mustRun = input$mustRun_h5, - thermalModulation = input$thermalModulation_h5, - overwrite = input$overwrite_h5, - opts = opts() - )}, - error = function(e){ - showModal(modalDialog( - title = "Error Writing h5", - easyClose = TRUE, - footer = NULL, - paste("Please update input. Error : ", e, sep = "\n") - )) - list() - })}, - warning = function(w){ - showModal(modalDialog( - title = "Warning Writing h5", - easyClose = TRUE, - footer = NULL, - w - )) - } - ) - }) - } -}) - - -# observe directory -observeEvent( - ignoreNULL = TRUE, - eventExpr = { - input$output_h5 - }, - handlerExpr = { - if (input$output_h5 > 0) { - # condition prevents handler execution on initial app launch - path = choose.dir(default = readDirectoryInput(session, 'output_h5')) - updateDirectoryInput(session, 'output_h5', value = path) - } - } -) - - \ No newline at end of file diff --git a/inst/application/src/tests/size_app.R b/inst/application/src/tests/size_app.R deleted file mode 100644 index 9363367..0000000 --- a/inst/application/src/tests/size_app.R +++ /dev/null @@ -1,41 +0,0 @@ -library(shiny) -library(manipulateWidget) -library(antaresViz) -library(pryr) - -ui <- fluidPage( - uiOutput("io"), - actionButton("goButton", "Go!") -) - - -server <- function(input, output, session) { - - tmp_prodstack <- NULL - - data <- reactiveValues(opts = setSimulationPath("C:\\Users\\Datastorm\\Desktop\\antares\\20171114-1533eco-base_30mc.h5")) - - output$io <- renderUI({ - mwModuleUI(paste0("mod2"), height = "800px") - }) - - observe({ - - print("object_size(session)") - print(object_size(session)) - input$goButton - isolate({ - prodStack <- prodStack(data$opts, xyCompare = "union", - unit = "GWh", interactive = TRUE, .updateBtn = TRUE, - .updateBtnInit = TRUE, .runApp = FALSE) - - if("MWController" %in% class(tmp_prodstack)){ - tmp_prodstack$clear() - } - tmp_prodstack <<- mwModule(id = paste0("mod2"), prodStack) - }) - }) - -} - -shinyApp(ui, server) \ No newline at end of file diff --git a/inst/application/src/ui/01_ui_import_data.R b/inst/application/src/ui/01_ui_import_data.R deleted file mode 100644 index 0578880..0000000 --- a/inst/application/src/ui/01_ui_import_data.R +++ /dev/null @@ -1,41 +0,0 @@ -tabPanel("Import Data", - h3("Antares study selection"), - fluidRow( - column(7, - directoryInput('directory', label = 'Select an antares study', - value = '') - ), - conditionalPanel(condition = "output.ctrl_is_antares_study | output.ctrl_is_antares_h5", - column(3, - selectInput("study_path", "Select a simulation", choices = NULL, selected = NULL) - ), - column(2, - div(br(), - actionButton("init_sim", "Set simulation", icon = icon("check-circle")), - align = "center" - ) - ) - ), - conditionalPanel(condition = "output.ctrl_is_antares_study === false & output.ctrl_is_antares_h5 === false", - column(5, - h3(textOutput("directory_message"), style = "color : red") - ) - ) - ), - - conditionalPanel(condition = "output.have_study", - hr(), - div(fluidRow( - column(6, - h3("ANTARES Simulation :", align = "right") - ), - column(6, - h3(textOutput("current_opts"), align = "left") - ) - )), - tabsetPanel(id = "args", - source("src/ui/02_ui_read_data.R", local = T)$value, - source("src/ui/03_ui_convert_h5.R", local = T)$value - ) - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/02_ui_read_data.R b/inst/application/src/ui/02_ui_read_data.R deleted file mode 100644 index 20bdcee..0000000 --- a/inst/application/src/ui/02_ui_read_data.R +++ /dev/null @@ -1,92 +0,0 @@ -tabPanel("Read data", - h3("readAntares parameters"), - fluidRow( - column(3, - selectInput("read_areas", "Areas :", choices = NULL, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("read_links", "Links :", choices = NULL, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("read_clusters", "Clusters : ", choices = NULL, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("read_districts", "Districts :", choices = NULL, selected = NULL, multiple = TRUE) - ) - ), - conditionalPanel(condition = "output.current_opts_h5 === false", - fluidRow( - column(3, - checkboxInput("read_misc", "misc", FALSE), - checkboxInput("read_reserve", "reserve", FALSE) - ), - column(3, - checkboxInput("read_thermalAvailabilities", "thermalAvailabilities", FALSE), - checkboxInput("read_linkCapacity", "linkCapacity", FALSE) - ), - column(3, - checkboxInput("read_hydroStorage", "hydroStorage", FALSE), - checkboxInput("read_mustRun", "mustRun", FALSE) - ), - column(3, - checkboxInput("read_hydroStorageMaxPower", "hydroStorageMaxPower", FALSE), - checkboxInput("read_thermalModulation", "thermalModulation", FALSE) - ) - ), - fluidRow( - column(3, - selectInput("read_timeStep", "timeStep :", choices = c("hourly", "daily", "weekly", - "monthly", "annual")) - ), - column(3, - radioButtons("read_type_mcYears", "mcYears :", - c("synthetic", "all", "custom"), inline = TRUE) - ), - conditionalPanel(condition = "input.read_type_mcYears === 'custom'", - column(3, - selectInput("read_mcYears", "Choose mcYears :", choices = NULL, selected = NULL, multiple = TRUE) - ) - ) - # ,column(3, - # checkboxInput("read_parallel", "parallel", FALSE) - # ) - ) - ), - fluidRow( - column(12, - selectInput("read_select", "Select :", choices = NULL, selected = NULL, - width = "100%", multiple = TRUE) - ) - ), - conditionalPanel(condition = "output.current_opts_h5 === false", - fluidRow( - column(3, - h4("removeVirtualAreas :") - ), - column(3, - checkboxInput("rmva_ctrl", "enabled", FALSE) - ) - ), - conditionalPanel(condition = "input.rmva_ctrl", - fluidRow( - column(3, - selectInput("rmva_storageFlexibility", "storageFlexibility :", choices = NULL, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("rmva_production", "production :", choices = NULL, selected = NULL, multiple = TRUE) - ), - - column(3, - br(), - checkboxInput("rmva_reassignCosts", "reassignCosts", FALSE) - ), - - column(3, - br(), - checkboxInput("rmva_newCols", "newCols", FALSE) - ) - ) - ) - ), - div(actionButton("import_data", "Validate & import data", icon = icon("upload")), align = "center") -) \ No newline at end of file diff --git a/inst/application/src/ui/03_ui_convert_h5.R b/inst/application/src/ui/03_ui_convert_h5.R deleted file mode 100644 index 893f78c..0000000 --- a/inst/application/src/ui/03_ui_convert_h5.R +++ /dev/null @@ -1,67 +0,0 @@ -tabPanel("Convert to h5", - conditionalPanel(condition = "output.have_study && output.current_opts_h5 === false", - fluidRow( - column(12, - h3("writeAntaresH5 parameters"), - fluidRow( - column(6, - directoryInput('output_h5', label = 'Select where study will be write', - value = getwd())), - - column(3, - selectInput("timeSteps_h5", label = "timeStep :", - choices = c("hourly", "daily", "weekly","monthly", "annual"), - multiple = TRUE, selected = "hourly")) - ), - - - fluidRow( - column(3, - checkboxInput("overwrite_h5", label = "overwrite" , TRUE)), - column(3, - checkboxInput("writeMcAll_h5", label = "writeMcAll" , TRUE) - ) - - ), - - fluidRow( - - column(3, - checkboxInput("misc_h5", label = "misc") - ), - column(3, - checkboxInput("thermalAvailabilities_h5", label = "thermalAvailabilities") - ), - column(3, - checkboxInput("mustRun_h5", label = "mustRun") - ), - column(3, - checkboxInput("thermalModulation_h5", label = "thermalModulation") - ) - ) - , - fluidRow( - column(3, - checkboxInput("hydroStorage_h5", label = "hydroStorage") - ), - column(3, - checkboxInput("hydroStorageMaxPower_h5", label = "hydroStorageMaxPower") - ), - column(3, - checkboxInput("reserve_h5", label = "reserve") - ), - column(3, - checkboxInput("linkCapacity_h5", label = "linkCapacity") - ) - ), - fluidRow( - column(12, - div(actionButton("write_h5", "Convert study to h5", icon = icon("floppy-o")), align = "center") ) - ) - ) - ) - ), - conditionalPanel(condition = "output.have_study && output.current_opts_h5 === true", - h3("Already a .h5 study...!") - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/04_ui_analysis.R b/inst/application/src/ui/04_ui_analysis.R deleted file mode 100644 index 69341e0..0000000 --- a/inst/application/src/ui/04_ui_analysis.R +++ /dev/null @@ -1,31 +0,0 @@ -tabPanel("Analysis", - conditionalPanel(condition = "output.have_data === true", - div(h3("Analysis parameters"), align = "center"), - h3("Studies :"), - uiOutput("info_list"), - h3("Compare :"), - fluidRow( - - column(3, - selectInput("sel_compare_prodstack", "prodStack :", choices = .global_compare_prodstack, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("sel_compare_exchangesStack", "exchangesStack :", choices = .global_compare_exchangesStack, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("sel_compare_tsPlot", "tsPlot : ", choices = .global_compare_tsPlot, selected = NULL, multiple = TRUE) - ), - column(3, - selectInput("sel_compare_plotMap", "plotMap :", choices = .global_compare_plotMap, selected = NULL, multiple = TRUE) - ) - ), - - checkboxInput("sel_compare_mcyear", "mcYear on all modules ?", FALSE), - - br(), - div(actionButton("update_module", "Launch Analysis", icon = icon("upload")), align = "center") - ), - conditionalPanel(condition = "output.have_data === false", - h3("No data imported from 'Import Data' panel", style = "color : red") - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/05_ui_prodstack.R b/inst/application/src/ui/05_ui_prodstack.R deleted file mode 100644 index 10a7ee4..0000000 --- a/inst/application/src/ui/05_ui_prodstack.R +++ /dev/null @@ -1,17 +0,0 @@ -tabPanel("prodStack", - fluidRow( - column(12, - conditionalPanel(condition = "output.have_data", - conditionalPanel(condition = "output.have_data_areas", - uiOutput("prodStack_ui") - ), - conditionalPanel(condition = "output.have_data_areas === false", - h3("No areas imported") - ) - ), - conditionalPanel(condition = "output.have_data === false", - h3("No data imported") - ) - ) - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/06_ui_exchange.R b/inst/application/src/ui/06_ui_exchange.R deleted file mode 100644 index 1154103..0000000 --- a/inst/application/src/ui/06_ui_exchange.R +++ /dev/null @@ -1,17 +0,0 @@ -tabPanel("exchangesStack", - fluidRow( - column(12, - conditionalPanel(condition = "output.have_data", - conditionalPanel(condition = "output.have_data_links", - uiOutput("exchangesStack_ui") - ), - conditionalPanel(condition = "output.have_data_links === false", - h3("No links imported") - ) - ), - conditionalPanel(condition = "output.have_data === false", - h3("No data imported") - ) - ) - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/07_ui_tsplot.R b/inst/application/src/ui/07_ui_tsplot.R deleted file mode 100644 index a3948dc..0000000 --- a/inst/application/src/ui/07_ui_tsplot.R +++ /dev/null @@ -1,17 +0,0 @@ -tabPanel("tsPlot", - fluidRow( - column(12, - conditionalPanel(condition = "output.have_data", - conditionalPanel(condition = "output.have_data_areas", - uiOutput("plotts_ui") - ), - conditionalPanel(condition = "output.have_data_areas === false", - h3("No areas imported") - ) - ), - conditionalPanel(condition = "output.have_data === false", - h3("No data imported") - ) - ) - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/08_ui_map.R b/inst/application/src/ui/08_ui_map.R deleted file mode 100644 index ae5840f..0000000 --- a/inst/application/src/ui/08_ui_map.R +++ /dev/null @@ -1,62 +0,0 @@ -navbarMenu("plotMap", - tabPanel("Layout Builder", - fluidRow( - column(12, - conditionalPanel(condition = "output.have_data", - antaresViz:::changeCoordsUI("ml") - ), - conditionalPanel(condition = "output.have_data === false", - h3("No data imported") - ) - - ) - ) - ), - tabPanel("Current Layout", - fluidRow( - column(12, - conditionalPanel(condition = "output.must_print_map", - div(h3("Current map layout"), align = "center"), - leafletDragPointsOutput("current_layout", height = "700px") - ), - conditionalPanel(condition = "output.must_print_map === false", - h3("Please set or import a map layout before.") - ), - hr(), - fluidRow( - column(6, - - conditionalPanel(condition = "output.must_print_map", - div(br(), downloadButton('download_layout', 'Download Layout'), align = "center") - ) - - ), - column(6, - div(fileInput("import_layout", "Import a layout", - accept = c(".RDS", ".rds", ".Rds") - ), align = "center") - ) - ) - - ) - ) - - ), - tabPanel("Map", - fluidRow( - column(12, - conditionalPanel(condition = "output.have_data", - conditionalPanel(condition = "output.must_print_map", - uiOutput("plotMap_ui") - ), - conditionalPanel(condition = "output.must_print_map === false", - h3("Please set or import a map layout before.") - ) - ), - conditionalPanel(condition = "output.have_data === false", - h3("No data imported") - ) - ) - ) - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/09_ui_params.R b/inst/application/src/ui/09_ui_params.R deleted file mode 100644 index 07d576d..0000000 --- a/inst/application/src/ui/09_ui_params.R +++ /dev/null @@ -1,20 +0,0 @@ -tabPanel("Parameters", - fluidRow( - column(2, checkboxInput("is_shared_input", label = "Share inputs between modules ?", value = TRUE)), - column(2, h4("readAntares RAM limit (in Go) : ")), - column(3, div(numericInput("ram_limit", label = NULL, - min = 1, max = 10, value = { - if(!is.null(getOption("maxSizeLoad"))){ - getOption("maxSizeLoad") - } else {10} - }), align = "center")), - column(2, h4("antaresViz data module (in Mb) : ")), - column(3, div(numericInput("data_module", label = NULL, - min = 1, max = 10, value = { - if(!is.null(getOption("antaresVizSizeGraph"))){ - getOption("antaresVizSizeGraph") - } else {200} - }), align = "center")) - - ) -) \ No newline at end of file diff --git a/inst/application/src/ui/10_ui_help.R b/inst/application/src/ui/10_ui_help.R deleted file mode 100644 index c037a67..0000000 --- a/inst/application/src/ui/10_ui_help.R +++ /dev/null @@ -1,26 +0,0 @@ -tabPanel("Help", - fluidRow( - column(width = 12, - HTML(text = "For any questions, please contact RTE-ANTARES-RPACKAGE Team .
"), - tabsetPanel( - tabPanel("R function readAntares", - fluidRow( - column(12, includeHTML("www/readAntares.html")) - ) - ), - tabPanel("R function removeVirtualAreas", - fluidRow( - column(12, includeHTML("www/removeVirtualAreas.html")) - ) - ), - tabPanel("R function writeAntaresH5", - fluidRow( - column(12, includeHTML("www/writeAntaresH5.html")) - ) - ) - ) - - ) - - ) -) \ No newline at end of file diff --git a/inst/application/ui.R b/inst/application/ui.R deleted file mode 100644 index 6bd73aa..0000000 --- a/inst/application/ui.R +++ /dev/null @@ -1,38 +0,0 @@ -# Define UI for antaresViz app -navbarPage(title = "antaresViz", id = "nav-id", inverse= TRUE, collapsible = TRUE, position = "fixed-top", - header = fluidRow( - column(12, - br(), br(), br(), - singleton(tags$script(src = 'events.js')), - 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( - column(12, - tabsetPanel(id = "tab_data", - source("src/ui/01_ui_import_data.R", local = T)$value, - source("src/ui/04_ui_analysis.R", local = T)$value - ) - ) - ) - ), - - source("src/ui/05_ui_prodstack.R", local = T)$value, - - source("src/ui/06_ui_exchange.R", local = T)$value, - - source("src/ui/07_ui_tsplot.R", local = T)$value, - - source("src/ui/08_ui_map.R", local = T)$value, - - source("src/ui/09_ui_params.R", local = T)$value, - - source("src/ui/10_ui_help.R", local = T)$value, - - footer = div(hr(), actionButton("quit", "Quit application", icon = icon("sign-out")), align = "center") -) - - - diff --git a/inst/application/www/events.js b/inst/application/www/events.js deleted file mode 100644 index dfeb11f..0000000 --- a/inst/application/www/events.js +++ /dev/null @@ -1,13 +0,0 @@ -$(function() { - $(document).on({ - - 'shiny:busy': function(event) { - $('#import_busy').css("visibility", "visible"); - }, - - 'shiny:idle': function(event) { - $('#import_busy').css("visibility", "hidden"); - } - }); - -}); \ No newline at end of file diff --git a/inst/application/www/js/directory_input_binding.js b/inst/application/www/js/directory_input_binding.js deleted file mode 100644 index f4decc7..0000000 --- a/inst/application/www/js/directory_input_binding.js +++ /dev/null @@ -1,57 +0,0 @@ -(function() { -/** - * Shiny Registration - */ - -var directoryInputBinding = new Shiny.InputBinding(); -$.extend(directoryInputBinding, { - find: function(scope) { - return( $(scope).find(".directory-input") ); - }, - initialize: function(el) { - // called when document is ready using initial values defined in ui.R - // documented in input_binding.js but not in docs (articles) - }, - getId: function(el) { - return($(el).attr('id')); - }, - getValue: function(el) { - return($(el).data('val') || 0); - }, - setValue: function(el, value) { - $(el).data('val', value); - }, - receiveMessage: function(el, data) { - // This is used for receiving messages that tell the input object to do - // things, such as setting values (including min, max, and others). - // documented in input_binding.js but not in docs (articles) - var $widget = $(el).parentsUntil('.directory-input-container').parent(); - var $path = $widget.find('input.directory-input-chosen-dir'); - - console.log('message received: ' + data.chosen_dir); - - if (data.chosen_dir) { - $path.val(data.chosen_dir); - $path.trigger('change'); - } - }, - subscribe: function(el, callback) { - $(el).on("click.directoryInputBinding", function(e) { - var $el = $(this); - var val = $el.data('val') || 0; - $el.data('val', val + 1); - - console.log('in subscribe: click'); - callback(); - }); - }, - unsubscribe: function(el) { - $(el).off(".directoryInputBinding"); - } -}); - -Shiny.inputBindings - .register(directoryInputBinding, "oddhypothesis.directoryInputBinding"); - - -})(); diff --git a/inst/application/www/readAntares.html b/inst/application/www/readAntares.html deleted file mode 100644 index d7fc0ea..0000000 --- a/inst/application/www/readAntares.html +++ /dev/null @@ -1,274 +0,0 @@ -R: Read the data of an Antares simulation - - - - -
readAntaresR Documentation
- -

Read the data of an Antares simulation

- -

Description

- -

readAntares is a swiss-army-knife function used to read almost every -possible time series of an antares Project at any desired time resolution -(hourly, daily, weekly, monthly or annual). -

-

It was first designed to read -output time series, but it can also read input time series. The input time -series are processed by the function to fit the query of the user (timeStep, -synthetic results or Monte-Carlo simulation, etc.). The few data that are not -read by readAntares can generally by read with other functions of the -package starting with "read" (readClusterDesc, -readLayout, readBindingConstraints) -

- - -

Usage

- -
-readAntares(areas = NULL, links = NULL, clusters = NULL,
-  districts = NULL, misc = FALSE, thermalAvailabilities = FALSE,
-  hydroStorage = FALSE, hydroStorageMaxPower = FALSE, reserve = FALSE,
-  linkCapacity = FALSE, mustRun = FALSE, thermalModulation = FALSE,
-  select = NULL, mcYears = NULL, timeStep = c("hourly", "daily", "weekly",
-  "monthly", "annual"), opts = simOptions(), parallel = FALSE,
-  simplify = TRUE, showProgress = TRUE)
-
- - -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
areas -

Vector containing the names of the areas to import. If -NULL no area is imported. The special value "all" tells the -function to import all areas. By default, the value is "all" when no other argument is enter and "NULL" when other arguments are enter.

-
links -

Vector containing the name of links to import. If NULL no -area is imported. The special value "all" tells the function to -import all areas. Use function getLinks to import all links -connected to some areas.

-
clusters -

Vector containing the name of the areas for which you want to -import results at cluster level. If NULL no cluster is imported. The -special value "all" tells the function to import clusters from all -areas.

-
districts -

Vector containing the names of the districts to import. If NULL, -no district is imported. The special value "all" tells the function to import all -districts.

-
misc -

Vector containing the name of the areas for which you want to -import misc.

-
thermalAvailabilities -

Should thermal availabilities of clusters be imported ? If TRUE, the column -"thermalAvailability" is added to the result and a new column "availableUnits" -containing the number of available units in a cluster is created.If synthesis is set to TRUE then -"availableUnits" contain the mean of avaible units on all MC Years.

-
hydroStorage -

Should hydro storage be imported ?

-
hydroStorageMaxPower -

Should hydro storage maximum power be imported ?

-
reserve -

Should reserve be imported ?

-
linkCapacity -

Should link capacities be imported ?

-
mustRun -

Should must run productions be added to the result? If TRUE, -then four columns are added: mustRun contains the production of -clusters that are in complete must run mode; mustRunPartial -contains the partial must run production of clusters; mustRunTotal -is the sum of the two previous columns. Finally thermalPmin is -similar to mustRunTotal except it also takes into account the production -induced by the minimum stable power of the units of a cluster. More -precisely, for a given cluster and a given time step, it is equal to -min(NODU x min.stable.power, mustRunTotal).

-
thermalModulation -

Should thermal modulation time series be imported ? If TRUE, the -columns "marginalCostModulation", "marketBidModulation", "capacityModulation" -and "minGenModulation" are added to the cluster data.

-
select -

Character vector containing the name of the columns to import. If this -argument is NULL, all variables are imported. Special names -"allAreas" and "allLinks" indicate to the function to import -all variables for areas or for links. Since version 1.0, values "misc", -"thermalAvailabilities", "hydroStorage", "hydroStorageMaxPower", "reserve", -"linkCapacity", "mustRun", "thermalModulation" are also accepted and can -replace the corresponding arguments. The list of available variables can be -seen with the command simOptions()$variables. Id variables like -area, link or timeId are automatically imported.

-
mcYears -

Index of the Monte-Carlo years to import. If NULL, synthetic results -are read, else the specified Monte-Carlo simulations are imported. The -special value all tells the function to import all Monte-Carlo -simulations.

-
timeStep -

Resolution of the data to import: hourly (default), daily, -weekly, monthly or annual.

-
opts -

list of simulation parameters returned by the function -setSimulationPath

-
parallel -

Should the importation be parallelized ? (See details)

-
simplify -

If TRUE and only one type of output is imported then a -data.table is returned. If FALSE, the result will always be a list of class -"antaresData".

-
showProgress -

If TRUE the function displays information about the progress of the -importation.

-
- - -

Details

- -

If parameters areas, links, clusters and districts -are all NULL, readAntares will read output for all areas. -By default the function reads synthetic results if they are available. -

-

readAntares is able to read input time series, but when they are not -stored in output, these time series may have changed since a simulation has -been run. In such a case the function will remind you this danger with a -warning. -

-

When individual Monte-Carlo simulations are read, the function may crash -because of insufficient memory. In such a case, it is necessary to reduce -size of the output. Different strategies are available depending on your -objective: -

- -
    -

  • Use a larger time step (parameter timeStep) -

    -
    • -

  • Filter the elements to import (parameters areas,links, -clusters and districts) -

    -
    • -

  • Select only a few columns (parameter select) -

    -
    • -

  • read only a subset of Monte-Carlo simulations (parameter -mcYears). For instance one can import a random sample of -100 simulations with mcYears = sample(simOptions()$mcYears, 100) -

    -
- - - -

Value

- -

If simplify = TRUE and only one type of output is imported -then the result is a data.table. -

-

Else an object of class "antaresDataList" is returned. It is a list of -data.tables, each element representing one type of element (areas, links, -clusters) -

- - -

Parallelization

- -

If you import several elements of the same type (areas, links, clusters), you -can use parallelized importation to improve performance. Setting the -parameter parallel = TRUE is not enough to parallelize the -importation, you also have to install the package -foreach -and a package that provides a parallel backend (for instance the package -doParallel). -

-

Before running the function with argument parallel=TRUE, you need to -register your parallel backend. For instance, if you use package "doParallel" -you need to use the function registerDoParallel once per -session. -

- - -

See Also

- -

setSimulationPath, getAreas, -getLinks, getDistricts -

- - -

Examples

- -
-## Not run: 
-# Import areas and links separately
-
-areas <- readAntares() # equivalent to readAntares(areas="all")
-links <- readAntares(links="all")
-
-# Import areas and links at same time
-
-output <- readAntares(areas = "all", links = "all")
-
-# Add input time series to the object returned by the function
-areas <- readAntares(areas = "all", misc = TRUE, reserve = TRUE)
-
-# Get all output for one area
-
-myArea <- sample(simOptions()$areaList, 1)
-myArea
-
-myAreaOutput <- readAntares(area = myArea,
-                            links = getLinks(myArea, regexpSelect=FALSE),
-                            clusters = myArea)
-
-# Or equivalently:
-myAreaOutput <- readAntaresAreas(myArea)
-
-# Use parameter "select" to read only some columns.
-
-areas <- readAntares(select = c("LOAD", "OV. COST"))
-
-# Aliases can be used to select frequent groups of columns. use showAliases()
-# to view a list of available aliases
-
-areas <- readAntares(select="economy")
-
-
-## End(Not run)
-
- - - diff --git a/inst/application/www/removeVirtualAreas.html b/inst/application/www/removeVirtualAreas.html deleted file mode 100644 index 842c7fb..0000000 --- a/inst/application/www/removeVirtualAreas.html +++ /dev/null @@ -1,178 +0,0 @@ -R: Remove virtual areas - - - - -
removeVirtualAreasR Documentation
- -

Remove virtual areas

- -

Description

- -

This function removes virtual areas from an antaresDataList object and -corrects the data for the real areas. The antaresDataList object -should contain area and link data to function correctly. -

- - -

Usage

- -
-removeVirtualAreas(x, storageFlexibility = NULL, production = NULL,
-  reassignCosts = FALSE, newCols = TRUE)
-
- - -

Arguments

- - - - - - - - - - - - -
x -

An object of class antaresDataList with at least components -areas and links.

-
storageFlexibility -

A vector containing the names of the virtual -storage/flexibility areas.

-
production -

A vector containing the names of the virtual production -areas.

-
reassignCosts -

If TRUE, the production costs of the virtual areas are -reallocated to the real areas they are connected to. If the virtual areas -are connected to a virtual hub, their costs are first reallocated to the -hub and then the costs of the hub are reallocated to the real areas.

-
newCols -

If TRUE, new columns containing the production of the virtual -areas are added. If FALSE their production is added to the production of -the real areas they are connected to.

-
- - -

Details

- -

Two types of virtual areas have been defined corresponding to different types -of modeling in Antares and different types of post-treatment to do: -

- -
    -

  • Flexibility/storage areas are areas created to model -pumping unit or any other flexibility that behave as a storage. For those -virtual areas, the important results are flows on the links. -

    -
    • -

  • Production areas are areas created to isolate some generation from -the "real" areas. They can be isolate for several reasons: to distinguish -time-series (for example wind onshore/offshore), to select some specific -unit to participate to day-ahead reserve, etc. -

    -
- -

removeVirtualAreas performs different corrections: -

- -
    -

  • Correct the balance of the real areas by removing the flows -to or from virtual areas. -

    -
    • -

  • If parameter reassignCosts is TRUE, then the costs of the -virtual areas are reassigned to the real areas they are connected to. The -affected columns are OV. COST, OP. COST, CO2 EMIS. -and NP COST. If a virtual area is connected to a single real area, -all its costs are attributed to the real area. If it is connected to -several real areas, then costs at a given time step are divided between -them proportionally to the flows between them and the virtual area. -

    -
    • -

  • For each storage/flexibility area, a column named like the area is -created. It contains the values of the flow between the virtual area and -the real areas. This column is interpreted as a production of -electricity: it is positive if the flow from the virtual area to the real -area is positive and negative otherwise. If parameter newCols is -FALSE, the values are added to the variable PSP and the -columns is removed. -

    -
    • -

  • If the parameter production is specified, then the non null -productions of the virtual areas are either added to the ones of the real -areas they are connected to if newCols = FALSE or put in new -columns if newCols = TRUE. In the second case the columns are -named *_virtual where "*" is a type of -production (wind, solar, nuclear, ...). Productions that are zero for -all virtual areas are omited. -If virtual production areas contains clusters then they will be move to the -real area. -

    -
    • -

  • Finally, virtual areas and the links connected to them are removed -from the data. -

    -
- -

The functions makes a few assumptions about the network. if they are -violated it will not act correctly: -

- -
    -

  • storage/flexibility -areas can be connected to other storage/flexibility areas (hubs), but at -least one of them is connected to a real area. That means that there is -no group of virtual areas disconnected from the real network. If such a -group exists, you can either remove them manually or simply not import -them. -

    -
    • -

  • production areas are connected to one and only one real area. They -cannot be connected to virtual areas. But a real area may by connected to -several production areas. -

    -
- - - -

Value

- -

An antaresDataList object in which virtual areas have been removed and -data of the real has been corrected. See details for an explanation of the -corrections. -

- - -

Examples

- -
-## Not run: 
-
-# Assume we have a network with two virtual areas acting as pump storage and
-# an area representing offshore production
-#
-#  offshore
-#     |
-# real area - psp in
-#           \
-#             psp out
-#
-
-data <- readAntares(areas="all", links="all")
-
-# Remove pump storage virtual areas
-
-correctedData <- removeVirtualAreas(data, 
-                                    storageFlexibility = c("psp in", "psp out"),
-                                    production = "offshore")
-
-## End(Not run)
-
-
- - - diff --git a/inst/application/www/spinner.gif b/inst/application/www/spinner.gif deleted file mode 100644 index d79561d..0000000 Binary files a/inst/application/www/spinner.gif and /dev/null differ diff --git a/inst/application/www/writeAntaresH5.html b/inst/application/www/writeAntaresH5.html deleted file mode 100644 index addf33a..0000000 --- a/inst/application/www/writeAntaresH5.html +++ /dev/null @@ -1,161 +0,0 @@ -R: Convert antares output to h5 file - - - - -
writeAntaresH5R Documentation
- -

Convert antares output to h5 file

- -

Description

- -

Convert antares output to h5 file -

- - -

Usage

- -
-writeAntaresH5(path = getwd(), timeSteps = c("hourly", "daily", "weekly",
-  "monthly", "annual"), opts = simOptions(), writeMcAll = TRUE,
-  compress = 1, misc = FALSE, thermalAvailabilities = FALSE,
-  hydroStorage = FALSE, hydroStorageMaxPower = FALSE, reserve = FALSE,
-  linkCapacity = FALSE, mustRun = FALSE, thermalModulation = FALSE,
-  allData = FALSE, writeAllSimulations = FALSE, nbCores = 4,
-  removeVirtualAreas = FALSE, storageFlexibility = NULL,
-  production = NULL, reassignCosts = FALSE, newCols = TRUE,
-  overwrite = FALSE, supressMessages = FALSE)
-
- - -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
path -

character folder where h5 file will be write (default getwd())

-
timeSteps -

character timeSteps

-
opts -

list of simulation parameters returned by the function setSimulationPath. Defaut to antaresRead::simOptions()

-
writeMcAll -

boolean write mc-all

-
compress -

numeric compress level

-
misc -

boolean see readAntares

-
thermalAvailabilities -

boolean see readAntares

-
hydroStorage -

boolean see readAntares

-
hydroStorageMaxPower -

boolean see readAntares

-
reserve -

boolean see readAntares

-
linkCapacity -

boolean see readAntares

-
mustRun -

boolean see readAntares

-
thermalModulation -

boolean see readAntares

-
allData -

boolean add all data with a single call (writeMcAll, misc, thermalAvailabilities, hydroStorage, hydroStorageMaxPower -reserve, linkCapacity, mustRun, thermalModulation).

-
writeAllSimulations -

boolean, write all simulations of your antares study.

-
nbCores -

numeric, number of cores to use, only used if writeAllSimulations is TRUE

-
removeVirtualAreas -

boolean, remove virtual areas, see removeVirtualAreas

-
storageFlexibility -

character, see removeVirtualAreas

-
production -

character, see removeVirtualAreas

-
reassignCosts -

boolean, see removeVirtualAreas

-
newCols -

boolean, see removeVirtualAreas

-
overwrite -

boolean, overwrite old file

-
supressMessages -

boolean, supress messages from readAntares and removeVirtualAreas

-
- - -

Examples

- -
-
-## Not run: 
-# Write simulation one by one
-setSimulationPath("C:/Users/MyUser/Mystudy", 1)
-writeAntaresH5()
-
-# Write all simulations
-setSimulationPath("C:/Users/MyUser/Mystudy")
-writeAntaresH5(writeAllSimulations = TRUE)
-
-# Choose timestep to write
-setSimulationPath("C:/Users/MyUser/Mystudy", 1)
-writeAntaresH5(timeSteps = "hourly")
-
-# Write with additionnal information
-writeAntaresH5(timeSteps = "hourly",
-   misc = TRUE, thermalAvailabilities = TRUE,
-   hydroStorage = TRUE, hydroStorageMaxPower = TRUE, reserve = TRUE,
-   linkCapacity = TRUE, mustRun = TRUE, thermalModulation = TRUE)
-
-# Write all data with a shorcut 
-writeAntaresH5(allData = TRUE)
-
-
-## End(Not run)
-
- - - diff --git a/inst/color.csv b/inst/color.csv deleted file mode 100644 index b2dcc13..0000000 --- a/inst/color.csv +++ /dev/null @@ -1,21 +0,0 @@ -red;green;blue;Column -17;71;185;PSP -120;136;194;mustRunTotal -120;236;194;mustRunPartial -220;236;94;mustRun -22;106;87;MISC. NDG -116;205;185;WIND -242;116;6;SOLAR -245;179;0;NUCLEAR -243;10;10;GAS -172;140;53;COAL -135;86;39;LOAD -39;114;178;H. STOR -180;130;43;LIGNITE -131;86;162;OIL -127;84;156;MIX. FUEL -173;255;47;MISC. DTG -61;96;125;H. ROR -84;151;208;H. STOR -101;180;197;netLoad -1;1;1;AVL DTG diff --git a/inst/htmlwidgets/leafletDragPoints.js b/inst/htmlwidgets/leafletDragPoints.js index b3de06f..8e6041a 100644 --- a/inst/htmlwidgets/leafletDragPoints.js +++ b/inst/htmlwidgets/leafletDragPoints.js @@ -14,22 +14,14 @@ HTMLWidgets.widget({ ).addTo(map); var points = []; - var mapLayer; - var markersLayer = []; - - function clear_polyline() { - map.removeLayer( linesFeatureLayer ); - } // Function that updates shiny input function updateShinyInput() { var coords = points.map(function(p) { return p.marker.getLatLng(); }); - if(HTMLWidgets.shinyMode){ - Shiny.onInputChange(el.id + "_coords", coords); - Shiny.onInputChange(el.id + "_mapcenter", map.getCenter()); - } + Shiny.onInputChange(el.id + "_coords", coords); + Shiny.onInputChange(el.id + "_mapcenter", map.getCenter()); } map.on("moveend", updateShinyInput); @@ -40,66 +32,37 @@ HTMLWidgets.widget({ return { renderValue: function(x) { - if(x.init){ - for(var i=0;i\% - addTiles() \%>\% - addFlows(0, 0, 1, 0, col= gray(0.9)) \%>\% - addCircleMarkers(c(0, 1), c(0, 0), color = "white", fillOpacity = 1, stroke = FALSE) \%>\% - addShadows() - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map_plugins.R +\name{addShadows} +\alias{addShadows} +\title{Add a shadow to map layers} +\usage{ +addShadows(map) +} +\arguments{ +\item{map}{A leaflet map object.} +} +\value{ +The modified map object +} +\description{ +This function adds a shadow to every svg element added to a leaflet map. It +can greatly improve the lisibility of the map. +} +\examples{ +require(leaflet) +require(leaflet.minicharts) + +leaflet() \%>\% + addTiles() \%>\% + addFlows(0, 0, 1, 0, col= gray(0.9)) \%>\% + addCircleMarkers(c(0, 1), c(0, 0), color = "white", fillOpacity = 1, stroke = FALSE) \%>\% + addShadows() + +} diff --git a/man/exchangesStack.Rd b/man/exchangesStack.Rd index ad632ea..d0664e3 100644 --- a/man/exchangesStack.Rd +++ b/man/exchangesStack.Rd @@ -1,134 +1,95 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stack_exchanges.R -\name{exchangesStack} -\alias{exchangesStack} -\title{Plot the exchanges of an area} -\usage{ -exchangesStack(x, area = NULL, mcYear = "average", dateRange = NULL, - colors = NULL, main = NULL, ylab = NULL, unit = c("MWh", "GWh", - "TWh"), compare = NULL, compareOpts = list(), - interactive = getInteractivity(), legend = TRUE, - legendId = sample(1000000000, 1), groupId = legendId, - legendItemsPerRow = 5, width = NULL, height = NULL, - xyCompare = c("union", "intersect"), h5requestFiltering = list(), - stepPlot = FALSE, drawPoints = FALSE, timeSteph5 = "hourly", - mcYearh5 = NULL, tablesh5 = c("areas", "links"), ...) -} -\arguments{ -\item{x}{Object of class \code{antaresData} created with function -\code{\link[antaresRead]{readAntares}}. It is required to contain link data. -If it also contains area data with column `ROW BAL.`, then exchanges with -the rest of the world are also displayed on the chart.} - -\item{area}{Name of a single area. The flows from/to this area will be drawn by the -function.} - -\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter -determine which scenario is displayed. Must be an integer representing the -index of the scenario or the word "average". In this case data are -averaged.} - -\item{dateRange}{A vector of two dates. Only data points between these two dates are -displayed. If NULL, then all data is displayed.} - -\item{colors}{Vector of colors with same length as parameter \code{variables}. If -\code{variables} is an alias, then this argument should be \code{NULL} in -order to use default colors.} - -\item{main}{Title of the graph.} - -\item{ylab}{Title of the Y-axis.} - -\item{unit}{Unit used in the graph. Possible values are "MWh", "GWh" or "TWh".} - -\item{compare}{An optional character vector containing names of parameters. When it is set, -two charts are outputed with their own input controls. Alternatively, it can -be a named list with names corresponding to parameter names and values being -list with the initial values of the given parameter for each chart. See details - if you are drawing a map.} - -\item{compareOpts}{List of options that indicates the number of charts to create and their -position. Check out the documentation of -\code{\link[manipulateWidget]{compareOptions}} to see available options.} - -\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets -the user interactively choose the areas or districts to display.} - -\item{legend}{Logical value indicating if a legend should be drawn. This argument is -usefull when one wants to create a shared legend with -\code{\link{prodStackLegend}}} - -\item{legendId}{Id of the legend linked to the graph. This argument is -usefull when one wants to create a shared legend with -\code{\link{prodStackLegend}}} - -\item{groupId}{Parameter that can be used to synchronize the horizontal -zoom of multiple charts. All charts that need to be synchronized must -have the same group.} - -\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} - -\item{width}{Width of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{height}{Height of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{xyCompare}{Use when you compare studies, can be "union" or "intersect". If union, all -of mcYears in one of studies will be selectable. If intersect, only mcYears in all -studies will be selectable.} - -\item{h5requestFiltering}{Contains arguments used by default for h5 request, -typically h5requestFiltering = list(select = "NUCLEAR")} - -\item{stepPlot}{\code{boolean}, step style for curves.} - -\item{drawPoints}{\code{boolean}, add points on graph} - -\item{timeSteph5}{\code{character} timeStep to read in h5 file. Only for Non interactive mode.} - -\item{mcYearh5}{\code{numeric} mcYear to read for h5. Only for Non interactive mode.} - -\item{tablesh5}{\code{character} tables for h5 ("areas" "links", "clusters" or "disticts"). Only for Non interactive mode.} - -\item{...}{Other arguments for \code{\link{manipulateWidget}}} -} -\value{ -A htmlwidget of class \code{dygraph}. It can be modified with functions from -package \code{dygraphs}. -} -\description{ -This function draws a stack representing the evolution of the exchanges of -an area with its neighbours. Positive values denotes exports and negative -values imports. -} -\details{ -Compare argument can take following values : -\itemize{ - \item "mcYear" - \item "main" - \item "unit" - \item "area" - \item "legend" - \item "stepPlot" - \item "drawPoints" - } -} -\examples{ -\dontrun{ -mydata <- readAntares(links = "all", timeStep = "daily") -exchangesStack(mydata) - -# Also display exchanges with the rest of the world -mydata <- readAntares(areas = "all", links = "all", timeStep = "daily") -exchangesStack(mydata) - -# Use compare : -exchangesStack(mydata, compare = "mcYear") -exchangesStack(mydata, compare = "area") -exchangesStack(mydata, compare = "unit") -exchangesStack(mydata, compare = "legend") - -} - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stack_exchanges.R +\name{exchangesStack} +\alias{exchangesStack} +\title{Plot the exchanges of an area} +\usage{ +exchangesStack(x, y = NULL, area = NULL, mcYear = "average", + dateRange = NULL, colors = NULL, main = NULL, ylab = NULL, + unit = c("MWh", "GWh", "TWh"), compare = NULL, compareOpts = list(), + interactive = getInteractivity(), legend = TRUE, + legendId = sample(1e+09, 1), groupId = legendId, legendItemsPerRow = 5, + width = NULL, height = NULL) +} +\arguments{ +\item{x}{Object of class \code{antaresData} created with function +\code{\link[antaresRead]{readAntares}}. It is required to contain link data. +If it also contains area data with column `ROW BAL.`, then exchanges with +the rest of the world are also displayed on the chart.} + +\item{y}{Optional object of class \code{antaresData}. If it is specified, then two +charts are generated.} + +\item{area}{Name of a single area. The flows from/to this area will be drawn by the +function.} + +\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter +determine which scenario is displayed. Must be an integer representing the +index of the scenario or the word "average". In this case data are +averaged.} + +\item{dateRange}{A vector of two dates. Only data points between these two dates are +displayed. If NULL, then all data is displayed.} + +\item{colors}{Vector of colors with same length as parameter \code{variables}. If +\code{variables} is an alias, then this argument should be \code{NULL} in +order to use default colors.} + +\item{main}{Title of the graph.} + +\item{ylab}{Title of the Y-axis.} + +\item{unit}{Unit used in the graph. Possible values are "MWh", "GWh" or "TWh".} + +\item{compare}{An optional character vector containing names of parameters. When it is set, +two charts are outputed with their own input controls. Alternatively, it can +be a named list with names corresponding to parameter names and values being +list with the initial values of the given parameter for each chart.} + +\item{compareOpts}{List of options that indicates the number of charts to create and their +position. Check out the documentation of +\code{\link[manipulateWidget]{compareOptions}} to see available options.} + +\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets +the user interactively choose the areas or districts to display.} + +\item{legend}{Logical value indicating if a legend should be drawn. This argument is +usefull when one wants to create a shared legend with +\code{\link{prodStackLegend}}} + +\item{legendId}{Id of the legend linked to the graph. This argument is +usefull when one wants to create a shared legend with +\code{\link{prodStackLegend}}} + +\item{groupId}{Parameter that can be used to synchronize the horizontal +zoom of multiple charts. All charts that need to be synchronized must +have the same group.} + +\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} + +\item{width}{Width of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{height}{Height of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} +} +\value{ +A htmlwidget of class \code{dygraph}. It can be modified with functions from +package \code{dygraphs}. +} +\description{ +This function draws a stack representing the evolution of the exchanges of +an area with its neighbours. Positive values denotes exports and negative +values imports. +} +\examples{ +\dontrun{ +mydata <- readAntares(links = "all", timeStep = "daily") +exchangeStack(mydata) + +# Also display exchanges with the rest of the world +mydata <- readAntares(areas = "all", links = "all", timeStep = "daily") +exchangesStack(mydata) +} + +} diff --git a/man/limitSizeGraph.Rd b/man/limitSizeGraph.Rd deleted file mode 100644 index e910573..0000000 --- a/man/limitSizeGraph.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/limitSizeGraph.R -\name{limitSizeGraph} -\alias{limitSizeGraph} -\title{Use to change limit size of graph (in Mb)} -\usage{ -limitSizeGraph(size) -} -\arguments{ -\item{size}{\code{numeric} widget size autorized in modules (default 200)} -} -\description{ -Use to change limit size of graph (in Mb) -} -\examples{ -\dontrun{ -limitSizeGraph(500) -} - -} diff --git a/man/mapLayout.Rd b/man/mapLayout.Rd index 5e8bff6..2729da2 100644 --- a/man/mapLayout.Rd +++ b/man/mapLayout.Rd @@ -1,48 +1,38 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map_layout.R -\name{mapLayout} -\alias{mapLayout} -\title{Place areas of a study on a map} -\usage{ -mapLayout(layout, what = c("areas", "districts"), map = getSpMaps(), - map_builder = TRUE) -} -\arguments{ -\item{layout}{object returned by function \code{\link[antaresRead]{readLayout}}} - -\item{what}{Either "areas" or "districts". Indicates what type of object to place -on the map.} - -\item{map}{An optional \code{\link[sp]{SpatialPolygons}} or -\code{\link[sp]{SpatialPolygonsDataFrame}} object. See \code{\link[spMaps]{getSpMaps}}} - -\item{map_builder}{\code{logical} Add inputs for build custom map ? Defaut to TRUE.} -} -\value{ -An object of class \code{mapLayout}. -} -\description{ -This function launches an interactive application that let the user place -areas of a study on a map. the GPS coordinates of the areas are then returned -and can be used in functions. This function should be used only once per -study. The result should then be saved in an external file and be reused. -} -\examples{ -\dontrun{ -# Read the coordinates of the areas in the Antares interface, then convert it -# in a map layout. -layout <- readLayout() -ml <- mapLayout(layout) - -# visualize mapLayout -plotMapLayout(ml) - -# Save the result for future use -save(ml, file = "ml.rda") - -} - -} -\seealso{ -\code{\link{plotMapLayout}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map_layout.R +\name{mapLayout} +\alias{mapLayout} +\title{Place areas of a study on a map} +\usage{ +mapLayout(layout, what = c("areas", "districts"), map = NULL) +} +\arguments{ +\item{layout}{object returned by function \code{\link[antaresRead]{readLayout}}} + +\item{what}{Either "areas" or "districts". Indicates what type of object to place +on the map.} + +\item{map}{An optional \code{\link[sp]{SpatialPolygons}} or +\code{\link[sp]{SpatialPolygonsDataFrame}} object.} +} +\value{ +An object of class \code{mapLayout}. +} +\description{ +This function launches an interactive application that let the user place +areas of a study on a map. the GPS coordinates of the areas are then returned +and can be used in functions. This function should be used only once per +study. The result should then be saved in an external file and be reused. +} +\examples{ +\dontrun{ +# Read the coordinates of the areas in the Antares interface, then convert it +# in a map layout. +layout <- readLayout() +ml <- mapLayout(layout) + +# Save the result for future use +save(ml, file = "ml.rda") +} + +} diff --git a/man/modRpart.Rd b/man/modRpart.Rd deleted file mode 100644 index efd6325..0000000 --- a/man/modRpart.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mod_rpart.R -\name{modRpart} -\alias{modRpart} -\title{Make rpart from antares data} -\usage{ -modRpart(data) -} -\arguments{ -\item{data}{an antaresData after use of \code{\link[antaresProcessing]{mergeAllAntaresData}}} -} -\description{ -Make rpart from antares data -} -\examples{ -\dontrun{ -setSimulationPath("Mystud", 1) -mydata <- readAntares(areas = "all", select = "OIL") -mydata <- mergeAllAntaresData(mydata) -modRpart(mydata) -} - -} diff --git a/man/modXY.Rd b/man/modXY.Rd deleted file mode 100644 index ac4606b..0000000 --- a/man/modXY.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mod_XY.R -\name{modXY} -\alias{modXY} -\title{Make X-Y bockey plot, interactive version} -\usage{ -modXY(x, xyCompare = c("union", "intersect")) -} -\arguments{ -\item{x}{optsH5 or list of optsH5} - -\item{xyCompare}{Use when you compare studies, can be "union" or "intersect". If union, all -of mcYears in one of studies will be selectable. If intersect, only mcYears in all -studies will be selectable.} -} -\description{ -Make X-Y bockey plot, interactive version -} -\examples{ -\dontrun{ -opts <- setSimulationPath("h5File") -modXY(opts) -modXY(list(opts, opts)) - -} - -} diff --git a/man/placeGeoPoints-shiny.Rd b/man/placeGeoPoints-shiny.Rd deleted file mode 100644 index 366c010..0000000 --- a/man/placeGeoPoints-shiny.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/leafletDragPoints.R -\name{placeGeoPoints-shiny} -\alias{placeGeoPoints-shiny} -\alias{leafletDragPointsOutput} -\alias{renderLeafletDragPoints} -\title{Shiny bindings for placeGeoPoints} -\usage{ -leafletDragPointsOutput(outputId, width = "100\%", height = "400px") - -renderLeafletDragPoints(expr, env = parent.frame(), quoted = FALSE) -} -\arguments{ -\item{outputId}{output variable to read from} - -\item{width, height}{Must be a valid CSS unit (like \code{'100\%'}, -\code{'400px'}, \code{'auto'}) or a number, which will be coerced to a -string and have \code{'px'} appended.} - -\item{expr}{An expression that generates a placeGeoPoints} - -\item{env}{The environment in which to evaluate \code{expr}.} - -\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This -is useful if you want to save an expression in a variable.} -} -\description{ -Output and render functions for using placeGeoPoints within Shiny -applications and interactive Rmd documents. -} diff --git a/man/plot.mapLayout.Rd b/man/plot.mapLayout.Rd index c148ec3..024c802 100644 --- a/man/plot.mapLayout.Rd +++ b/man/plot.mapLayout.Rd @@ -1,118 +1,118 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map_layout.R -\name{plot.mapLayout} -\alias{plot.mapLayout} -\title{Plot method for map layout} -\usage{ -\method{plot}{mapLayout}(x, colAreas = x$coords$color, dataAreas = 1, - opacityArea = 1, areaMaxSize = 30, areaMaxHeight = 50, - areaChartType = c("auto", "bar", "pie", "polar-area", "polar-radius"), - labelArea = NULL, labelMinSize = 8, labelMaxSize = 8, - colLinks = "#CCCCCC", sizeLinks = 3, opacityLinks = 1, dirLinks = 0, - links = TRUE, areas = TRUE, tilesURL = defaultTilesURL(), - preprocess = function(map) { map }, width = NULL, height = NULL, - ...) -} -\arguments{ -\item{x}{Object created with function \code{\link{mapLayout}}} - -\item{colAreas}{Vector of colors for areas. By default, the colors used in the Antares -software are used.} - -\item{dataAreas}{A numeric vector or a numeric matrix that is passed to function -\code{link[addMinicharts]}. A single vector will produce circles with -different radius. A matrix will produce bar charts or pie charts or -polar charts, depending on the value of \code{areaChartType}} - -\item{opacityArea}{Opacity of areas. It has to be a numeric vector with values -between 0 and 1.} - -\item{areaMaxSize}{Maximal width in pixels of the symbols that represent -areas on the map.} - -\item{areaMaxHeight}{Maximal height of bars. Used only if a barchart representation is used.} - -\item{areaChartType}{Type of chart to use to represent areas.} - -\item{labelArea}{Character vector containing labels to display inside areas.} - -\item{labelMinSize}{minimal height of labels.} - -\item{labelMaxSize}{maximal height of labels.} - -\item{colLinks}{Vector of colors for links.} - -\item{sizeLinks}{Line width of the links, in pixels.} - -\item{opacityLinks}{Opacity of the links. It has to be a numeric vector with values -between 0 and 1.} - -\item{dirLinks}{Single value or vector indicating the direction of the link. Possible values -are 0, -1 and 1. If it equals 0, then links are repsented by a simple line. -If it is equal to 1 or -1 it is represented by a line with an arrow pointing -respectively the destination and the origin of the link.} - -\item{links}{Should links be drawn on the map ?} - -\item{areas}{Should areas be drawn on the map ?} - -\item{tilesURL}{URL template used to get map tiles. The followign site -provides some URLs; -\url{https://leaflet-extras.github.io/leaflet-providers/preview/}} - -\item{preprocess}{A function that takes as argument a map and that returns a -modified version of this map. This parameter can be used to add extra -information on a map.} - -\item{width}{Width of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{height}{Height of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{...}{Currently unused.} -} -\value{ -The function generates an \code{htmlwidget} of class \code{leaflet}. It can - be stored in a variable and modified with package - \code{\link[leaflet]{leaflet}} -} -\description{ -This method can be used to visualize the network of an antares study. -It generates an interactive map with a visual representaiton of a -map layout created with function \code{\link{mapLayout}}. -} -\examples{ -\dontrun{ -# Read the coordinates of the areas in the Antares interface, then convert it -# in a map layout. -layout <- readLayout() -ml <- mapLayout(layout) - -# Save the result for future use -save(ml, file = "ml.rda") - -# Plot the network on an interactive map -plot(ml) - -# change style -plot(ml, colAreas = gray(0.5), colLinks = "orange") - -# Use polar area charts to represent multiple values for each area. -nareas <- nrow(ml$coords) -fakeData <- matrix(runif(nareas * 3), ncol = 3) -plot(ml, sizeAreas = fakeData) - -# Store the result in a variable to change it with functions from leaflet -# package -library(leaflet) - -center <- c(mean(ml$coords$x), mean(ml$coords$y)) - -p <- plot(ml) -p \%>\% - addCircleMarker(center[1], center[2], color = "red", - popup = "I'm the center !") -} - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map_layout.R +\name{plot.mapLayout} +\alias{plot.mapLayout} +\title{Plot method for map layout} +\usage{ +\method{plot}{mapLayout}(x, colAreas = x$coords$color, dataAreas = 1, + opacityArea = 1, areaMaxSize = 30, areaMaxHeight = 50, + areaChartType = c("auto", "bar", "pie", "polar-area", "polar-radius"), + labelArea = NULL, labelMinSize = 8, labelMaxSize = 8, + colLinks = "#CCCCCC", sizeLinks = 3, opacityLinks = 1, dirLinks = 0, + links = TRUE, areas = TRUE, tilesURL = defaultTilesURL(), + preprocess = function(map) { map }, width = NULL, height = NULL, + ...) +} +\arguments{ +\item{x}{Object created with function \code{\link{mapLayout}}} + +\item{colAreas}{Vector of colors for areas. By default, the colors used in the Antares +software are used.} + +\item{dataAreas}{A numeric vector or a numeric matrix that is passed to function +\code{link[addMinicharts]}. A single vector will produce circles with +different radius. A matrix will produce bar charts or pie charts or +polar charts, depending on the value of \code{areaChartType}} + +\item{opacityArea}{Opacity of areas. It has to be a numeric vector with values +between 0 and 1.} + +\item{areaMaxSize}{Maximal width in pixels of the symbols that represent +areas on the map.} + +\item{areaMaxHeight}{Maximal height of bars. Used only if a barchart representation is used.} + +\item{areaChartType}{Type of chart to use to represent areas.} + +\item{labelArea}{Character vector containing labels to display inside areas.} + +\item{labelMinSize}{minimal height of labels.} + +\item{labelMaxSize}{maximal height of labels.} + +\item{colLinks}{Vector of colors for links.} + +\item{sizeLinks}{Line width of the links, in pixels.} + +\item{opacityLinks}{Opacity of the links. It has to be a numeric vector with values +between 0 and 1.} + +\item{dirLinks}{Single value or vector indicating the direction of the link. Possible values +are 0, -1 and 1. If it equals 0, then links are repsented by a simple line. +If it is equal to 1 or -1 it is represented by a line with an arrow pointing +respectively the destination and the origin of the link.} + +\item{links}{Should links be drawn on the map ?} + +\item{areas}{Should areas be drawn on the map ?} + +\item{tilesURL}{URL template used to get map tiles. The followign site +provides some URLs; +\url{https://leaflet-extras.github.io/leaflet-providers/preview/}} + +\item{preprocess}{A function that takes as argument a map and that returns a +modified version of this map. This parameter can be used to add extra +information on a map.} + +\item{width}{Width of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{height}{Height of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{...}{Currently unused.} +} +\value{ +The function generates an \code{htmlwidget} of class \code{leaflet}. It can + be stored in a variable and modified with package + \code{\link[leaflet]{leaflet}} +} +\description{ +This method can be used to visualize the network of an antares study. +It generates an interactive map with a visual representaiton of a +map layout created with function \code{\link{mapLayout}}. +} +\examples{ +\dontrun{ +# Read the coordinates of the areas in the Antares interface, then convert it +# in a map layout. +layout <- readLayout() +ml <- mapLayout(layout) + +# Save the result for future use +save(ml, file = "ml.rda") + +# Plot the network on an interactive map +plot(ml) + +# change style +plot(ml, colAreas = gray(0.5), colLinks = "orange") + +# Use polar area charts to represent multiple values for each area. +nareas <- nrow(ml$coords) +fakeData <- matrix(runif(nareas * 3), ncol = 3) +plot(ml, sizeAreas = fakeData) + +# Store the result in a variable to change it with functions from leaflet +# package +library(leaflet) + +center <- c(mean(ml$coords$x), mean(ml$coords$y)) + +p <- plot(ml) +p \%>\% + addCircleMarker(center[1], center[2], color = "red", + popup = "I'm the center !") +} + +} diff --git a/man/plotMap.Rd b/man/plotMap.Rd index 8e1c564..079816e 100644 --- a/man/plotMap.Rd +++ b/man/plotMap.Rd @@ -1,192 +1,135 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{plotMap} -\alias{plotMap} -\title{Display results of a simulation on a map} -\usage{ -plotMap(x, mapLayout, colAreaVar = "none", sizeAreaVars = c(), - areaChartType = c("bar", "pie", "polar-area", "polar-radius"), - uniqueScale = FALSE, showLabels = FALSE, popupAreaVars = c(), - labelAreaVar = "none", colLinkVar = "none", sizeLinkVar = "none", - popupLinkVars = c(), type = c("detail", "avg"), timeId = NULL, - mcYear = "average", main = "", compare = NULL, compareOpts = list(), - interactive = getInteractivity(), options = plotMapOptions(), - width = NULL, height = NULL, dateRange = NULL, xyCompare = c("union", - "intersect"), h5requestFiltering = list(), timeSteph5 = "hourly", - mcYearh5 = NULL, tablesh5 = c("areas", "links"), sizeMiniPlot = FALSE, - ...) -} -\arguments{ -\item{x}{Object of class \code{antaresDataList} created with -\code{\link[antaresRead]{readAntares}} and containing areas and links data. - It can be a list of \code{antaresData} objects. - In this case, one chart is created for each object.} - -\item{mapLayout}{Object created with function \code{\link{mapLayout}}} - -\item{colAreaVar}{Name of a variable present in \code{x$areas}. The values of this variable -are represented by the color of the areas on the map. If \code{"none"}, then -the default color is used for all areas.} - -\item{sizeAreaVars}{Vector of variables present in \code{x$areas} to associate with the size of -areas on the map. If this parameter has length equal to 0, all areas have the -same size. If it has length equal to one, then the radius of the areas change -depending on the values of the variable choosen. If it has length greater than -1 then areas are represented by a polar area chart where the size of each section -depends on the values of each variable.} - -\item{areaChartType}{If parameter \code{sizeAreaVars} contains multiple variables, this parameter -determines the type of representation. Possible values are \code{"bar"} for -bar charts, \code{"pie"} for pie charts, \code{"polar-area"} and -\code{"polar-radius"} for polar area charts where the values are represented -respectively by the area or the radius of the slices.} - -\item{uniqueScale}{If the map contains polar or bar charts, should the different variables -represented use the same scale or should each variable have its own scale ? -This parameter should be TRUE only if the variables have the same unit and -are comparable : for instance production variables.} - -\item{showLabels}{Used only when \code{sizeAreaVars} contains multiple variables. If it is -\code{TRUE}, then values of each variable are displayed.} - -\item{popupAreaVars}{Vector of variables to display when user clicks on an area.} - -\item{labelAreaVar}{Variable to display inside the areas. This parameter is used only if -parameter \code{sizeAreaVars} contains zero or one variable.} - -\item{colLinkVar}{Name of a variable present in \code{x$links}. The values of this variable -are represented by the color of the links on the map. If \code{"none"}, then -the default color is used for all links} - -\item{sizeLinkVar}{Name of a variable present in \code{x$links}. Its values are represented by -the line width of the links on the map.} - -\item{popupLinkVars}{Vector of variables to display when user clicks on a link.} - -\item{type}{If \code{type="avg"}, the data is averaged by area/and or link and -represented on the map. If it is equal to \code{"detail"}, only one time -step at a time. In interactive mode, an input control permits to choose the -time step shown.} - -\item{timeId}{A single time id present in the data. Only used if \code{type="detail"}} - -\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter -determine which scenario is displayed. Must be an integer representing the -index of the scenario or the word "average". In this case data are -averaged.} - -\item{main}{Title of the map.} - -\item{compare}{An optional character vector containing names of parameters. When it is set, -two charts are outputed with their own input controls. Alternatively, it can -be a named list with names corresponding to parameter names and values being -list with the initial values of the given parameter for each chart. See details - if you are drawing a map.} - -\item{compareOpts}{List of options that indicates the number of charts to create and their -position. Check out the documentation of -\code{\link[manipulateWidget]{compareOptions}} to see available options.} - -\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets -the user interactively choose the areas or districts to display.} - -\item{options}{List of parameters that override some default visual settings. See the -help of \code{\link{plotMapOptions}}.} - -\item{width}{Width of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{height}{Height of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{dateRange}{A vector of two dates. Only data points between these two dates are -displayed. If NULL, then all data is displayed.} - -\item{xyCompare}{Use when you compare studies, can be "union" or "intersect". If union, all -of mcYears in one of studies will be selectable. If intersect, only mcYears in all -studies will be selectable.} - -\item{h5requestFiltering}{Contains arguments used by default for h5 request, -typically h5requestFiltering = list(select = "NUCLEAR")} - -\item{timeSteph5}{\code{character} timeStep to read in h5 file. Only for Non interactive mode.} - -\item{mcYearh5}{\code{numeric} mcYear to read for h5. Only for Non interactive mode.} - -\item{tablesh5}{\code{character} tables for h5 ("areas" "links", "clusters" or "disticts"). Only for Non interactive mode.} - -\item{sizeMiniPlot}{\code{boolean} variable size for miniplot} - -\item{...}{Other arguments for \code{\link{manipulateWidget}}} -} -\value{ -An htmlwidget of class "leaflet". It can be modified with package -\code{leaflet}. By default the function starts a shiny gadget that lets the -user play with most of the parameters of the function. The function returns -a leaflet map when the user clicks on the button \code{"done"}. -} -\description{ -This function generates an interactive map that let the user visually explore -the results of an Antares simulation. By default the function starts a Shiny -gadget that let the user which variables to represent. -} -\details{ -compare argument can take following values : -\itemize{ - \item "mcYear" - \item "type" - \item "colAreaVar" - \item "sizeAreaVars" - \item "areaChartType" - \item "showLabels" - \item "popupAreaVars" - \item "labelAreaVar" - \item "colLinkVar" - \item "sizeLinkVar" - \item "popupLinkVars" - } -} -\examples{ -\dontrun{ -mydata <- readAntares(areas = "all", links = "all", timeStep = "daily", - select = "nostat") - -# Place areas on a map. Ths has to be done once for a given study. Then the -# object returned by "mapLayout" may be saved and reloaded with -# functions save and load - -layout <- readLayout() -ml <- mapLayout(layout = layout) -save("ml", file = "ml.rda") - -plotMap(x = mydata, mapLayout = ml) - -# Specify the variables to use to control the color or size of elements. -plotMap(mydata, mapLayout = ml, - sizeAreaVars = c("WIND", "SOLAR", "H. ROR"), - sizeLinkVar = "FLOW LIN.") - -# Change default graphical properties -plotMap(x = mydata, mapLayout = ml, options = list(colArea="red", colLink = "orange")) -plotMap(x = list(mydata, mydata), mapLayout = ml) - -# Use h5 for dynamic request / exploration in a study -# Set path of simulaiton -setSimulationPath(path = path1) - -# Convert your study in h5 format -writeAntaresH5(path = mynewpath) - -# Redefine sim path with h5 file -opts <- setSimulationPath(path = mynewpath) -plotMap(x = opts, mapLayout = ml) - -# Compare elements in a single study -plotMap(x = opts, mapLayout = ml, .compare = "mcYear") - -# Compare 2 studies -plotMap(x = list(opts, opts2), mapLayout = ml) - -} - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map.R +\name{plotMap} +\alias{plotMap} +\title{Display results of a simulation on a map} +\usage{ +plotMap(x, y = NULL, mapLayout, colAreaVar = "none", sizeAreaVars = c(), + areaChartType = c("bar", "pie", "polar-area", "polar-radius"), + uniqueScale = FALSE, showLabels = FALSE, popupAreaVars = c(), + labelAreaVar = "none", colLinkVar = "none", sizeLinkVar = "none", + popupLinkVars = c(), type = c("detail", "avg"), timeId = NULL, + mcYear = "average", main = "", compare = NULL, compareOpts = list(), + interactive = getInteractivity(), options = plotMapOptions(), + width = NULL, height = NULL) +} +\arguments{ +\item{x}{Object of class \code{antaresDataList} created with +\code{\link[antaresRead]{readAntares}} and containing areas and links data} + +\item{y}{Optional object of class \code{antaresData}. If it is specified, then two +charts are generated.} + +\item{mapLayout}{Object created with function \code{\link{mapLayout}}} + +\item{colAreaVar}{Name of a variable present in \code{x$areas}. The values of this variable +are represented by the color of the areas on the map. If \code{"none"}, then +the default color is used for all areas.} + +\item{sizeAreaVars}{Vector of variables present in \code{x$areas} to associate with the size of +areas on the map. If this parameter has length equal to 0, all areas have the +same size. If it has length equal to one, then the radius of the areas change +depending on the values of the variable choosen. If it has length greater than +1 then areas are represented by a polar area chart where the size of each section +depends on the values of each variable.} + +\item{areaChartType}{If parameter \code{sizeAreaVars} contains multiple variables, this parameter +determines the type of representation. Possible values are \code{"bar"} for +bar charts, \code{"pie"} for pie charts, \code{"polar-area"} and +\code{"polar-radius"} for polar area charts where the values are represented +respectively by the area or the radius of the slices.} + +\item{uniqueScale}{If the map contains polar or bar charts, should the different variables +represented use the same scale or should each variable have its own scale ? +This parameter should be TRUE only if the variables have the same unit and +are comparable : for instance production variables.} + +\item{showLabels}{Used only when \code{sizeAreaVars} contains multiple variables. If it is +\code{TRUE}, then values of each variable are displayed.} + +\item{popupAreaVars}{Vector of variables to display when user clicks on an area.} + +\item{labelAreaVar}{Variable to display inside the areas. This parameter is used only if +parameter \code{sizeAreaVars} contains zero or one variable.} + +\item{colLinkVar}{Name of a variable present in \code{x$links}. The values of this variable +are represented by the color of the links on the map. If \code{"none"}, then +the default color is used for all links} + +\item{sizeLinkVar}{Name of a variable present in \code{x$links}. Its values are represented by +the line width of the links on the map.} + +\item{popupLinkVars}{Vector of variables to display when user clicks on a link.} + +\item{type}{If \code{type="avg"}, the data is averaged by area/and or link and +represented on the map. If it is equal to \code{"detail"}, only one time +step at a time. In interactive mode, an input control permits to choose the +time step shown.} + +\item{timeId}{A single time id present in the data. Only used if \code{type="detail"}} + +\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter +determine which scenario is displayed. Must be an integer representing the +index of the scenario or the word "average". In this case data are +averaged.} + +\item{main}{Title of the map.} + +\item{compare}{An optional character vector containing names of parameters. When it is set, +two charts are outputed with their own input controls. Alternatively, it can +be a named list with names corresponding to parameter names and values being +list with the initial values of the given parameter for each chart.} + +\item{compareOpts}{List of options that indicates the number of charts to create and their +position. Check out the documentation of +\code{\link[manipulateWidget]{compareOptions}} to see available options.} + +\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets +the user interactively choose the areas or districts to display.} + +\item{options}{List of parameters that override some default visual settings. See the +help of \code{\link{plotMapOptions}}.} + +\item{width}{Width of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{height}{Height of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} +} +\value{ +An htmlwidget of class "leaflet". It can be modified with package +\code{leaflet}. By default the function starts a shiny gadget that lets the +user play with most of the parameters of the function. The function returns +a leaflet map when the user clicks on the button \code{"done"}. +} +\description{ +This function generates an interactive map that let the user visually explore +the results of an Antares simulation. By default the function starts a Shiny +gadget that let the user which variables to represent. +} +\examples{ +\dontrun{ +mydata <- readAntares(areas = "all", links = "all", timeStep = "daily", + select = "nostat") + +# Place areas on a map. Ths has to be done once for a given study. Then the +# object returned by "mapLayout" may be saved and reloaded with +# functions save and load + +layout <- readLayout() +ml <- mapLayout(layout) +save("ml", file = "ml.rda") + +plotMap(mydata, ml) + +# Specify the variables to use to control the color or size of elements. +plotMap(mydata, ml, + sizeAreaVars = c("WIND", "SOLAR", "H. ROR"), + sizeLinkVar = "FLOW LIN.") + +# Change default graphical properties +plotMap(mydata, ml, options = list(colArea="red", colLink = "orange")) + +} + +} diff --git a/man/plotMapLayout.Rd b/man/plotMapLayout.Rd deleted file mode 100644 index 44faf3e..0000000 --- a/man/plotMapLayout.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map_layout.R -\name{plotMapLayout} -\alias{plotMapLayout} -\title{Visualize mapLayout output.} -\usage{ -plotMapLayout(mapLayout) -} -\arguments{ -\item{mapLayout}{object returned by function \code{\link{mapLayout}}} -} -\description{ -Visualize mapLayout output. -} -\examples{ - -\dontrun{ -# Read the coordinates of the areas in the Antares interface, then convert it -# in a map layout. -layout <- readLayout() -ml <- mapLayout(layout) - -# visualize mapLayout -plotMapLayout(ml) - -} - -} -\seealso{ -\code{\link{mapLayout}} -} diff --git a/man/plotMapOptions.Rd b/man/plotMapOptions.Rd index 1397525..3bf5a0e 100644 --- a/man/plotMapOptions.Rd +++ b/man/plotMapOptions.Rd @@ -1,102 +1,102 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map_options.R -\name{plotMapOptions} -\alias{plotMapOptions} -\alias{defaultTilesURL} -\alias{colorScaleOptions} -\title{Graphical options for plotMap} -\usage{ -plotMapOptions(areaDefaultCol = "#DDDDE5", areaDefaultSize = 30, - areaMaxSize = 50, areaMaxHeight = 50, areaChartColors = NULL, - areaColorScaleOpts = colorScaleOptions(), labelMinSize = 8, - labelMaxSize = 24, linkDefaultCol = "#BEBECE", linkDefaultSize = 3, - linkMaxSize = 15, linkColorScaleOpts = colorScaleOptions(), - legend = c("choose", "visible", "hidden"), tilesURL = defaultTilesURL(), - preprocess = function(map) { map }) - -defaultTilesURL() - -colorScaleOptions(breaks = 5, domain = NULL, negCol = "#FF0000", - zeroCol = "#FAFAFA", posCol = "#0000FF", naCol = "#EEEEEE", - zeroTol = NULL, colors = NULL, levels = NULL) -} -\arguments{ -\item{areaDefaultCol}{default color of areas.} - -\item{areaDefaultSize}{default size of areas.} - -\item{areaMaxSize}{maximal size of an area when it represents the value of some variable.} - -\item{areaMaxHeight}{Maximal height of bars. Used only if a barchart representation is used.} - -\item{areaChartColors}{Vector of colors to use in polar area charts and bar charts} - -\item{areaColorScaleOpts}{List of options used to construct a continuous color scale. This list should -be generated with function \code{colorScaleOptions}.} - -\item{labelMinSize}{minimal height of labels.} - -\item{labelMaxSize}{maximal height of labels.} - -\item{linkDefaultCol}{Default color of links.} - -\item{linkDefaultSize}{Default line width of links.} - -\item{linkMaxSize}{Maximal line width of a link when it represents the value of some variable.} - -\item{linkColorScaleOpts}{List of options used to construct a continuous color scale. This list should -be generated with function \code{colorScaleOptions}.} - -\item{legend}{Should the legend be displayed or not ? Default is to mask the legend but -add a button to display it. Other values are "visible" to make the legend -always visible and "hidden" to mask it.} - -\item{tilesURL}{URL template used to get map tiles. The followign site -provides some URLs; -\url{https://leaflet-extras.github.io/leaflet-providers/preview/}} - -\item{preprocess}{A function that takes as argument a map and that returns a -modified version of this map. This parameter can be used to add extra -information on a map.} - -\item{breaks}{Either a single number indicating the approximate number of colors to use, or -a vector of values at which values to change color. -In the first case, the function tries to cut the data nicely, so the real -number of colors used may vary.} - -\item{domain}{Range of the data, ie. the range of possible values. If \code{NULL}, the -the range of the data is used} - -\item{negCol}{color of the extreme negative value.} - -\item{zeroCol}{color of the 0 value.} - -\item{posCol}{Color of the extreme positive value.} - -\item{naCol}{Color for missing values} - -\item{zeroTol}{All values in the interval \code{\[-zeroTol, +zeroTol\]} are mapped to the -\code{zeroCol} color. If \code{NULL}, the function tries to pick a nice -value that is approximately equal to 1\% of the maximal value.} - -\item{colors}{Vector of colors. If it is set and if user manually sets break points, then -these colors are used instead of the colors defined by parameters negCol, -zeroCol and posCol.} - -\item{levels}{Vector of the distinct values a variable can take. Only used when the -variable to represent is a categorical variable.} -} -\value{ -A list with the values of the different graphical parameters. -} -\description{ -These functions get and set options that control some graphical aspects -of maps created with \code{\link{plotMap}}. -} -\examples{ -\dontrun{ -params <- plotMapOptions(areaDefaultCol = "red", linkDefaultCol = "orange") -plotMap(mydata, mylayout, options = params) -} - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map_options.R +\name{plotMapOptions} +\alias{plotMapOptions} +\alias{defaultTilesURL} +\alias{colorScaleOptions} +\title{Graphical options for plotMap} +\usage{ +plotMapOptions(areaDefaultCol = "#DDDDE5", areaDefaultSize = 30, + areaMaxSize = 50, areaMaxHeight = 50, areaChartColors = NULL, + areaColorScaleOpts = colorScaleOptions(), labelMinSize = 8, + labelMaxSize = 24, linkDefaultCol = "#BEBECE", linkDefaultSize = 3, + linkMaxSize = 15, linkColorScaleOpts = colorScaleOptions(), + legend = c("choose", "visible", "hidden"), tilesURL = defaultTilesURL(), + preprocess = function(map) { map }) + +defaultTilesURL() + +colorScaleOptions(breaks = 5, domain = NULL, negCol = "#FF0000", + zeroCol = "#FAFAFA", posCol = "#0000FF", naCol = "#EEEEEE", + zeroTol = NULL, colors = NULL, levels = NULL) +} +\arguments{ +\item{areaDefaultCol}{default color of areas.} + +\item{areaDefaultSize}{default size of areas.} + +\item{areaMaxSize}{maximal size of an area when it represents the value of some variable.} + +\item{areaMaxHeight}{Maximal height of bars. Used only if a barchart representation is used.} + +\item{areaChartColors}{Vector of colors to use in polar area charts and bar charts} + +\item{areaColorScaleOpts}{List of options used to construct a continuous color scale. This list should +be generated with function \code{colorScaleOptions}.} + +\item{labelMinSize}{minimal height of labels.} + +\item{labelMaxSize}{maximal height of labels.} + +\item{linkDefaultCol}{Default color of links.} + +\item{linkDefaultSize}{Default line width of links.} + +\item{linkMaxSize}{Maximal line width of a link when it represents the value of some variable.} + +\item{linkColorScaleOpts}{List of options used to construct a continuous color scale. This list should +be generated with function \code{colorScaleOptions}.} + +\item{legend}{Should the legend be displayed or not ? Default is to mask the legend but +add a button to display it. Other values are "visible" to make the legend +always visible and "hidden" to mask it.} + +\item{tilesURL}{URL template used to get map tiles. The followign site +provides some URLs; +\url{https://leaflet-extras.github.io/leaflet-providers/preview/}} + +\item{preprocess}{A function that takes as argument a map and that returns a +modified version of this map. This parameter can be used to add extra +information on a map.} + +\item{breaks}{Either a single number indicating the approximate number of colors to use, or +a vector of values at which values to change color. +In the first case, the function tries to cut the data nicely, so the real +number of colors used may vary.} + +\item{domain}{Range of the data, ie. the range of possible values. If \code{NULL}, the +the range of the data is used} + +\item{negCol}{color of the extreme negative value.} + +\item{zeroCol}{color of the 0 value.} + +\item{posCol}{Color of the extreme positive value.} + +\item{naCol}{Color for missing values} + +\item{zeroTol}{All values in the interval \code{\[-zeroTol, +zeroTol\]} are mapped to the +\code{zeroCol} color. If \code{NULL}, the function tries to pick a nice +value that is approximately equal to 1\% of the maximal value.} + +\item{colors}{Vector of colors. If it is set and if user manually sets break points, then +these colors are used instead of the colors defined by parameters negCol, +zeroCol and posCol.} + +\item{levels}{Vector of the distinct values a variable can take. Only used when the +variable to represent is a categorical variable.} +} +\value{ +A list with the values of the different graphical parameters. +} +\description{ +These functions get and set options that control some graphical aspects +of maps created with \code{\link{plotMap}}. +} +\examples{ +\dontrun{ +params <- plotMapOptions(areaDefaultCol = "red", linkDefaultCol = "orange") +plotMap(mydata, mylayout, options = params) +} + +} diff --git a/man/plotThermalGroupCapacities.Rd b/man/plotThermalGroupCapacities.Rd deleted file mode 100644 index 787eba0..0000000 --- a/man/plotThermalGroupCapacities.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_thermal_group_capacities.R -\name{plotThermalGroupCapacities} -\alias{plotThermalGroupCapacities} -\title{Plot for Thermal Group Capacities} -\usage{ -plotThermalGroupCapacities(data, area = "all", - main = "Thermal group capacities") -} -\arguments{ -\item{data}{data.table of Thermal Group capacities} - -\item{area}{areas to select, default all} - -\item{main}{title} -} -\description{ -Plot for Thermal Group Capacities -} -\examples{ -\dontrun{ -opts <- setSimulationPath(getwd()) -plotThermalGroupCapacities( thermalGroupCapacities(opts)) -} - -} diff --git a/man/plotXY.Rd b/man/plotXY.Rd deleted file mode 100644 index dd8c297..0000000 --- a/man/plotXY.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_XY.R -\name{plotXY} -\alias{plotXY} -\title{Plot density between X et Y with rbokeh} -\usage{ -plotXY(data, x, y, precision = 30, sizeOnCount = FALSE, outLine = TRUE, - transform = NULL) -} -\arguments{ -\item{data}{\code{data.frame} can be antaresData object} - -\item{x}{\code{character}, x variable} - -\item{y}{\code{character}, y variable} - -\item{precision}{\code{numeric} precision for plot} - -\item{sizeOnCount}{\code{boolean}, should addapt size of object based on count} - -\item{outLine}{\code{boolean}, add outline on your shape} - -\item{transform}{\code{funciton}, transform function apply on count (by cells), can be log} -} -\description{ -This function take somes arguments from rbokeh and make plot. -} -\examples{ -\dontrun{ - -setSimulationPath("myStudy") -myData <- readAntares() - -plotXY(myData, "NODU", "LOAD", precision = 50, - sizeOnCount = FALSE) - -myData <- readAntares(areas = "all", links = "all") -myData <- mergeAllAntaresData(myData) -plotXY(myData, "OP. COST_max_b", "OP. COST_max_c", precision = 50, - sizeOnCount = FALSE) - - -} - -} diff --git a/man/prodStack.Rd b/man/prodStack.Rd index f6c3df7..20e73fb 100644 --- a/man/prodStack.Rd +++ b/man/prodStack.Rd @@ -1,224 +1,155 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stack_aliases.R, R/stack_prod.R -\name{prodStackAliases} -\alias{prodStackAliases} -\alias{setProdStackAlias} -\alias{prodStack} -\title{Visualize the production stack of an area} -\usage{ -prodStackAliases() - -setProdStackAlias(name, variables, colors, lines = NULL, lineColors = NULL, - description = NULL) - -prodStack(x, stack = "eco2mix", areas = NULL, mcYear = "average", - dateRange = NULL, main = "Production stack", unit = c("MWh", "GWh", - "TWh"), compare = NULL, compareOpts = list(), - interactive = getInteractivity(), legend = TRUE, - legendId = sample(1000000000, 1), groupId = legendId, - legendItemsPerRow = 5, width = NULL, height = NULL, - xyCompare = c("union", "intersect"), h5requestFiltering = list(), - stepPlot = FALSE, drawPoints = FALSE, timeSteph5 = "hourly", - mcYearh5 = NULL, tablesh5 = c("areas", "links"), ...) -} -\arguments{ -\item{name}{name of the stack to create or update} - -\item{variables}{A named list of expressions created with \code{\link[base]{alist}}. The -name of each element is the name of the variable to draw in the stacked -graph. The element itself is an expression explaining how to compute the -variable (see examples).} - -\item{colors}{Vector of colors with same length as parameter \code{variables}. If -\code{variables} is an alias, then this argument should be \code{NULL} in -order to use default colors.} - -\item{lines}{A named list of expressions created with \code{\link[base]{alist}} -indicating how to compute the curves to display on top of the stacked graph. -It should be \code{NULL} if there is no curve to trace or if parameter -\code{variables} is an alias.} - -\item{lineColors}{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.} - -\item{description}{Description of the stack. It is displayed by function -\code{prodStackAliases}.} - -\item{x}{An object of class \code{antaresData} created with function -\code{\link[antaresRead]{readAntares}} containing data for areas and or -districts. it can be a list of \code{antaresData} objects. -In this case, one chart is created for each object. -Can also contains opts who refer to a h5 file or list of opts.} - -\item{stack}{Name of the stack to use. One can visualize available stacks with -\code{prodStackAliases}} - -\item{areas}{Vector of area or district names. The data of these areas or districts is -aggregated by the function to construct the production stack.} - -\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter -determine which scenario is displayed. Must be an integer representing the -index of the scenario or the word "average". In this case data are -averaged.} - -\item{dateRange}{A vector of two dates. Only data points between these two dates are -displayed. If NULL, then all data is displayed.} - -\item{main}{Title of the graph.} - -\item{unit}{Unit used in the graph. Possible values are "MWh", "GWh" or "TWh".} - -\item{compare}{An optional character vector containing names of parameters. When it is set, -two charts are outputed with their own input controls. Alternatively, it can -be a named list with names corresponding to parameter names and values being -list with the initial values of the given parameter for each chart. See details - if you are drawing a map.} - -\item{compareOpts}{List of options that indicates the number of charts to create and their -position. Check out the documentation of -\code{\link[manipulateWidget]{compareOptions}} to see available options.} - -\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets -the user interactively choose the areas or districts to display.} - -\item{legend}{Logical value indicating if a legend should be drawn. This argument is -usefull when one wants to create a shared legend with -\code{\link{prodStackLegend}}} - -\item{legendId}{Id of the legend linked to the graph. This argument is -usefull when one wants to create a shared legend with -\code{\link{prodStackLegend}}} - -\item{groupId}{Parameter that can be used to synchronize the horizontal -zoom of multiple charts. All charts that need to be synchronized must -have the same group.} - -\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} - -\item{width}{Width of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{height}{Height of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{xyCompare}{Use when you compare studies, can be "union" or "intersect". If union, all -of mcYears in one of studies will be selectable. If intersect, only mcYears in all -studies will be selectable.} - -\item{h5requestFiltering}{Contains arguments used by default for h5 request, -typically h5requestFiltering = list(select = "NUCLEAR")} - -\item{stepPlot}{\code{boolean}, step style for curves.} - -\item{drawPoints}{\code{boolean}, add points on graph} - -\item{timeSteph5}{\code{character} timeStep to read in h5 file. Only for Non interactive mode.} - -\item{mcYearh5}{\code{numeric} mcYear to read for h5. Only for Non interactive mode.} - -\item{tablesh5}{\code{character} tables for h5 ("areas" "links", "clusters" or "disticts"). Only for Non interactive mode.} - -\item{...}{Other arguments for \code{\link{manipulateWidget}}} -} -\value{ -\code{prodStack} returns an interactive html graphic. If argument -\code{interactive} is \code{TRUE}, then a shiny gadget is started and the -function returns an interactive html graphic when the user clicks on button -"Done". - -\code{prodStackAliases} displays the list of available aliases. - -\code{setProdStackAlias} creates or updates a stack alias. -} -\description{ -\code{prodStack} draws the production stack for a set of areas or districts. -User can see available stacks with \code{prodStackAliases} and create new ones -with \code{setProdStackAlias}. -} -\details{ -compare argument can take following values : -\itemize{ - \item "mcYear" - \item "main" - \item "unit" - \item "areas" - \item "legend" - \item "stack" - \item "stepPlot" - \item "drawPoints" - } -} -\examples{ -\dontrun{ -mydata <- readAntares(areas = "all", timeStep = "daily") - -# Start a shiny gadget that permits to choose areas to display. -prodStack(x = mydata, unit = "GWh") - -# Use in a non-interactive way -prodStack(x = mydata, unit = "GWh", areas = "fr", interactive = FALSE) - -# Define a custom stack -setProdStackAlias( - name = "Wind and solar", - variables = alist(wind = WIND, solar = SOLAR), - colors = c("green", "orange") -) - -prodStack(x = mydata, unit = "GWh", stack = "Wind and solar") - -# In a custom stack it is possible to use computed values -setProdStackAlias( - name = "Renewable", - variables = alist( - renewable = WIND + SOLAR + `H. ROR` + `H. STOR` + `MISC. NDG`, - thermal = NUCLEAR + LIGNITE + COAL + GAS + OIL + `MIX. FUEL` + `MISC. DTG` - ), - colors = c("green", gray(0.3)), - lines = alist(goalRenewable = LOAD * 0.23), - lineColors = "#42EB09" -) - -prodStack(x = mydata, unit = "GWh", stack = "renewable") - -# Use compare -prodStack(x = mydata, compare = "areas") -prodStack(x = mydata, unit = "GWh", compare = "mcYear") -prodStack(x = mydata, unit = "GWh", compare = "main") -prodStack(x = mydata, unit = "GWh", compare = "unit") -prodStack(x = mydata, unit = "GWh", compare = "areas") -prodStack(x = mydata, unit = "GWh", compare = "legend") -prodStack(x = mydata, unit = "GWh", compare = "stack") -prodStack(x = mydata, unit = "GWh", compare = c("mcYear", "areas")) - - -# Compare studies -prodStack(list(mydata, mydata)) - - -# Use h5 opts -# Set path of simulaiton -setSimulationPath(path = path1) - -# Convert your study in h5 format -writeAntaresH5(path = mynewpath) - -# Redefine sim path with h5 file -opts <- setSimulationPath(path = mynewpath) -prodStack(x = opts) - -# Compare elements in a single study -prodStack(x = opts, .compare = "mcYear") - -# Compare 2 studies -prodStack(x = list(opts, opts2)) - - - -} - -} -\seealso{ -\code{\link{prodStackLegend}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stack_aliases.R, R/stack_prod.R +\name{prodStackAliases} +\alias{prodStackAliases} +\alias{setProdStackAlias} +\alias{prodStack} +\title{Visualize the production stack of an area} +\usage{ +prodStackAliases() + +setProdStackAlias(name, variables, colors, lines = NULL, lineColors = NULL, + description = NULL) + +prodStack(x, y = NULL, stack = "eco2mix", areas = NULL, + mcYear = "average", dateRange = NULL, main = "Production stack", + unit = c("MWh", "GWh", "TWh"), compare = NULL, compareOpts = list(), + interactive = getInteractivity(), legend = TRUE, + legendId = sample(1e+09, 1), groupId = legendId, legendItemsPerRow = 5, + width = NULL, height = NULL) +} +\arguments{ +\item{name}{name of the stack to create or update} + +\item{variables}{A named list of expressions created with \code{\link[base]{alist}}. The +name of each element is the name of the variable to draw in the stacked +graph. The element itself is an expression explaining how to compute the +variable (see examples).} + +\item{colors}{Vector of colors with same length as parameter \code{variables}. If +\code{variables} is an alias, then this argument should be \code{NULL} in +order to use default colors.} + +\item{lines}{A named list of expressions created with \code{\link[base]{alist}} +indicating how to compute the curves to display on top of the stacked graph. +It should be \code{NULL} if there is no curve to trace or if parameter +\code{variables} is an alias.} + +\item{lineColors}{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.} + +\item{description}{Description of the stack. It is displayed by function +\code{prodStackAliases}.} + +\item{x}{An object of class \code{antaresData} created with function +\code{\link[antaresRead]{readAntares}} containing data for areas and or +districts.} + +\item{y}{Optional object of class \code{antaresData}. If it is specified, then two +charts are generated.} + +\item{stack}{Name of the stack to use. One can visualize available stacks with +\code{prodStackAliases}} + +\item{areas}{Vector of area or district names. The data of these areas or districts is +aggregated by the function to construct the production stack.} + +\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter +determine which scenario is displayed. Must be an integer representing the +index of the scenario or the word "average". In this case data are +averaged.} + +\item{dateRange}{A vector of two dates. Only data points between these two dates are +displayed. If NULL, then all data is displayed.} + +\item{main}{Title of the graph.} + +\item{unit}{Unit used in the graph. Possible values are "MWh", "GWh" or "TWh".} + +\item{compare}{An optional character vector containing names of parameters. When it is set, +two charts are outputed with their own input controls. Alternatively, it can +be a named list with names corresponding to parameter names and values being +list with the initial values of the given parameter for each chart.} + +\item{compareOpts}{List of options that indicates the number of charts to create and their +position. Check out the documentation of +\code{\link[manipulateWidget]{compareOptions}} to see available options.} + +\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets +the user interactively choose the areas or districts to display.} + +\item{legend}{Logical value indicating if a legend should be drawn. This argument is +usefull when one wants to create a shared legend with +\code{\link{prodStackLegend}}} + +\item{legendId}{Id of the legend linked to the graph. This argument is +usefull when one wants to create a shared legend with +\code{\link{prodStackLegend}}} + +\item{groupId}{Parameter that can be used to synchronize the horizontal +zoom of multiple charts. All charts that need to be synchronized must +have the same group.} + +\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} + +\item{width}{Width of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{height}{Height of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} +} +\value{ +\code{prodStackAliases} returns an interactive html graphic. If argument +\code{interactive} is \code{TRUE}, then a shiny gadget is started and the +function returns an interactive html graphic when the user clicks on button +"Done". + +\code{prodStackAliases} displays the list of available aliases. + +\code{setProdStackAlias} creates or updates a stack alias. +} +\description{ +\code{prodStack} draws the production stack for a set of areas or districts. +User can see available stacks with \code{prodStackAliases} and create new ones +with \code{setProdStackAlias}. +} +\examples{ +\dontrun{ +mydata <- readAntares(areas = "all", timeStep = "daily") + +# Start a shiny gadget that permits to choose areas to display. +prodStack(mydata, unit = "GWh") + +# Use in a non-interactive way +prodStack(mydata, unit = "GWh", areas = "fr", interactive = FALSE) + +# Define a custom stack +setProdStackAlias( + name = "Wind and solar", + variables = alist(wind = WIND, solar = SOLAR), + colors = c("green", "orange") +) + +prodStack(mydata, unit = "GWh", stack = "Wind and solar") + +# In a custom stack it is possible to use computed values +setProdStackAlias( + name = "Renewable", + variables = alist( + renewable = WIND + SOLAR + `H. ROR` + `H. STOR` + `MISC. NDG`, + thermal = NUCLEAR + LIGNITE + COAL + GAS + OIL + `MIX. FUEL` + `MISC. DTG` + ), + colors = c("green", gray(0.3)), + lines = alist(goalRenewable = LOAD * 0.23), + lineColors = "#42EB09" +) + +prodStack(mydata, unit = "GWh", stack = "renewable") + +} + +} +\seealso{ +\code{\link{prodStackLegend}} +} diff --git a/man/runAppAntaresViz.Rd b/man/runAppAntaresViz.Rd deleted file mode 100644 index 239c2fe..0000000 --- a/man/runAppAntaresViz.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/runApp.R -\name{runAppAntaresViz} -\alias{runAppAntaresViz} -\title{Run app antaresViz} -\usage{ -runAppAntaresViz() -} -\value{ -an App Shiny. -} -\description{ -\code{runAppAntaresViz} run antaresViz App. -} diff --git a/man/stackMap.Rd b/man/stackMap.Rd deleted file mode 100644 index 4a26f65..0000000 --- a/man/stackMap.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stack_map.R -\name{stackMap} -\alias{stackMap} -\title{plot stack and map} -\usage{ -stackMap(x, mapLayout) -} -\arguments{ -\item{x}{\code{antaresDataList} antaresDataList contian areas ans links.} - -\item{mapLayout}{Object created with function \code{\link{mapLayout}}} -} -\description{ -plot stack and map -} -\examples{ -\dontrun{ -mydata <- readAntares(areas = "all", links = "all") - -layout <- readLayout() -ml <- mapLayout(layout = layout) - -stackMap(x = mydata, mapLayout = ml) -} - -} diff --git a/man/tsLegend.Rd b/man/tsLegend.Rd index 17f797f..9ec8a3e 100644 --- a/man/tsLegend.Rd +++ b/man/tsLegend.Rd @@ -1,65 +1,65 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stack_prod.R, R/tsLegend.R -\name{prodStackLegend} -\alias{prodStackLegend} -\alias{tsLegend} -\title{Plot an interactive legend for time series plots} -\usage{ -prodStackLegend(stack = "eco2mix", legendItemsPerRow = 5, legendId = "") - -tsLegend(labels, colors, types = "line", legendItemsPerRow = 5, - legendId = "") -} -\arguments{ -\item{stack}{Name of the stack to use. One can visualize available stacks with -\code{prodStackAliases}} - -\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} - -\item{legendId}{Id of the legend linked to the graph. This argument is -usefull when one wants to create a shared legend with -\code{\link{prodStackLegend}}} - -\item{labels}{vector containing the names of the times series} - -\item{colors}{vector of colors. It must have the same length as parameter -\code{labels}.} - -\item{types}{"line" or "area" or a vector with same length as \code{labels} -containing these two values.} -} -\description{ -These functions create a nice looking legend that displays values when the user -hovers a time series produced with plot this package. By -default, the different functions already output a legend. This function -is mostly useful to share a unique legend between two or more time series plots. -} -\details{ -Thes functions can be used to create a legend shared by multiple plots -in a Shiny application or an interactive document created with Rmarkdown. -For instance, let assume one wants to display four productions stacks in a 2x2 -layout and have a unique legend below them in a Rmarkdown document. To do so, -one can use the following chunck code: - -\preformatted{ -```{R, echo = FALSE} -library(manipulateWidget) - -combineWidgets( - prodStack(mydata, areas = "fr", - main = "Production stack in France", unit = "GWh", - legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), - prodStack(mydata, areas = "de", - main = "Production stack in Germany", unit = "GWh", - legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), - prodStack(mydata, areas = "es", - main = "Production stack in Spain", unit = "GWh", - legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), - prodStack(mydata, areas = "be", - main = "Production stack in Belgium", unit = "GWh", - legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), - footer = prodStackLegend(legendId = 1) -) -``` -} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stack_prod.R, R/tsLegend.R +\name{prodStackLegend} +\alias{prodStackLegend} +\alias{tsLegend} +\title{Plot an interactive legend for time series plots} +\usage{ +prodStackLegend(stack = "eco2mix", legendItemsPerRow = 5, legendId = "") + +tsLegend(labels, colors, types = "line", legendItemsPerRow = 5, + legendId = "") +} +\arguments{ +\item{stack}{Name of the stack to use. One can visualize available stacks with +\code{prodStackAliases}} + +\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} + +\item{legendId}{Id of the legend linked to the graph. This argument is +usefull when one wants to create a shared legend with +\code{\link{prodStackLegend}}} + +\item{labels}{vector containing the names of the times series} + +\item{colors}{vector of colors. It must have the same length as parameter +\code{labels}.} + +\item{types}{"line" or "area" or a vector with same length as \code{labels} +containing these two values.} +} +\description{ +These functions create a nice looking legend that displays values when the user +hovers a time series produced with plot this package. By +default, the different functions already output a legend. This function +is mostly useful to share a unique legend between two or more time series plots. +} +\details{ +Thes functions can be used to create a legend shared by multiple plots +in a Shiny application or an interactive document created with Rmarkdown. +For instance, let assume one wants to display four productions stacks in a 2x2 +layout and have a unique legend below them in a Rmarkdown document. To do so, +one can use the following chunck code: + +\preformatted{ +```{R, echo = FALSE} +library(manipulateWidget) + +combineWidgets( + prodStack(mydata, areas = "fr", + main = "Production stack in France", unit = "GWh", + legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), + prodStack(mydata, areas = "de", + main = "Production stack in Germany", unit = "GWh", + legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), + prodStack(mydata, areas = "es", + main = "Production stack in Spain", unit = "GWh", + legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), + prodStack(mydata, areas = "be", + main = "Production stack in Belgium", unit = "GWh", + legend = FALSE, legendId = 1, height = "100\%", width = "100\%"), + footer = prodStackLegend(legendId = 1) +) +``` +} +} diff --git a/man/tsPlot.Rd b/man/tsPlot.Rd index e3cfdb9..e0925cb 100644 --- a/man/tsPlot.Rd +++ b/man/tsPlot.Rd @@ -1,277 +1,176 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot.R -\name{tsPlot} -\alias{tsPlot} -\alias{plot.antaresData} -\alias{plot.simOptions} -\alias{plot.list} -\title{plot time series contained in an antaresData object} -\usage{ -tsPlot(x, table = NULL, variable = NULL, elements = NULL, - variable2Axe = NULL, mcYear = "average", type = c("ts", "barplot", - "monotone", "density", "cdf", "heatmap"), dateRange = NULL, confInt = 0, - minValue = NULL, maxValue = NULL, aggregate = c("none", "mean", "sum", - "mean by areas", "sum by areas"), compare = NULL, compareOpts = list(), - interactive = getInteractivity(), colors = NULL, main = NULL, - ylab = NULL, legend = TRUE, legendItemsPerRow = 5, - colorScaleOpts = colorScaleOptions(20), width = NULL, height = NULL, - xyCompare = c("union", "intersect"), h5requestFiltering = list(), - highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, - secondAxis = FALSE, timeSteph5 = "hourly", mcYearh5 = NULL, - tablesh5 = c("areas", "links"), ...) - -\method{plot}{antaresData}(x, table = NULL, variable = NULL, - elements = NULL, variable2Axe = NULL, mcYear = "average", - type = c("ts", "barplot", "monotone", "density", "cdf", "heatmap"), - dateRange = NULL, confInt = 0, minValue = NULL, maxValue = NULL, - aggregate = c("none", "mean", "sum", "mean by areas", "sum by areas"), - compare = NULL, compareOpts = list(), interactive = getInteractivity(), - colors = NULL, main = NULL, ylab = NULL, legend = TRUE, - legendItemsPerRow = 5, colorScaleOpts = colorScaleOptions(20), - width = NULL, height = NULL, xyCompare = c("union", "intersect"), - h5requestFiltering = list(), highlight = FALSE, stepPlot = FALSE, - drawPoints = FALSE, secondAxis = FALSE, timeSteph5 = "hourly", - mcYearh5 = NULL, tablesh5 = c("areas", "links"), ...) - -\method{plot}{simOptions}(x, table = NULL, variable = NULL, - elements = NULL, variable2Axe = NULL, mcYear = "average", - type = c("ts", "barplot", "monotone", "density", "cdf", "heatmap"), - dateRange = NULL, confInt = 0, minValue = NULL, maxValue = NULL, - aggregate = c("none", "mean", "sum", "mean by areas", "sum by areas"), - compare = NULL, compareOpts = list(), interactive = getInteractivity(), - colors = NULL, main = NULL, ylab = NULL, legend = TRUE, - legendItemsPerRow = 5, colorScaleOpts = colorScaleOptions(20), - width = NULL, height = NULL, xyCompare = c("union", "intersect"), - h5requestFiltering = list(), highlight = FALSE, stepPlot = FALSE, - drawPoints = FALSE, secondAxis = FALSE, timeSteph5 = "hourly", - mcYearh5 = NULL, tablesh5 = c("areas", "links"), ...) - -\method{plot}{list}(x, table = NULL, variable = NULL, elements = NULL, - variable2Axe = NULL, mcYear = "average", type = c("ts", "barplot", - "monotone", "density", "cdf", "heatmap"), dateRange = NULL, confInt = 0, - minValue = NULL, maxValue = NULL, aggregate = c("none", "mean", "sum", - "mean by areas", "sum by areas"), compare = NULL, compareOpts = list(), - interactive = getInteractivity(), colors = NULL, main = NULL, - ylab = NULL, legend = TRUE, legendItemsPerRow = 5, - colorScaleOpts = colorScaleOptions(20), width = NULL, height = NULL, - xyCompare = c("union", "intersect"), h5requestFiltering = list(), - highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, - secondAxis = FALSE, timeSteph5 = "hourly", mcYearh5 = NULL, - tablesh5 = c("areas", "links"), ...) -} -\arguments{ -\item{x}{Object of class \code{antaresData}. Alternatively, it can be a list of -\code{antaresData} objects. In this case, one chart is created for each -object. Can also be opts object from h5 file or list of opts object from h5 file.} - -\item{table}{Name of the table to display when \code{x} is an \code{antaresDataList} -object.} - -\item{variable}{Name of the variable to plot. If this argument is missing, then the -function starts a shiny gadget that let the user choose the variable to -represent. When the user clicks on the "Done" button", the graphic is -returned by the function.} - -\item{elements}{Vector of "element" names indicating for which elements of 'x' should the -variable be plotted. For instance if the input data contains areas, then -this parameter should be a vector of area names. If data contains clusters -data, this parameter has to be the concatenation of the area name and the -cluster name, separated by \code{" > "}. This is to prevent confusion -when two clusters from different areas have the same name.} - -\item{variable2Axe}{\code{character}, variables on second axis.} - -\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter -determine which scenario is displayed. Must be an integer representing the -index of the scenario or the word "average". In this case data are -averaged.} - -\item{type}{Type of plot to draw. "ts" creates a time series plot, "barplot" creates -a barplot with one bar per element representing the average value of the -variable for this element. "monotone" draws the monotone curve of the -variable for each element.} - -\item{dateRange}{A vector of two dates. Only data points between these two dates are -displayed. If NULL, then all data is displayed.} - -\item{confInt}{Number between 0 and 1 indicating the size of the confidence interval to -display. If it equals to 0, then confidence interval is not computed nor -displayed. Used only when multiple Monte Carlo scenarios are present in -the input data.} - -\item{minValue}{Only used if parameter \code{type} is "density" or "cdf". If this parameter -is set, all values that are less than \code{minValue} are removed from the -graphic. This is useful to deal with variables containing a few extreme -values (generally cost and price variables). If \code{minValue} is unset, -all values are displayed.} - -\item{maxValue}{Only used if parameter \code{type} is "density" or "cdf". If this parameter -is set, all values not in [-minValue, maxValue] are removed from the graphic. -This is useful to deal with variables containing a few extreme values -(generally cost and price variables). If \code{maxValue} is 0 or unset, all -values are displayed.} - -\item{aggregate}{When multiple elements are selected, should the data be aggregated. If -"none", each element is represented separetly. If "mean" values are -averaged and if "sum" they are added. You can also compute mean ans sum by areas.} - -\item{compare}{An optional character vector containing names of parameters. When it is set, -two charts are outputed with their own input controls. Alternatively, it can -be a named list with names corresponding to parameter names and values being -list with the initial values of the given parameter for each chart. See details - if you are drawing a map.} - -\item{compareOpts}{List of options that indicates the number of charts to create and their -position. Check out the documentation of -\code{\link[manipulateWidget]{compareOptions}} to see available options.} - -\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets -the user interactively choose the areas or districts to display.} - -\item{colors}{Vector of colors} - -\item{main}{Title of the graph.} - -\item{ylab}{Label of the Y axis.} - -\item{legend}{Logical value indicating if a legend should be drawn. This argument is -usefull when one wants to create a shared legend with -\code{\link{prodStackLegend}}} - -\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} - -\item{colorScaleOpts}{A list of parameters that control the creation of color scales. It is used -only for heatmaps. See \code{\link{colorScaleOptions}}() for available -parameters.} - -\item{width}{Width of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{height}{Height of the graph expressed in pixels or in percentage of -the parent element. For instance "500px" and "100\%" are valid values.} - -\item{xyCompare}{Use when you compare studies, can be "union" or "intersect". If union, all -of mcYears in one of studies will be selectable. If intersect, only mcYears in all -studies will be selectable.} - -\item{h5requestFiltering}{Contains arguments used by default for h5 request, -typically h5requestFiltering = list(select = "NUCLEAR")} - -\item{highlight}{highlight curve when mouse over} - -\item{stepPlot}{\code{boolean}, step style for curves.} - -\item{drawPoints}{\code{boolean}, add points on graph} - -\item{secondAxis}{add second axis to graph} - -\item{timeSteph5}{\code{character} timeStep to read in h5 file. Only for Non interactive mode.} - -\item{mcYearh5}{\code{numeric} mcYear to read for h5. Only for Non interactive mode.} - -\item{tablesh5}{\code{character} tables for h5 ("areas" "links", "clusters" or "disticts"). Only for Non interactive mode.} - -\item{...}{Other arguments for \code{\link{manipulateWidget}}} -} -\value{ -The function returns an object of class "htmlwidget". It is generated by -package \code{highcharter} if time step is annual or by \code{dygraphs} for -any other time step.It can be directly displayed in the viewer or be stored -in a variable for later use. -} -\description{ -This function generates an interactive plot of an antares time series. -} -\details{ -If the input data contains several Monte-Carlo scenarios, the function will -display the evolution of the average value. Moreover it will represent a -95% confidence interval. - -If the input data has a annual time step, the function creates a barplot -instead of a line chart. - -compare argument can take following values : -\itemize{ - \item "mcYear" - \item "main" - \item "variable" - \item "type" - \item "confInt" - \item "elements" - \item "aggregate" - \item "legend" - \item "highlight" - \item "stepPlot" - \item "drawPoints" - \item "secondAxis" - } -} -\examples{ -\dontrun{ -setSimulationPath(path = path1) -mydata <- readAntares(areas = "all", timeStep = "hourly") -plot(x = mydata) - -# Plot only a few areas -plot(x = mydata[area \%in\% c("area1", "area2", "area3")]) - -# If data contains detailed results, then the function adds a confidence -# interval -dataDetailed <- readAntares(areas = "all", timeStep = "hourly", mcYears = 1:2) -plot(x = dataDetailed) - -# If the time step is annual, the function creates a barplot instead of a -# linechart -dataAnnual <- readAntares(areas = "all", timeStep = "annual") -plot(x = dataAnnual) - -# Compare two simulaitons -# Compare the results of two simulations -setSimulationPath(path1) -mydata1 <- readAntares(areas = "all", timeStep = "daily") -setSimulationPath(path2) -mydata2 <- readAntares(areas = "all", timeStep = "daily") - -plot(x = list(mydata1, mydata2)) - -# When you compare studies, you have 2 ways to defind inputs, union or intersect. -# for example, if you chose union and you have mcYears 1 and 2 in the first study -# and mcYears 2 and 3 in the second, mcYear input will be worth c(1, 2, 3) -# In same initial condition (study 1 -> 1,2 ans study 2 -> 2, 3) if you choose intersect, -# mcYear input will be wort 2. -# You must specify union or intersect with xyCompare argument (default union). -plot(x = list(mydata1[area \%in\% c("a", "b")], - mydata1[area \%in\% c("b", "c")]), xyCompare = "union") -plot(x = list(mydata1[area \%in\% c("a", "b")], - mydata1[area \%in\% c("b", "c")]), xyCompare = "intersect") - -# Compare data in a single simulation -# Compare two periods for the same simulation -plot(x = mydata1, compare = "dateRange") - -# Compare two Monte-Carlo scenarios -detailedData <- readAntares(areas = "all", mcYears = "all") -plot(x = detailedData, .compare = "mcYear") - -# Use h5 for dynamic request / exploration in a study -# Set path of simulaiton -setSimulationPath(path = path1) - -# Convert your study in h5 format -writeAntaresH5(path = mynewpath) - -# Redefine sim path with h5 file -opts <- setSimulationPath(path = mynewpath) -plot(x = opts) - -# Compare elements in a single study -plot(x = opts, .compare = "mcYear") -# Compare 2 studies -plot(x = list(opts, opts2)) - -} - - - - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.R +\name{tsPlot} +\alias{tsPlot} +\alias{plot.antaresData} +\title{plot time series contained in an antaresData object} +\usage{ +tsPlot(x, y = NULL, table = NULL, variable = NULL, elements = NULL, + mcYear = "average", type = c("ts", "barplot", "monotone", "density", + "cdf", "heatmap"), dateRange = NULL, confInt = 0, minValue = NULL, + maxValue = NULL, aggregate = c("none", "mean", "sum"), compare = NULL, + compareOpts = list(), interactive = getInteractivity(), colors = NULL, + main = NULL, ylab = NULL, legend = TRUE, legendItemsPerRow = 5, + colorScaleOpts = colorScaleOptions(20), width = NULL, height = NULL, + ...) + +\method{plot}{antaresData}(x, y = NULL, table = NULL, variable = NULL, + elements = NULL, mcYear = "average", type = c("ts", "barplot", + "monotone", "density", "cdf", "heatmap"), dateRange = NULL, confInt = 0, + minValue = NULL, maxValue = NULL, aggregate = c("none", "mean", "sum"), + compare = NULL, compareOpts = list(), interactive = getInteractivity(), + colors = NULL, main = NULL, ylab = NULL, legend = TRUE, + legendItemsPerRow = 5, colorScaleOpts = colorScaleOptions(20), + width = NULL, height = NULL, ...) +} +\arguments{ +\item{x}{Object of class \code{antaresData}. Alternatively, it can be a list of +\code{antaresData} objects. In this case, one chart is created for each +object.} + +\item{y}{Optional object of class \code{antaresData}. If it is specified, then two +charts are generated.} + +\item{table}{Name of the table to display when \code{x} is an \code{antaresDataList} +object.} + +\item{variable}{Name of the variable to plot. If this argument is missing, then the +function starts a shiny gadget that let the user choose the variable to +represent. When the user clicks on the "Done" button", the graphic is +returned by the function.} + +\item{elements}{Vector of "element" names indicating for which elements of 'x' should the +variable be plotted. For instance if the input data contains areas, then +this parameter should be a vector of area names. If data contains clusters +data, this parameter has to be the concatenation of the area name and the +cluster name, separated by \code{" > "}. This is to prevent confusion +when two clusters from different areas have the same name.} + +\item{mcYear}{If \code{x}, contains multiple Monte-Carlo scenarios, this parameter +determine which scenario is displayed. Must be an integer representing the +index of the scenario or the word "average". In this case data are +averaged.} + +\item{type}{Type of plot to draw. "ts" creates a time series plot, "barplot" creates +a barplot with one bar per element representing the average value of the +variable for this element. "monotone" draws the monotone curve of the +variable for each element.} + +\item{dateRange}{A vector of two dates. Only data points between these two dates are +displayed. If NULL, then all data is displayed.} + +\item{confInt}{Number between 0 and 1 indicating the size of the confidence interval to +display. If it equals to 0, then confidence interval is not computed nor +displayed. Used only when multiple Monte Carlo scenarios are present in +the input data.} + +\item{minValue}{Only used if parameter \code{type} is "density" or "cdf". If this parameter +is set, all values that are less than \code{minValue} are removed from the +graphic. This is useful to deal with variables containing a few extreme +values (generally cost and price variables). If \code{minValue} is unset, +all values are displayed.} + +\item{maxValue}{Only used if parameter \code{type} is "density" or "cdf". If this parameter +is set, all values not in [-minValue, maxValue] are removed from the graphic. +This is useful to deal with variables containing a few extreme values +(generally cost and price variables). If \code{maxValue} is 0 or unset, all +values are displayed.} + +\item{aggregate}{When multiple elements are selected, should the data be aggregated. If +"none", each element is represented separetly. If "mean" values are +averaged and if "sum" they are added.} + +\item{compare}{An optional character vector containing names of parameters. When it is set, +two charts are outputed with their own input controls. Alternatively, it can +be a named list with names corresponding to parameter names and values being +list with the initial values of the given parameter for each chart.} + +\item{compareOpts}{List of options that indicates the number of charts to create and their +position. Check out the documentation of +\code{\link[manipulateWidget]{compareOptions}} to see available options.} + +\item{interactive}{LogicalValue. If \code{TRUE}, then a shiny gadget is launched that lets +the user interactively choose the areas or districts to display.} + +\item{colors}{Vector of colors} + +\item{main}{Title of the graph.} + +\item{ylab}{Label of the Y axis.} + +\item{legend}{Logical value indicating if a legend should be drawn. This argument is +usefull when one wants to create a shared legend with +\code{\link{prodStackLegend}}} + +\item{legendItemsPerRow}{Number of elements to put in each row of the legend.} + +\item{colorScaleOpts}{A list of parameters that control the creation of color scales. It is used +only for heatmaps. See \code{\link{colorScaleOptions}}() for available +parameters.} + +\item{width}{Width of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{height}{Height of the graph expressed in pixels or in percentage of +the parent element. For instance "500px" and "100\%" are valid values.} + +\item{...}{currently unused} +} +\value{ +The function returns an object of class "htmlwidget". It is generated by +package \code{highcharter} if time step is annual or by \code{dygraphs} for +any other time step.It can be directly displayed in the viewer or be stored +in a variable for later use. +} +\description{ +This function generates an interactive plot of an antares time series. +} +\details{ +If the input data contains several Monte-Carlo scenarios, the function will +display the evolution of the average value. Moreover it will represent a +95% confidence interval. + +If the input data has a annual time step, the function creates a barplot +instead of a line chart. +} +\examples{ +\dontrun{ +setSimulationPath() +mydata <- readAntares("all", timeStep = "monthly") +plot(mydata) +plot(mydata, "LOAD") + +# Plot only a few areas +plot(mydata[area \%in\% c("area1", "area2", "area3")]) + +# If data contains detailed results, then the function adds a confidence +# interval +dataDetailed <- readAntares("all", timeStep = "monthly", synthesis = FALSE) +plot(dataDetailed) + +# If the time step is annual, the function creates a barplot instead of a +# linechart +dataAnnual <- readAntares("all", timeStep = "Annual") +plot(dataAnnual) + +# Compare the results of two simulations +setSimulationPath(path1) +mydata1 <- readAntares("all", timeStep = "daily") +setSimulationPath(path2) +mydata2 <- readAntares("all", timeStep = "daily") + +plot(mydata1, mydata2) + +# Compare two periods for the same simulation +plot(mydata1, compare = "dateRange") + +# Compare two Monte-Carlo scenarios +detailedData <- readAntares("all", mcYears = "all") +plot(detailedData[mcYear == 1], detailedData[mcYear == 2]) + +# To do the same thing, with antaresDataList objects, one can use 'subset' +detailedData <- readAntares(areas = "all" links = "all", mcYears = "all") +plot(subset(detailedData, mcYears = 1), subset(detailedData, mcYears = 2)) +} + +} diff --git a/tests/testthat/helper-init.R b/tests/testthat/helper-init.R index ba421b4..5b53d97 100644 --- a/tests/testthat/helper-init.R +++ b/tests/testthat/helper-init.R @@ -3,10 +3,7 @@ # Copy the test study in a temporary folder path <- tempdir() - -sourcedir <- system.file("inst/testdata", package = "antaresRead") -if(sourcedir == ""){sourcedir <- system.file("testdata", package = "antaresRead")} - +sourcedir <- system.file("testdata", package = "antaresRead") # Hack: For some unknown reason, this script is executed at some point of # the R CMD CHECK before package is correctly installed and tests actually run. diff --git a/tests/testthat/test-exchangesStack.R b/tests/testthat/test-exchangesStack.R deleted file mode 100644 index 528c2fb..0000000 --- a/tests/testthat/test-exchangesStack.R +++ /dev/null @@ -1,18 +0,0 @@ -context("exchangesStack") - -describe("no interactivy", { - - mydata <- readAntares(links = "all", timeStep = "daily", showProgress = FALSE) - - # default parameters - default_params <- exchangesStack(mydata, interactive = FALSE) - expect_is(default_params, "htmlwidget") - - # TO DO : passer les arguments - # passer plusieurs data - # .compare - - # suivant les cas : - # - tester les retours d'erreurs - -}) \ No newline at end of file diff --git a/tests/testthat/test-getTSData.R b/tests/testthat/test-getTSData.R deleted file mode 100644 index ae70160..0000000 --- a/tests/testthat/test-getTSData.R +++ /dev/null @@ -1,56 +0,0 @@ -context(".getTSData") - -describe(".getTSData", { - # Helper function that checks the structure of object returned by .getTSData - # is ok - check_obj <- function(x, aggregated = FALSE) { - expect_is(x, "data.table") - expect_true(all(c("element", "timeId", "time", "value") %in% names(x))) - } - - mydata <- readAntares(timeStep = "daily", mcYears = "all", showProgress = FALSE) - tpl <- mydata[, .(mcYear, element = area, timeId, time, value = 0)] - - it ("returns a table with element, timeId, time and value columns", { - dt <- .getTSData(mydata, tpl, "LOAD", "all") - check_obj(dt) - }) - - it ("can filter data by element, date, mcYear", { - # element - myarea <- getAreas()[1] - dt <- .getTSData(mydata, tpl, "LOAD", elements = myarea) - check_obj(dt) - expect_true(all(dt$element == myarea)) - expect_equal(dt$value, mydata[area == myarea, LOAD]) - - # date - dateRange <- c(min(dt$time), min(dt$time)) - dt <- .getTSData(mydata, tpl, "LOAD", "all", dateRange = dateRange) - check_obj(dt) - expect_true(all(dt$time == dateRange[1])) - expect_equal(dt$value, mydata[time == dateRange[1], LOAD]) - - # mcYear - dt <- .getTSData(mydata, tpl, "LOAD", "all", mcYear = 1) - check_obj(dt) - expect_true(all(dt$mcYear == 1)) - expect_equal(dt$value, mydata[mcYear == 1, LOAD]) - }) - - it ("can aggregate data", { - # sum - dt <- .getTSData(mydata, tpl, "LOAD", "all", aggregate = "sum") - check_obj(dt) - expect_true(all(dt$element == "LOAD")) - expectValue <- mydata[, .(LOAD = sum(LOAD)), by = .(mcYear, timeId)] - expect_equal(dt$value, expectValue$LOAD) - - # mean - dt <- .getTSData(mydata, tpl, "LOAD", "all", aggregate = "mean") - check_obj(dt) - expect_true(all(dt$element == "LOAD")) - expectValue <- mydata[, .(LOAD = mean(LOAD)), by = .(mcYear, timeId)] - expect_equal(dt$value, expectValue$LOAD) - }) -}) \ No newline at end of file diff --git a/tests/testthat/test-get_data_for_comp.R b/tests/testthat/test-get_data_for_comp.R index c97bc00..ebba455 100644 --- a/tests/testthat/test-get_data_for_comp.R +++ b/tests/testthat/test-get_data_for_comp.R @@ -1,4 +1,5 @@ context(".getDataForComp") + # Helper function check_structure <- function(x, y = NULL, compare = NULL, compareOpts = NULL) { res <- .getDataForComp(x, y, compare, compareOpts) diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R deleted file mode 100644 index 56861a9..0000000 --- a/tests/testthat/test-map.R +++ /dev/null @@ -1,34 +0,0 @@ -context("plotMap") - - -describe("plotMap, no interactive", { - - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - testClass <- function(obj){ - class(obj)[1] == 'combineWidgets' - } - load(system.file("mapLayout/ml.rda", package = "antaresViz")) - - listArgs <- list(noarg = list(x = dta, interactive = FALSE, mapLayout = ml), - colorLinks = list(x = dta, interactive = FALSE, mapLayout = ml, colLinkVar = "FLOW LIN."), - colorAll = list(x = dta, interactive = FALSE, mapLayout = ml, colLinkVar = "FLOW LIN.", - colAreaVar = "OP. COST") - ) - - lapply(listArgs, function(X){ - test_that (names(listArgs), { - re1 <- do.call(plotMap, X) - expect_true(testClass(re1)) - }) - }) - -}) - -describe("plotMap, no interactive return error", { - - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - load(system.file("mapLayout/ml.rda", package = "antaresViz")) - - expect_error(plotMap(dta, ml , interactive = FALSE, compare = "areas")) - -}) \ No newline at end of file diff --git a/tests/testthat/test-prodStack.R b/tests/testthat/test-prodStack.R deleted file mode 100644 index 1775580..0000000 --- a/tests/testthat/test-prodStack.R +++ /dev/null @@ -1,27 +0,0 @@ -describe("prodStack, no interactive", { - - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - testClass <- function(obj){ - class(obj)[1] == 'combineWidgets' - } - listArgs <- list(noarg = list(x = dta, interactive = FALSE, areas = "a"), - areas2 = list(x = dta, interactive = FALSE, areas = c("a", "b")) - ) - - - lapply(listArgs, function(X){ - test_that (names(listArgs), { - re1 <- do.call(prodStack, X) - expect_true(testClass(re1)) - }) - }) - -}) - - -describe("prodStack, no interactive return error", { - - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - expect_error(prodStack(dta, interactive = FALSE, compare = "areas")) - -}) \ No newline at end of file diff --git a/tests/testthat/test-stackExchanges.R b/tests/testthat/test-stackExchanges.R deleted file mode 100644 index 96f4066..0000000 --- a/tests/testthat/test-stackExchanges.R +++ /dev/null @@ -1,31 +0,0 @@ -context("stackExchanges") - - -describe("stackExchanges, no interactive", { - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - testClass <- function(obj){ - class(obj)[1] == 'combineWidgets' - } - listArgs <- list(noarg = list(x = dta, interactive = FALSE, areas = "a"), - allAreas = list(x = dta, interactive = FALSE, areas = "all"), - main = list(x = dta, interactive = FALSE, areas = "all", main = "Title"), - ylab = list(x = dta, interactive = FALSE, areas = "all", main = "Title", ylab = "Subt") - ) - - - lapply(listArgs, function(X){ - test_that (names(listArgs), { - re1 <- do.call(exchangesStack, X) - expect_true(testClass(re1)) - }) - }) - -}) - -describe("stackExchanges, no interactive return error", { - - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - - expect_error(exchangesStack(dta, interactive = FALSE, compare = "areas")) - -}) \ No newline at end of file diff --git a/tests/testthat/test-ts_plot.R b/tests/testthat/test-ts_plot.R deleted file mode 100644 index 6e7aa7a..0000000 --- a/tests/testthat/test-ts_plot.R +++ /dev/null @@ -1,95 +0,0 @@ -context("tsPlot") - -describe(".getTSData", { - # Helper function that checks the structure of object returned by .getTSData - # is ok - check_obj <- function(x, aggregated = FALSE) { - expect_is(x, "data.table") - expect_true(all(c("element", "timeId", "time", "value") %in% names(x))) - } - - mydata <- readAntares(timeStep = "daily", mcYears = "all", showProgress = FALSE) - tpl <- mydata[, .(mcYear, element = area, timeId, time, value = 0)] - - it ("returns a table with element, timeId, time and value columns", { - dt <- .getTSData(mydata, tpl, "LOAD", "all") - check_obj(dt) - }) - - it ("can filter data by element, date, mcYear", { - # element - myarea <- getAreas()[1] - dt <- .getTSData(mydata, tpl, "LOAD", elements = myarea) - check_obj(dt) - expect_true(all(dt$element == myarea)) - expect_equal(dt$value, mydata[area == myarea, LOAD]) - - # date - dateRange <- c(min(dt$time), min(dt$time)) - dt <- .getTSData(mydata, tpl, "LOAD", "all", dateRange = dateRange) - check_obj(dt) - expect_true(all(dt$time == dateRange[1])) - expect_equal(dt$value, mydata[time == dateRange[1], LOAD]) - - # mcYear - dt <- .getTSData(mydata, tpl, "LOAD", "all", mcYear = 1) - check_obj(dt) - expect_true(all(dt$mcYear == 1)) - expect_equal(dt$value, mydata[mcYear == 1, LOAD]) - }) - - it ("can aggregate data", { - # sum - dt <- .getTSData(mydata, tpl, "LOAD", "all", aggregate = "sum") - check_obj(dt) - expect_true(all(dt$element == "LOAD")) - expectValue <- mydata[, .(LOAD = sum(LOAD)), by = .(mcYear, timeId)] - expect_equal(dt$value, expectValue$LOAD) - - # mean - dt <- .getTSData(mydata, tpl, "LOAD", "all", aggregate = "mean") - check_obj(dt) - expect_true(all(dt$element == "LOAD")) - expectValue <- mydata[, .(LOAD = mean(LOAD)), by = .(mcYear, timeId)] - expect_equal(dt$value, expectValue$LOAD) - }) -}) - - -describe("tsPlot, no interactive", { - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - testClass <- function(obj){ - class(obj)[1] == 'combineWidgets' - } - listArgs <- list(noarg = list(x = dta, interactive = FALSE), - elem = list(x = dta, interactive = FALSE, elements = "a"), - elemS = list(x = dta, interactive = FALSE, elements = c("a", "b")), - linkS = list(x = dta, table = "links", interactive = FALSE, elements = c("a - a_offshore")), - linkSVarSel = list(x = dta, table = "links", interactive = FALSE, - elements = c("a - a_offshore"), - variable = "FLOW LIN._std"), - bar = list(x = dta, interactive = FALSE, elements = "all", type = "barplot"), - monotone = list(x = dta, interactive = FALSE, elements = "all", type = "monotone"), - density = list(x = dta, interactive = FALSE, elements = "all", type = "density"), - cdf = list(x = dta, interactive = FALSE, elements = "all", type = "cdf"), - heatmap = list(x = dta, interactive = FALSE, elements = "all", type = "heatmap") - ) - - lapply(listArgs, function(X){ - test_that (names(listArgs), { - re1 <- do.call(tsPlot, X) - expect_true(testClass(re1)) - }) - }) - -}) - - - -describe("tsPlot, no interactive return error", { - - dta <- readAntares(areas = "all", links = "all", showProgress = FALSE) - - expect_error(tsPlot(dta, interactive = FALSE, compare = "areas")) - -}) \ No newline at end of file diff --git a/vignettes/antaresViz.Rmd b/vignettes/antaresViz.Rmd deleted file mode 100644 index 04f7f2d..0000000 --- a/vignettes/antaresViz.Rmd +++ /dev/null @@ -1,195 +0,0 @@ ---- -title: "Quick presentation of antaresViz" -author: "RTE" -date: "`r Sys.Date()`" -output: html_vignette -vignette: > - %\VignetteIndexEntry{Vignette Title} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - - - -![](antareslogo.png) - -This package works along with RTE's adequacy software ANTARES : https://antares.rte-france.com/ - -`antaresViz` is a package which proposes relevant graphs and maps to vizualize the results of an ANTARES study, with numerous settings and possible customizations. - - - -## Where everything starts - - -```{r loadPackage, message = FALSE, warning=FALSE} -library(antaresViz) -``` - - -The data from an ANTARES study can be imported and easily manipulated using the [antaresRead](https://github.com/rte-antares-rpackage/antaresRead) package. - -The examples presented below have been build on a fictionnal study whose output have been loaded with antaresRead. They contains different types of elements : - - * outputs with an annual and an hourly time step, - * synthetic outputs (averaged on several Monte-Carlo years) and detailled outputs (given year by year), - * outputs for areas, links, clusters and districts. - - -```{r loadData, message = FALSE} -load("data_for_antaresViz_vignette_extralight.Rdata") -``` - -The aim of this vignette is to give a quick overview of the possibilities offered by the package antaresViz. The data with which the following graphs have been plotted are fictionnal. - -## The simple power of the `plot` function - -The `plot()` function, used with an antaresDataList object (i.e. an object returned by the `antaresRead::readAntares()` function) offers different possible vizualisations. - -Moreover, this function is __really easy to use__. It opens a shiny interface which let the user decide : - -* Which type of __element__ he wants to study : areas, links or disctricts. -* Which __variable__ he wants to analyze. -* With which type of __graph__ : barplot, time series, probability density function, heatmap, etc. -* For which area(s), link(s), or district(s). -* And during which __time period__. - - -```r -plot(data_hourly_synthesis) -``` - -![](plot_resized.gif) - - -Note that all the interface manipulation can also be set directly in the arguments of the `plot` function. Some examples of the multiple graphs that can be returned by this function are given below. - -###### Barplot of Loss of Load Duration (LOLD) for several districts of the study - -```{r barplot, eval = FALSE} -plot(data_annual_synthesis, table = "districts" ,variable = "LOLD", type = "barplot", elements = c("00_a", "00_b", "00_c", "00_d", "00_e", "00_f", "00_g", "00_h", "00_i"), interactive = FALSE, width = "100%", height = 400) -``` - - -###### Time series of the load in an area with average value and 95% confidence interval. - -```{r ts, eval=FALSE} -plot(data_hourly_allmc, table = "areas" ,variable = "LOAD", type = "ts", elements = "23_b", confInt = 0.95, dateRange = c("2018-01-08", "2018-01-14"), width = "100%", height = 400, interactive = FALSE) -``` - - -###### Probability density function of the wind power generation in two areas -```{r density, eval=FALSE} -plot(data_hourly_synthesis, table = "areas" ,variable = "WIND", type = "density", elements = c("01_a", "02_a"), interactive = FALSE, width = "100%", height = 400) -``` - - -###### Heatmap of the congestion probability of one interconnection - -```{r heatmap, eval=FALSE} -plot(data_hourly_synthesis_1year, table = "links", variable = "CONG. PROB +", type = "heatmap", elements = "25_c - 26_d", interactive = FALSE, width = "100%", height = 400, main = "Congestion probability") -``` - - -Note that the `plot()` function also contains a `compare` argument which allows comparisons between : - -* different variables -* different areas/links/district -* different studies - - -## When the production meets the demand - -The `prodStack` function builds a graph which contains the time series of demand in one area (or the sum of the demand of a set of areas) along with the generation of this area (or set of areas), divided between the different fuel types (e.g. nuclear, gas, wind, etc). - - -```r -prodStack(data_hourly_synthesis) -``` - -Once again, this function is easy to use and opens a shiny interface which let the user manipulate the selected areas and time range. Some settings can also be passed to the function through its (optionnal) arguments. - -```{r prodStack, eval = FALSE} -prodStack(data_hourly_synthesis, stack = "eco2mix", areas = "37_h", dateRange = c("2018-01-08", "2018-01-21"), main = "Production stack", unit = "GWh", interactive = FALSE, width = "100%", height = 500) -``` - -The graphical template used by default is the one of the RTE's application [eco2mix](http://www.rte-france.com/fr/eco2mix/eco2mix-mix-energetique). This template can though be redefined completely by the user with the function `setProdStackAlias()`. - -The `exchangesStack()` function proposes similar graphs with a superposition of all the imports and exports of an area. - -```{r exchangeStack, eval = FALSE} -exchangesStack(data_hourly_synthesis, area = "37_h", dateRange = c("2018-01-08", "2018-01-21"), main = "Import/Export of area 37_h", unit = "GWh", interactive = FALSE, width = "100%", height = 500) -``` - -## Everything looks better on a map - -Last but not least, `antaresViz` proposes several function to vizualise the results of a study on a map. - -To do so, the first function to use is `mapLayout()`. This function launches an interactive application that let the user place areas of the ANTARES study on a map. - - -```r -antares_layout <- antaresRead::readLayout(opts = antaresRead::setSimulationPath(study_path)) -map_layout <- mapLayout(layout = antares_layout) -``` - -![](maplyout_resized.gif) - -(Once again : the study presented here is fictionnal !) - - -The function `plotMap()` then generates an interactive map that let the user visually explore the results of an Antares simulation. By default the function starts a Shiny gadget that let the user choose : - - * Which __variable__ to represent - * With which __type of vizualisation__ - - areas : color, size, popup, label - - links : color, width of the link, popup - * For which __time step__ or __date range__ - - -```r -plotMap(data_hourly_synthesis, map_layout) -``` - -Some examples of results returned by the `plotMap()` function are depicted below. - - - -###### C02 emissions - -This first map depicts the annual CO2 emissions of all the areas of the ANTARES study. - - -```{r plotmap_co2, eval = FALSE} -plotMap(data_annual_filtered, map_layout, showLabels = TRUE, sizeAreaVar = "CO2 EMIS.", interactive = FALSE, labelAreaVar = "CO2 EMIS.", colAreaVar = "CO2 EMIS.", type = "avg", options = plotMapOptions(areaDefaultSize = 30, labelMaxSize = 8, labelMinSize = 14, areaColorScaleOpts = colorScaleOptions(zeroCol = "white", posCol = "red2")), width = "100%", height = 600) -``` - - -###### Average balance and flows in the system - -This map illustrates the annual balance (MWh exported if positive - or imported if negative - during an hour) of each area and the annual flows of each link. - -```{r plotmap_flows, eval = FALSE} -plotMap(data_annual_synthesis, map_layout, showLabels = TRUE, colAreaVar = "BALANCE", interactive = FALSE, labelAreaVar = "BALANCE", sizeLinkVar = "FLOW LIN.", type = "avg", options = plotMapOptions(areaDefaultSize = 30, labelMaxSize = 10, labelMinSize = 8, areaColorScaleOpts = colorScaleOptions(negCol = "tomato3", zeroCol = "white", posCol = "blue3")), width = "100%", height = 600) -``` - - -###### Energy mixes - -The proportion of each energy type in the annual production of each area is illustrated on this next map. The actual generated energies (in MWh) can be known by clicking on the pie charts. - -```{r plotmap_mix, eval = FALSE} -data_annual_synthesis$areas <- data_annual_synthesis$areas[, `:=`(THERMAL = NUCLEAR + LIGNITE + COAL + GAS + OIL + `MIX. FUEL` + `MISC. DTG`, HYDRO =`H. ROR` + `H. STOR`)] - -plotMap(data_annual_synthesis, map_layout, interactive = FALSE, sizeAreaVars = c("HYDRO", "SOLAR", "WIND", "THERMAL"), popupAreaVars = c("HYDRO", "SOLAR", "WIND", "THERMAL"),areaChartType = "pie", type = "avg", options = plotMapOptions(areaDefaultSize = 25), width = "100%", height = 600) -``` - - - -## Let's get started - -The `antaresViz` package is available on the CRAN and can be installed with : -```r -install.packages("antaresViz") -``` - diff --git a/vignettes/antareslogo.png b/vignettes/antareslogo.png deleted file mode 100644 index c434774..0000000 Binary files a/vignettes/antareslogo.png and /dev/null differ diff --git a/vignettes/data_for_antaresViz_vignette_extralight.Rdata b/vignettes/data_for_antaresViz_vignette_extralight.Rdata deleted file mode 100644 index 1030ef1..0000000 Binary files a/vignettes/data_for_antaresViz_vignette_extralight.Rdata and /dev/null differ diff --git a/vignettes/maplyout_resized.gif b/vignettes/maplyout_resized.gif deleted file mode 100644 index 5fe4738..0000000 Binary files a/vignettes/maplyout_resized.gif and /dev/null differ diff --git a/vignettes/plot_resized.gif b/vignettes/plot_resized.gif deleted file mode 100644 index 3f84eb4..0000000 Binary files a/vignettes/plot_resized.gif and /dev/null differ