diff --git a/.Rbuildignore b/.Rbuildignore
index 450d3b7..9ab0c90 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -1,12 +1,14 @@
-^.*\.Rproj$
-^\.Rproj\.user$
-^appveyor\.yml$
-^\.travis\.yml$
-^codecov\.yml$
-inst/examples
-^_pkgdown\.yml$
-^docs$
-^pkgdown$
-^cran-comments\.md$
-^CRAN-RELEASE$
-^\.github$
+^.*\.Rproj$
+^\.Rproj\.user$
+^appveyor\.yml$
+^\.travis\.yml$
+^codecov\.yml$
+inst/examples
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^cran-comments\.md$
+^CRAN-RELEASE$
+^\.github$
+^revdep$
+^README\.Rmd$
diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
new file mode 100644
index 0000000..2c5bb50
--- /dev/null
+++ b/.github/workflows/test-coverage.yaml
@@ -0,0 +1,50 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+ push:
+ branches: [main, master]
+ pull_request:
+ branches: [main, master]
+
+name: test-coverage
+
+jobs:
+ test-coverage:
+ runs-on: ubuntu-latest
+ env:
+ GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+ steps:
+ - uses: actions/checkout@v3
+
+ - uses: r-lib/actions/setup-r@v2
+ with:
+ use-public-rspm: true
+
+ - uses: r-lib/actions/setup-r-dependencies@v2
+ with:
+ extra-packages: any::covr
+ needs: coverage
+
+ - name: Test coverage
+ run: |
+ covr::codecov(
+ quiet = FALSE,
+ clean = FALSE,
+ install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+ )
+ shell: Rscript {0}
+
+ - name: Show testthat output
+ if: always()
+ run: |
+ ## --------------------------------------------------------------------
+ find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+ shell: bash
+
+ - name: Upload test results
+ if: failure()
+ uses: actions/upload-artifact@v3
+ with:
+ name: coverage-test-failures
+ path: ${{ runner.temp }}/package
diff --git a/.gitignore b/.gitignore
index 28bc3a1..37a476c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,10 @@
-.Rproj.user
-.Rhistory
-.RData
-.Ruserdata
-inst/examples
-inst/doc
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+.idea
+inst/examples
+inst/doc
+.Rdata
+.httr-oauth
+.DS_Store
diff --git a/DESCRIPTION b/DESCRIPTION
index 657920e..df75780 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,9 +1,9 @@
Package: antaresViz
Type: Package
Title: Antares Visualizations
-Version: 0.17.1
+Version: 0.18.0
Authors@R: c(
- person("Veronique", "Bachelier", email = "veronique.bachelier@rte-france.com", role = c("aut", "cre")),
+ person("Tatiana", "Vargas", email = "tatiana.vargas@rte-france.com", role = c("aut", "cre")),
person("Jalal-Edine", "Zawam", role = "aut"),
person("Francois", "Guillem", role = "aut"),
person("Benoit", "Thieurmel", role = "aut"),
@@ -23,8 +23,8 @@ License: GPL (>= 2) | file LICENSE
Encoding: UTF-8
Depends:
antaresRead (>= 2.2.9),
- antaresProcessing (>= 0.13.0),
- spMaps (>= 0.2)
+ antaresProcessing (>= 0.13.0),
+ spMaps (>= 0.5.0)
Imports:
dygraphs (>= 1.1.1.6),
shiny (>= 0.13.0),
@@ -33,9 +33,8 @@ Imports:
htmlwidgets (>= 0.7.0),
manipulateWidget (>= 0.10.0),
leaflet (>= 1.1.0),
- sp,
- rgeos,
- raster,
+ sp (>= 2.0-0),
+ sf,
webshot,
data.table,
methods,
@@ -47,7 +46,7 @@ Imports:
assertthat,
rAmCharts,
utils
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.2
Suggests:
testthat,
covr,
diff --git a/NAMESPACE b/NAMESPACE
index bb5472a..ac472e7 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,75 +1,74 @@
-# 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(exchangesStackAliases)
-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(prodStackExchangesLegend)
-export(prodStackLegend)
-export(renderLeafletDragPoints)
-export(runAppAntaresViz)
-export(savePlotAsPng)
-export(setExchangesStackAlias)
-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(rAmCharts)
-import(shiny)
-import(sp)
-import(spMaps)
-importFrom(geojsonio,geojson_json)
-importFrom(grDevices,col2rgb)
-importFrom(grDevices,colorRampPalette)
-importFrom(grDevices,colors)
-importFrom(grDevices,gray)
-importFrom(grDevices,rainbow)
-importFrom(grDevices,rgb)
-importFrom(graphics,par)
-importFrom(graphics,plot.default)
-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(raster,aggregate)
-importFrom(rgeos,gDistance)
-importFrom(shiny,runApp)
-importFrom(stats,as.formula)
-importFrom(stats,density)
-importFrom(stats,lm)
-importFrom(stats,predict)
-importFrom(stats,quantile)
-importFrom(utils,capture.output)
-importFrom(utils,object.size)
+# 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(exchangesStackAliases)
+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(prodStackExchangesLegend)
+export(prodStackLegend)
+export(renderLeafletDragPoints)
+export(runAppAntaresViz)
+export(savePlotAsPng)
+export(setExchangesStackAlias)
+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(rAmCharts)
+import(sf)
+import(shiny)
+import(sp)
+import(spMaps)
+importFrom(geojsonio,geojson_json)
+importFrom(grDevices,col2rgb)
+importFrom(grDevices,colorRampPalette)
+importFrom(grDevices,colors)
+importFrom(grDevices,gray)
+importFrom(grDevices,rainbow)
+importFrom(grDevices,rgb)
+importFrom(graphics,par)
+importFrom(graphics,plot.default)
+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,capture.output)
+importFrom(utils,object.size)
diff --git a/NEWS.md b/NEWS.md
index 8a90fa0..ee6a721 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,8 @@
-Copyright © 2016 RTE Réseau de transport d’électricité
+Copyright 2016 RTE Reseau de transport d'electricite
+
+# antaresViz 0.18.0
+* fix deprecated dependencies (issue #200)
+ * packages `rgeos`, `raster` removed and replaced by `sf`
# antaresViz 0.17.1
diff --git a/R/map_layout.R b/R/map_layout.R
index d776d52..8509562 100644
--- a/R/map_layout.R
+++ b/R/map_layout.R
@@ -1,645 +1,648 @@
-# Copyright © 2016 RTE Réseau de transport d’électricité
-
-#' Place areas of a study on a map
-#'
-#' 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.
-#'
-#' @param layout
-#' object returned by function \code{\link[antaresRead]{readLayout}}
-#' @param what
-#' Either "areas" or "districts". Indicates what type of object to place
-#' on the map.
-#' @param map
-#' An optional \code{\link[sp]{SpatialPolygons}} or
-#' \code{\link[sp:SpatialPolygons]{SpatialPolygonsDataFrame}} object. See \code{\link[spMaps:spMaps]{getSpMaps}}
-#'
-#' @param map_builder \code{logical} Add inputs for build custom map ? Defaut to TRUE.
-#'
-#' @details
-#' With \code{map_builder} option, you can build a quiet custom map using \code{spMaps} package.
-#' This package help you to build \code{\link[sp:SpatialPolygons]{SpatialPolygonsDataFrame}} on Europe.
-#' Moreover, you can use two options in the module :
-#'
-#' \itemize{
-#' \item {"Merge countries" : Some countries like UK or Belgium are firstly rendered in multiple and diffrent area.
-#' You can so choose to finally use this countries as one single area on the map}
-#' \item {"Merge states" : If you need states details but not having one area per state, the map will be incomplete
-#' for some countries, plotting only states with area. So you can choose to aggregate the states of the countries.
-#' This is done using a nearest states algorithm. The result is available only after layout validation.}
-#' }
-#' @return
-#' An object of class \code{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)
-#'
-#' # 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) {
-
- 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)
- }
-
- mapCoords <- shiny::runApp(shiny::shinyApp(ui = ui, server = server))
-
- 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){
-
- 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
- } else {
- stop("No coordinates found in layout")
- }
-
- leafletDragPoints(coords, map = mapLayout$map, init = TRUE, draggable = FALSE)
-}
-
-# 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(3,
- if (map_builder){
- selectInput(ns("ml_countries"), "Countries : ", width = "100%",
- choices = choices_map, selected = "all", multiple = TRUE)
- }
- ),
- column(3,
- if (map_builder){
- selectInput(ns("ml_states"), "States : ", width = "100%",
- choices = choices_map, selected = NULL, multiple = TRUE)
- }
- ),
- column(2,
- if (map_builder){
- div(br(), checkboxInput(ns("merge_cty"), "Merge countries ?", TRUE), align = "center")
- }
- ),
- column(2,
- if (map_builder){
- div(br(), checkboxInput(ns("merge_ste"), "Merge states ?", TRUE), align = "center")
- }
- ),
- 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(textOutput(ns("title_layout"))), align = "center")),
- column(2,
- conditionalPanel(
- condition = paste0("output['", ns("control_state"), "'] >= 2"),
- div(br(), actionButton(ns("done"), "Done"), align = "center")
- )
- )
- ),
-
- 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
-#' @import sp
-#' @importFrom rgeos gDistance
-#' @importFrom raster aggregate
-changeCoordsServer <- function(input, output, session,
- layout, what = reactive("areas"),
- map = reactive(NULL), map_builder = TRUE,
- language = reactive("en"), stopApp = FALSE){
-
- ns <- session$ns
-
- lfDragPoints <- reactiveValues(map = NULL, init = FALSE)
-
- current_state <- reactiveValues(state = -1)
- output$control_state <- reactive({
- current_state$state
- })
-
- observe({
- updateSelectInput(session, "ml_countries",
- label = paste0(.getLabelLanguage("Countries", language()), " : "))
- updateSelectInput(session, "ml_states",
- label = paste0(.getLabelLanguage("States", language()), " : "))
-
- updateCheckboxInput(session, "merge_cty", .getLabelLanguage("Merge countries ?", language()))
- updateCheckboxInput(session, "merge_ste", .getLabelLanguage("Merge states ?", language()))
-
- updateActionButton(session, "state", label = .getLabelLanguage("Next", language()))
- updateActionButton(session, "done", label = .getLabelLanguage("Done", language()))
- updateActionButton(session, "reset_ml", label = .getLabelLanguage("Re-Init layout", language()))
- updateActionButton(session, "set_map_ml", label = .getLabelLanguage("Set map", language()))
-
- })
-
- output$title_layout <- renderText({
- .getLabelLanguage("Map Layout", language())
- })
-
- outputOptions(output, "control_state", suspendWhenHidden = FALSE)
-
- current_map <- reactive({
- if (!map_builder){
- checkSlotId(map())
- } else {
- if (!is.null(map()) & input$set_map_ml == 0){
- checkSlotId(map())
- } else {
- checkSlotId(getSpMaps(countries = isolate(input$ml_countries), states = isolate(input$ml_states),
- mergeCountry = isolate(input$merge_cty)))
- }
- }
- })
-
- data <- reactive({
- input$reset_ml
- if (!is.null(layout())){
- if (what() == "areas") {
- coords <- copy(layout()$areas)
- info <- coords$area
- links <- copy(layout()$links)
- if(is.null(links)) links <- data.table()
- } else {
- coords <- copy(layout()$districts)
- info <- coords$district
- links <- copy(layout()$districtLinks)
- if(is.null(links)) links <- data.table()
- }
-
- 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))
- graphics::plot.default(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({
- .getLabelLanguage("Please place the following point on the map", language())
- })
-
- 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({
- .getLabelLanguage("Drag the markers on the map to adjust coordinates then click the 'Done' button", language())
- })
-
- output$info <- renderUI(HTML(
- paste0("",
- .getLabelLanguage("You can click on a marker to display information", language()),
- "
"))
- )
-
- })
- }
- })
-
- # 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"))
-
- # special with only one area...
- if(nrow(data()$coords) == 1){
- coords <- coords[1, ]
- }
-
- 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
- if(nrow(data()$coords) > 1){
- ord <- order(c(data_points$pt1, data_points$pt2, (1:length(coords))[-c(data_points$pt1, data_points$pt2)]))
- mapCoords <- coords[ord, ]
- } else {
- mapCoords <- coords
- }
-
- final_coords <- data()$coords
- final_links <- data()$links
-
- final_coords$x <- sp::coordinates(mapCoords)[, 1]
- final_coords$y <- sp::coordinates(mapCoords)[, 2]
-
- if (what() == "areas") {
- if(!is.null(final_links) && nrow(final_links) > 0){
- 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 {
- if(!is.null(final_links) && nrow(final_links) > 0){
- final_links[final_coords, `:=`(x0 = x, y0 = y), on = c(fromDistrict = "district")]
- final_links[final_coords, `:=`(x1 = x, y1 = y), on = c(toDistrict = "district")]
- }
- }
-
- if (!is.null(map)) {
- final_coords$geoAreaId <- mapCoords$geoAreaId
- final_coords_map <- final_coords[!is.na(final_coords$geoAreaId), ]
- if (!isolate(input$merge_ste)){
- map <- map[final_coords_map$geoAreaId, ]
- } else {
- if (all(c("name", "code") %in% names(map))){
- keep_code <- unique(map$code[final_coords_map$geoAreaId])
- # subset on countries
- tmp_map <- map[map$code %in% keep_code, ]
-
- if (nrow(tmp_map) > 0){
- # set unlink states
- tmp_map$geoAreaId[!tmp_map$geoAreaId %in% final_coords_map$geoAreaId] <- NA
-
- ind_na <- which(is.na(tmp_map$geoAreaId))
- if (length(ind_na) > 0){
- # have to find nearestArea...
- treat_cty <- unique(tmp_map$code[ind_na])
-
- for (cty in treat_cty){
- ind_cty <- which(tmp_map$code %in% cty)
- ind_miss <- which(tmp_map$code %in% cty & is.na(tmp_map$geoAreaId))
- areas <- coords[coords$geoAreaId %in% tmp_map$geoAreaId[ind_cty], ]
- if (nrow(areas) > 0){
- areas_min <- suppressWarnings(apply(rgeos::gDistance(tmp_map[ind_miss, ], areas, byid = TRUE), 2, which.min))
- tmp_map$geoAreaId[ind_miss] <- areas$geoAreaId[areas_min]
- }
- }
-
- tmp_map <- raster::aggregate(tmp_map, by = c("geoAreaId"))
- map <- tmp_map[match(final_coords_map$geoAreaId, tmp_map$geoAreaId), ]
- } else {
- map <- map[final_coords_map$geoAreaId, ]
- }
- }else {
- map <- map[final_coords_map$geoAreaId, ]
- }
- } else {
- map <- map[final_coords_map$geoAreaId, ]
- }
- # remove if multiple same polygon. Needed other change...
- # map <- map[!duplicated(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)
- }
- })
-
- return(reactive(cur_coords$data))
-}
-
-.changeCoordinates <- function(points, coords, pts = 1:nrow(points)) {
- coords$oldLon <- points$oldLon[pts]
- regLon <- lm(lon ~ oldLon, data = coords)
- points$lon <- predict(regLon, newdata = points)
-
- coords$oldLat <- points$oldLat[pts]
- regLat <- lm(lat ~ oldLat, data = coords)
- points$lat <- predict(regLat, newdata = points)
-
- points$oldLon <- points$oldLat <- NULL
-
- points
-}
-
-#' Plot method for map layout
-#'
-#' 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}}.
-#'
-#' @param x
-#' Object created with function \code{\link{mapLayout}}
-#' @param colAreas
-#' Vector of colors for areas. By default, the colors used in the Antares
-#' software are used.
-#' @param 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}
-#' @param opacityArea Opacity of areas. It has to be a numeric vector with values
-#' between 0 and 1.
-#' @param areaMaxSize Maximal width in pixels of the symbols that represent
-#' areas on the map.
-#' @param areaChartType Type of chart to use to represent areas.
-#' @param labelArea Character vector containing labels to display inside areas.
-#' @param colLinks
-#' Vector of colors for links.
-#' @param sizeLinks
-#' Line width of the links, in pixels.
-#' @param opacityLinks Opacity of the links. It has to be a numeric vector with values
-#' between 0 and 1.
-#' @param 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.
-#' @param areas
-#' Should areas be drawn on the map ?
-#' @param links
-#' Should links be drawn on the map ?
-#' @param ...
-#' Currently unused.
-#' @inheritParams prodStack
-#' @inheritParams plotMapOptions
-#'
-#' @return
-#' 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}}
-#'
-#' @method plot 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 !")
-#' }
-#'
-#' @export
-plot.mapLayout <- function(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, ...) {
-
- areaChartType <- match.arg(areaChartType)
-
- map <- leaflet(width = width, height = height, padding = 10) %>% addTiles(tilesURL)
-
- # Add Polygons
- if (areas & !is.null(x$map)) {
- map <- addPolygons(map, data = x$map, layerId = x$coords$area, fillColor = colAreas, weight = 1,
- fillOpacity = 1, color = "#333")
- }
-
- # Add custom elements
- if (is.function(preprocess)){
- map <- preprocess(map)
- }
-
- # Add links
- if (links) {
- map <- addFlows(map, x$links$x0, x$links$y0, x$links$x1, x$links$y1, dir = dirLinks,
- flow = abs(sizeLinks), opacity = opacityLinks, maxFlow = 1, maxThickness = 1,
- color = colLinks, layerId = x$links$link)
- }
-
- # Add areas
- 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)
-
- }
-
- # Add shadows to elements
- map %>% addShadows()
-}
+# Copyright © 2016 RTE Réseau de transport d’électricité
+
+#' Place areas of a study on a map
+#'
+#' 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.
+#'
+#' @param layout
+#' object returned by function \code{\link[antaresRead]{readLayout}}
+#' @param what
+#' Either "areas" or "districts". Indicates what type of object to place
+#' on the map.
+#' @param map
+#' An optional \code{\link[sp]{SpatialPolygons}} or
+#' \code{\link[sp:SpatialPolygons]{SpatialPolygonsDataFrame}} object. See \code{\link[spMaps:spMaps]{getSpMaps}}
+#'
+#' @param map_builder \code{logical} Add inputs for build custom map ? Defaut to TRUE.
+#'
+#' @details
+#' With \code{map_builder} option, you can build a quiet custom map using \code{spMaps} package.
+#' This package help you to build \code{\link[sp:SpatialPolygons]{SpatialPolygonsDataFrame}} on Europe.
+#' Moreover, you can use two options in the module :
+#'
+#' \itemize{
+#' \item {"Merge countries" : Some countries like UK or Belgium are firstly rendered in multiple and diffrent area.
+#' You can so choose to finally use this countries as one single area on the map}
+#' \item {"Merge states" : If you need states details but not having one area per state, the map will be incomplete
+#' for some countries, plotting only states with area. So you can choose to aggregate the states of the countries.
+#' This is done using a nearest states algorithm. The result is available only after layout validation.}
+#' }
+#' @return
+#' An object of class \code{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)
+#'
+#' # 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) {
+
+ 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)
+ }
+
+ mapCoords <- shiny::runApp(shiny::shinyApp(ui = ui, server = server))
+
+ 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){
+
+ 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
+ } else {
+ stop("No coordinates found in layout")
+ }
+
+ leafletDragPoints(coords, map = mapLayout$map, init = TRUE, draggable = FALSE)
+}
+
+# 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(3,
+ if (map_builder){
+ selectInput(ns("ml_countries"), "Countries : ", width = "100%",
+ choices = choices_map, selected = "all", multiple = TRUE)
+ }
+ ),
+ column(3,
+ if (map_builder){
+ selectInput(ns("ml_states"), "States : ", width = "100%",
+ choices = choices_map, selected = NULL, multiple = TRUE)
+ }
+ ),
+ column(2,
+ if (map_builder){
+ div(br(), checkboxInput(ns("merge_cty"), "Merge countries ?", TRUE), align = "center")
+ }
+ ),
+ column(2,
+ if (map_builder){
+ div(br(), checkboxInput(ns("merge_ste"), "Merge states ?", TRUE), align = "center")
+ }
+ ),
+ 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(textOutput(ns("title_layout"))), align = "center")),
+ column(2,
+ conditionalPanel(
+ condition = paste0("output['", ns("control_state"), "'] >= 2"),
+ div(br(), actionButton(ns("done"), "Done"), align = "center")
+ )
+ )
+ ),
+
+ 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
+#' @import sp
+#' @import sf
+changeCoordsServer <- function(input, output, session,
+ layout, what = reactive("areas"),
+ map = reactive(NULL), map_builder = TRUE,
+ language = reactive("en"), stopApp = FALSE){
+
+ ns <- session$ns
+
+ lfDragPoints <- reactiveValues(map = NULL, init = FALSE)
+
+ current_state <- reactiveValues(state = -1)
+ output$control_state <- reactive({
+ current_state$state
+ })
+
+ observe({
+ updateSelectInput(session, "ml_countries",
+ label = paste0(.getLabelLanguage("Countries", language()), " : "))
+ updateSelectInput(session, "ml_states",
+ label = paste0(.getLabelLanguage("States", language()), " : "))
+
+ updateCheckboxInput(session, "merge_cty", .getLabelLanguage("Merge countries ?", language()))
+ updateCheckboxInput(session, "merge_ste", .getLabelLanguage("Merge states ?", language()))
+
+ updateActionButton(session, "state", label = .getLabelLanguage("Next", language()))
+ updateActionButton(session, "done", label = .getLabelLanguage("Done", language()))
+ updateActionButton(session, "reset_ml", label = .getLabelLanguage("Re-Init layout", language()))
+ updateActionButton(session, "set_map_ml", label = .getLabelLanguage("Set map", language()))
+
+ })
+
+ output$title_layout <- renderText({
+ .getLabelLanguage("Map Layout", language())
+ })
+
+ outputOptions(output, "control_state", suspendWhenHidden = FALSE)
+
+ current_map <- reactive({
+ if (!map_builder){
+ checkSlotId(map())
+ } else {
+ if (!is.null(map()) & input$set_map_ml == 0){
+ checkSlotId(map())
+ } else {
+ checkSlotId(getSpMaps(countries = isolate(input$ml_countries), states = isolate(input$ml_states),
+ mergeCountry = isolate(input$merge_cty)))
+ }
+ }
+ })
+
+ data <- reactive({
+ input$reset_ml
+ if (!is.null(layout())){
+ if (what() == "areas") {
+ coords <- copy(layout()$areas)
+ info <- coords$area
+ links <- copy(layout()$links)
+ if(is.null(links)) links <- data.table()
+ } else {
+ coords <- copy(layout()$districts)
+ info <- coords$district
+ links <- copy(layout()$districtLinks)
+ if(is.null(links)) links <- data.table()
+ }
+
+ 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))
+ graphics::plot.default(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({
+ .getLabelLanguage("Please place the following point on the map", language())
+ })
+
+ 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({
+ .getLabelLanguage("Drag the markers on the map to adjust coordinates then click the 'Done' button", language())
+ })
+
+ output$info <- renderUI(HTML(
+ paste0("",
+ .getLabelLanguage("You can click on a marker to display information", language()),
+ "
"))
+ )
+
+ })
+ }
+ })
+
+ # 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"))
+
+ # special with only one area...
+ if(nrow(data()$coords) == 1){
+ coords <- coords[1, ]
+ }
+
+ 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
+ if(nrow(data()$coords) > 1){
+ ord <- order(c(data_points$pt1, data_points$pt2, (1:length(coords))[-c(data_points$pt1, data_points$pt2)]))
+ mapCoords <- coords[ord, ]
+ } else {
+ mapCoords <- coords
+ }
+
+ final_coords <- data()$coords
+ final_links <- data()$links
+
+ final_coords$x <- sp::coordinates(mapCoords)[, 1]
+ final_coords$y <- sp::coordinates(mapCoords)[, 2]
+
+ if (what() == "areas") {
+ if(!is.null(final_links) && nrow(final_links) > 0){
+ 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 {
+ if(!is.null(final_links) && nrow(final_links) > 0){
+ final_links[final_coords, `:=`(x0 = x, y0 = y), on = c(fromDistrict = "district")]
+ final_links[final_coords, `:=`(x1 = x, y1 = y), on = c(toDistrict = "district")]
+ }
+ }
+
+ if (!is.null(map)) {
+ final_coords$geoAreaId <- mapCoords$geoAreaId
+ final_coords_map <- final_coords[!is.na(final_coords$geoAreaId), ]
+ if (!isolate(input$merge_ste)){
+ map <- map[final_coords_map$geoAreaId, ]
+ } else {
+ if (all(c("name", "code") %in% names(map))){
+ keep_code <- unique(map$code[final_coords_map$geoAreaId])
+ # subset on countries
+ tmp_map <- map[map$code %in% keep_code, ]
+
+ if (nrow(tmp_map) > 0){
+ # set unlink states
+ tmp_map$geoAreaId[!tmp_map$geoAreaId %in% final_coords_map$geoAreaId] <- NA
+
+ ind_na <- which(is.na(tmp_map$geoAreaId))
+ if (length(ind_na) > 0){
+ # have to find nearestArea...
+ treat_cty <- unique(tmp_map$code[ind_na])
+
+ for (cty in treat_cty){
+ ind_cty <- which(tmp_map$code %in% cty)
+ ind_miss <- which(tmp_map$code %in% cty & is.na(tmp_map$geoAreaId))
+ areas <- coords[coords$geoAreaId %in% tmp_map$geoAreaId[ind_cty], ]
+ if (nrow(areas) > 0){
+ tmp_sf <- st_as_sf(tmp_map[ind_miss, ])
+ areas_sf <- st_as_sf(areas)
+ dist_matrix <- st_distance(tmp_sf, areas_sf)
+ areas_min <- suppressWarnings(apply(dist_matrix, 1, which.min))
+ tmp_map$geoAreaId[ind_miss] <- areas$geoAreaId[areas_min]
+ }
+ }
+ tmp_sf <- st_cast(tmp_map, "MULTIPOLYGON") # Cast to multipolygon if needed
+ tmp_sf <- st_cast(tmp_sf, "GEOMETRY") # Remove unused geometry types
+ tmp_sf <- st_combine(tmp_sf) # Combine features with the same geoAreaId
+ map <- tmp_sf[match(final_coords_map$geoAreaId, tmp_map$geoAreaId), ]
+ } else {
+ map <- map[match(final_coords_map$geoAreaId, map$geoAreaId), ]
+ }
+ }else {
+ map <- map[match(final_coords_map$geoAreaId, map$geoAreaId), ]
+ }
+ } else {
+ map <- map[match(final_coords_map$geoAreaId, map$geoAreaId), ]
+ }
+ # remove if multiple same polygon. Needed other change...
+ # map <- map[!duplicated(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)
+ }
+ })
+
+ return(reactive(cur_coords$data))
+}
+
+.changeCoordinates <- function(points, coords, pts = 1:nrow(points)) {
+ coords$oldLon <- points$oldLon[pts]
+ regLon <- lm(lon ~ oldLon, data = coords)
+ points$lon <- predict(regLon, newdata = points)
+
+ coords$oldLat <- points$oldLat[pts]
+ regLat <- lm(lat ~ oldLat, data = coords)
+ points$lat <- predict(regLat, newdata = points)
+
+ points$oldLon <- points$oldLat <- NULL
+
+ points
+}
+
+#' Plot method for map layout
+#'
+#' 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}}.
+#'
+#' @param x
+#' Object created with function \code{\link{mapLayout}}
+#' @param colAreas
+#' Vector of colors for areas. By default, the colors used in the Antares
+#' software are used.
+#' @param 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}
+#' @param opacityArea Opacity of areas. It has to be a numeric vector with values
+#' between 0 and 1.
+#' @param areaMaxSize Maximal width in pixels of the symbols that represent
+#' areas on the map.
+#' @param areaChartType Type of chart to use to represent areas.
+#' @param labelArea Character vector containing labels to display inside areas.
+#' @param colLinks
+#' Vector of colors for links.
+#' @param sizeLinks
+#' Line width of the links, in pixels.
+#' @param opacityLinks Opacity of the links. It has to be a numeric vector with values
+#' between 0 and 1.
+#' @param 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.
+#' @param areas
+#' Should areas be drawn on the map ?
+#' @param links
+#' Should links be drawn on the map ?
+#' @param ...
+#' Currently unused.
+#' @inheritParams prodStack
+#' @inheritParams plotMapOptions
+#'
+#' @return
+#' 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}}
+#'
+#' @method plot 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 !")
+#' }
+#'
+#' @export
+plot.mapLayout <- function(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, ...) {
+
+ areaChartType <- match.arg(areaChartType)
+
+ map <- leaflet(width = width, height = height, padding = 10) %>% addTiles(tilesURL)
+
+ # Add Polygons
+ if (areas & !is.null(x$map)) {
+ map <- addPolygons(map, data = x$map, layerId = x$coords$area, fillColor = colAreas, weight = 1,
+ fillOpacity = 1, color = "#333")
+ }
+
+ # Add custom elements
+ if (is.function(preprocess)){
+ map <- preprocess(map)
+ }
+
+ # Add links
+ if (links) {
+ map <- addFlows(map, x$links$x0, x$links$y0, x$links$x1, x$links$y1, dir = dirLinks,
+ flow = abs(sizeLinks), opacity = opacityLinks, maxFlow = 1, maxThickness = 1,
+ color = colLinks, layerId = x$links$link)
+ }
+
+ # Add areas
+ 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)
+
+ }
+
+ # Add shadows to elements
+ map %>% addShadows()
+}
diff --git a/README.md b/README.md
index 56c4604..35b327d 100644
--- a/README.md
+++ b/README.md
@@ -6,9 +6,9 @@
> `antaresViz` is the package to visualize the results of your Antares simulations that you have imported in the R session with package `antaresRead`. It provides some functions that generate interactive visualisations. Moreover, by default, these functions launch a shiny widget that provides some controls to dynamically choose what data is displayed in the graphics.
-[](https://cran.r-project.org/package=antaresViz)
-[](https://app.codecov.io/gh/rte-antares-rpackage/antaresViz)
[](https://github.com/rte-antares-rpackage/antaresViz/actions)
+[](https://app.codecov.io/gh/rte-antares-rpackage/antaresViz?branch=master)
+[](https://CRAN.R-project.org/package=antaresViz)
diff --git a/antaresViz.Rproj b/antaresViz.Rproj
new file mode 100644
index 0000000..e4cfd18
--- /dev/null
+++ b/antaresViz.Rproj
@@ -0,0 +1,18 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: No
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace
diff --git a/codecov.yml b/codecov.yml
index d6c6c1a..04c5585 100644
--- a/codecov.yml
+++ b/codecov.yml
@@ -1 +1,14 @@
-comment: false
+comment: false
+
+coverage:
+ status:
+ project:
+ default:
+ target: auto
+ threshold: 1%
+ informational: true
+ patch:
+ default:
+ target: auto
+ threshold: 1%
+ informational: true
diff --git a/cran-comments.md b/cran-comments.md
new file mode 100644
index 0000000..881707d
--- /dev/null
+++ b/cran-comments.md
@@ -0,0 +1,17 @@
+## Test environments
+* local OS X, install, 4.1.0 (2021-05-18)
+* github actions :
+* windows-latest, r: 'release'
+* macOS-latest, r: 'release'
+* ubuntu-latest, r: 'release'
+
+## R CMD check results
+
+0 errors | 0 warnings | 0 note
+
+
+We don't expect any reverse dependency failures.
+
+This patch release contains only fix deprecated dependencies (issue #200).
+
+
diff --git a/man/plot.mapLayout.Rd b/man/plot.mapLayout.Rd
index 8788d8f..b1584d0 100644
--- a/man/plot.mapLayout.Rd
+++ b/man/plot.mapLayout.Rd
@@ -22,7 +22,9 @@
links = TRUE,
areas = TRUE,
tilesURL = defaultTilesURL(),
- preprocess = function(map) { map },
+ preprocess = function(map) {
+ map
+ },
width = NULL,
height = NULL,
...
diff --git a/man/plotMapOptions.Rd b/man/plotMapOptions.Rd
index 0ac234d..e02d1c9 100644
--- a/man/plotMapOptions.Rd
+++ b/man/plotMapOptions.Rd
@@ -21,7 +21,9 @@ plotMapOptions(
linkColorScaleOpts = colorScaleOptions(),
legend = c("choose", "visible", "hidden"),
tilesURL = defaultTilesURL(),
- preprocess = function(map) { map }
+ preprocess = function(map) {
+ map
+ }
)
defaultTilesURL()
diff --git a/revdep/.gitignore b/revdep/.gitignore
new file mode 100644
index 0000000..111ab32
--- /dev/null
+++ b/revdep/.gitignore
@@ -0,0 +1,7 @@
+checks
+library
+checks.noindex
+library.noindex
+cloud.noindex
+data.sqlite
+*.html
diff --git a/revdep/README.md b/revdep/README.md
new file mode 100644
index 0000000..e376c91
--- /dev/null
+++ b/revdep/README.md
@@ -0,0 +1,105 @@
+# Platform
+
+|field |value |
+|:--------|:------------------------------|
+|version |R version 4.1.0 (2021-05-18) |
+|os |Windows 10 x64 (build 19044) |
+|system |x86_64, mingw32 |
+|ui |RStudio |
+|language |(EN) |
+|collate |French_France.1252 |
+|ctype |French_France.1252 |
+|tz |Europe/Paris |
+|date |2023-08-31 |
+|rstudio |1.4.1103 Wax Begonia (desktop) |
+|pandoc |NA |
+
+# Dependencies
+
+|package |old |new | |
+|:-----------------|:------|:-------|:--|
+|antaresViz |0.17.1 |0.17.1 | |
+|bit |NA |4.0.5 |* |
+|bslib |NA |0.5.1 |* |
+|cachem |NA |1.0.7 |* |
+|classInt |NA |0.4-9 |* |
+|cli |NA |3.6.1 |* |
+|colorspace |NA |2.1-0 |* |
+|commonmark |NA |1.9.0 |* |
+|cpp11 |NA |0.4.6 |* |
+|crul |NA |1.4.0 |* |
+|curl |NA |5.0.0 |* |
+|data.table |NA |1.14.8 |* |
+|digest |NA |0.6.31 |* |
+|dplyr |NA |1.1.2 |* |
+|e1071 |NA |1.7-13 |* |
+|evaluate |NA |0.21 |* |
+|fansi |NA |1.0.4 |* |
+|fastmap |NA |1.1.1 |* |
+|fontawesome |NA |0.5.2 |* |
+|fs |NA |1.5.2 |* |
+|geojson |NA |0.3.5 |* |
+|geojsonio |NA |0.11.2 |* |
+|geometries |NA |0.2.2 |* |
+|ggplot2 |NA |3.4.3 |* |
+|gtable |NA |0.3.4 |* |
+|highr |NA |0.10 |* |
+|hms |NA |1.1.3 |* |
+|htmltools |NA |0.5.5 |* |
+|htmlwidgets |NA |1.6.2 |* |
+|httpuv |NA |1.6.9 |* |
+|isoband |NA |0.2.7 |* |
+|jsonlite |NA |1.8.4 |* |
+|knitr |NA |1.43 |* |
+|labeling |NA |0.4.3 |* |
+|later |NA |1.3.0 |* |
+|leaflet |NA |2.2.0 |* |
+|leaflet.providers |NA |1.13.0 |* |
+|lubridate |NA |1.9.2 |* |
+|openssl |NA |2.0.6 |* |
+|pbapply |NA |1.7-2 |* |
+|pillar |NA |1.9.0 |* |
+|plotly |NA |4.10.2 |* |
+|plyr |NA |1.8.8 |* |
+|png |NA |0.1-8 |* |
+|processx |NA |3.8.1 |* |
+|promises |NA |1.2.0.1 |* |
+|protolite |NA |2.2.0 |* |
+|ps |NA |1.7.5 |* |
+|purrr |NA |1.0.1 |* |
+|raster |NA |3.6-20 |* |
+|Rcpp |NA |1.0.10 |* |
+|readr |NA |2.1.4 |* |
+|rmarkdown |NA |2.24 |* |
+|s2 |NA |1.1.2 |* |
+|sass |NA |0.4.5 |* |
+|sf |NA |1.0-12 |* |
+|sfheaders |NA |0.4.2 |* |
+|shiny |NA |1.7.5 |* |
+|sourcetools |NA |0.1.7-1 |* |
+|stringi |NA |1.7.12 |* |
+|stringr |NA |1.5.0 |* |
+|sys |NA |3.4.1 |* |
+|terra |NA |1.7-23 |* |
+|tibble |NA |3.2.1 |* |
+|tidyr |NA |1.3.0 |* |
+|timechange |NA |0.2.0 |* |
+|tinytex |NA |0.46 |* |
+|triebeard |NA |0.4.1 |* |
+|tzdb |NA |0.3.0 |* |
+|units |NA |0.8-1 |* |
+|utf8 |NA |1.2.3 |* |
+|V8 |NA |4.3.0 |* |
+|vctrs |NA |0.6.1 |* |
+|viridis |NA |0.6.4 |* |
+|viridisLite |NA |0.4.2 |* |
+|vroom |NA |1.6.1 |* |
+|webshot |NA |0.5.5 |* |
+|wk |NA |0.7.2 |* |
+|xfun |NA |0.39 |* |
+|xts |NA |0.13.1 |* |
+|yaml |NA |2.3.7 |* |
+|zoo |NA |1.8-12 |* |
+
+# Revdeps
+
diff --git a/revdep/cran.md b/revdep/cran.md
new file mode 100644
index 0000000..782ef68
--- /dev/null
+++ b/revdep/cran.md
@@ -0,0 +1,7 @@
+## revdepcheck results
+
+We checked 1 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package.
+
+ * We saw 0 new problems
+ * We failed to check 0 packages
+
diff --git a/revdep/email.yml b/revdep/email.yml
new file mode 100644
index 0000000..0c5cef8
--- /dev/null
+++ b/revdep/email.yml
@@ -0,0 +1,5 @@
+release_date: ???
+rel_release_date: ???
+my_news_url: ???
+release_version: ???
+release_details: ???
diff --git a/revdep/failures.md b/revdep/failures.md
new file mode 100644
index 0000000..9a20736
--- /dev/null
+++ b/revdep/failures.md
@@ -0,0 +1 @@
+*Wow, no problems at all. :)*
\ No newline at end of file
diff --git a/revdep/problems.md b/revdep/problems.md
new file mode 100644
index 0000000..9a20736
--- /dev/null
+++ b/revdep/problems.md
@@ -0,0 +1 @@
+*Wow, no problems at all. :)*
\ No newline at end of file
diff --git a/tests/testthat/helper-init.R b/tests/testthat/helper-init.R
index 9988141..e82f92b 100644
--- a/tests/testthat/helper-init.R
+++ b/tests/testthat/helper-init.R
@@ -1,62 +1,62 @@
-#Copyright © 2016 RTE Réseau de transport d’électricité
-
-# Copy the test study in a temporary folder
-
-## force tests to be executed if in dev release which we define as
-## having a sub-release, eg 0.9.15.5 is one whereas 0.9.16 is not
-if (length(strsplit(packageDescription("antaresViz")$Version, "\\.")[[1]]) > 3) {
- Sys.setenv("RunAllAntaresVizTests"="yes")
-}
-.runThisTest <- FALSE
-.runThisTest <- Sys.getenv("RunAllAntaresVizTests") == "yes"
-
-if(.runThisTest){
- .runProdStackTest <- TRUE
- .runExchangesStackTest <- TRUE
- .runTsPlotTest <- TRUE
- #bug when executing in the Test environment, so keep
- # .runPlotMapTest to FALSE
- .runPlotMapTest <- FALSE
-}else{
- .runProdStackTest <- FALSE
- .runExchangesStackTest <- FALSE
- .runTsPlotTest <- FALSE
- .runPlotMapTest <- FALSE
-}
-
-path <- tempdir()
-
-sourcedir <- system.file("inst/testdata", package = "antaresRead")
-if (sourcedir == ""){
- 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.
-# The following "if" prevents errors at this step
-if (sourcedir != "") {
-
- ar_path_study <- file.path(sourcedir, "antares-test-study.tar.gz")
- if (!file.exists(ar_path_study)) {
- ar_path_study <- file.path(sourcedir, "antares-test-study-latest.tar.gz")
- }
-
- # if (Sys.info()["sysname"] == "Windows") {
- # untar(
- # tarfile = ar_path_study,
- # exdir = path,
- # extras = "--force-local"
- # )
- # } else {
- untar(
- tarfile = ar_path_study,
- exdir = path
- )
- # }
- assign("studyPath", file.path(path, "test_case"), envir = globalenv())
- assign("nweeks", 2, envir = globalenv())
- assign("pathtemp", path, envir = globalenv())
-}
-
-opts <- setSimulationPath(get("studyPath", envir = globalenv()))
+#Copyright © 2016 RTE Réseau de transport d’électricité
+
+# Copy the test study in a temporary folder
+
+## force tests to be executed if in dev release which we define as
+## having a sub-release, eg 0.9.15.5 is one whereas 0.9.16 is not
+if (length(strsplit(packageDescription("antaresViz")$Version, "\\.")[[1]]) > 3) {
+ Sys.setenv("RunAllAntaresVizTests"="yes")
+}
+.runThisTest <- FALSE
+.runThisTest <- Sys.getenv("RunAllAntaresVizTests") == "yes"
+
+if(.runThisTest){
+ .runProdStackTest <- TRUE
+ .runExchangesStackTest <- TRUE
+ .runTsPlotTest <- TRUE
+ #bug when executing in the Test environment, so keep
+ # .runPlotMapTest to FALSE
+ .runPlotMapTest <- FALSE
+}else{
+ .runProdStackTest <- FALSE
+ .runExchangesStackTest <- FALSE
+ .runTsPlotTest <- FALSE
+ .runPlotMapTest <- FALSE
+}
+
+path <- tempdir()
+
+sourcedir <- system.file("inst/testdata", package = "antaresRead")
+if (sourcedir == ""){
+ 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.
+# The following "if" prevents errors at this step
+if (sourcedir != "") {
+
+ ar_path_study <- file.path(sourcedir, "antares-test-study.tar.gz")
+ if (!file.exists(ar_path_study)) {
+ ar_path_study <- file.path(sourcedir, "antares-test-study-latest.tar.gz")
+ }
+
+ # if (Sys.info()["sysname"] == "Windows") {
+ # untar(
+ # tarfile = ar_path_study,
+ # exdir = path,
+ # extras = "--force-local"
+ # )
+ # } else {
+ untar(
+ tarfile = ar_path_study,
+ exdir = path
+ )
+ # }
+ assign("studyPath", file.path(path, "test_case"), envir = globalenv())
+ assign("nweeks", 2, envir = globalenv())
+ assign("pathtemp", path, envir = globalenv())
+}
+
+opts <- setSimulationPath(get("studyPath", envir = globalenv()))
diff --git a/tests/testthat/test-ts_plot.R b/tests/testthat/test-ts_plot.R
index 471532a..656b76c 100644
--- a/tests/testthat/test-ts_plot.R
+++ b/tests/testthat/test-ts_plot.R
@@ -35,32 +35,32 @@ test_that("tsPlot, no interactive return error", {
})
-test_that("tsPlot, work with compare", {
-
- dta <- readAntares(areas = "all", links = "all", showProgress = FALSE, mcYears = "all")
- exList <- tsPlot(x = dta, .runApp = FALSE, interactive = TRUE, compare = "mcYear")
- exList <- exList$init()
- #to get a param exList$getParams("tables")
- # exList$getValue("mcYear")
- exList$setValue("mcYear", 1, chartId = 1, reactive = FALSE)
- exList$setValue("mcYear", 2, chartId = 2, reactive = FALSE)
- exList$updateCharts()
- expect_equal(exList$getValue("tables"), "areas")
- expect_equal(exList$getValue("main"), "")
- expect_true(is(exList, "MWController"))
- expect_equal(exList$ncharts, 2)
- expect_equal(exList$ncol, 1)
- expect_equal(exList$nrow, 2)
- dataTsCompare <- .get_data_from_htmlwidget(exList, widgetsNumber = 1)
- timeEditValue <- "2018-05-06T18:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsCompare$hour)
- expect_gt(indexHour, 180)
- expect_equal(dataTsCompare$a[indexHour], 1627275)
-
- dataTsCompareMcYear2 <- .get_data_from_htmlwidget(exList, widgetsNumber = 2)
- expect_equal(dataTsCompareMcYear2$a[indexHour], 1432100)
-
-})
+# test_that("tsPlot, work with compare", {
+#
+# dta <- readAntares(areas = "all", links = "all", showProgress = FALSE, mcYears = "all")
+# exList <- tsPlot(x = dta, .runApp = FALSE, interactive = TRUE, compare = "mcYear")
+# exList <- exList$init()
+# #to get a param exList$getParams("tables")
+# # exList$getValue("mcYear")
+# exList$setValue("mcYear", 1, chartId = 1, reactive = FALSE)
+# exList$setValue("mcYear", 2, chartId = 2, reactive = FALSE)
+# exList$updateCharts()
+# expect_equal(exList$getValue("tables"), "areas")
+# expect_equal(exList$getValue("main"), "")
+# expect_true(is(exList, "MWController"))
+# expect_equal(exList$ncharts, 2)
+# expect_equal(exList$ncol, 1)
+# expect_equal(exList$nrow, 2)
+# dataTsCompare <- .get_data_from_htmlwidget(exList, widgetsNumber = 1)
+# timeEditValue <- "2018-05-06T18:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsCompare$hour)
+# expect_gt(indexHour, 180)
+# expect_equal(dataTsCompare$a[indexHour], 1627275)
+#
+# dataTsCompareMcYear2 <- .get_data_from_htmlwidget(exList, widgetsNumber = 2)
+# expect_equal(dataTsCompareMcYear2$a[indexHour], 1432100)
+#
+# })
test_that("tsPlot, no interactive, x and refStudy are antaresDataTable", {
myData1 <- readAntares(links = "all", showProgress = FALSE)
@@ -150,709 +150,710 @@ test_that("tsPlot, no interactive, x and refStudy are antaresDataList", {
})
-describe("tsPlot, no interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
- myData1 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
- myData2 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
- myData3 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
- myData4 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
-
- myDataList <- list(myData2, myData3, myData4)
- myLink <- "a - a_offshore"
- mytables <- "links"
- myVariable <- "FLOW LIN."
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- TsDaList <- tsPlot(x = myDataList,
- table = mytables,
- elements = myLink,
- type = "ts",
- interactive = FALSE,
- variable = myVariable)
- # compare with myData3
- idWidget <- 2
- dataTsDaList <- .get_data_from_htmlwidget(TsDaList, widgetsNumber = idWidget)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsDaList$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDaList$`a - a_offshore`[indexHour], -9)
- #with a refStudy
- TsDaList <- tsPlot(x = myDataList,
- refStudy = myData1,
- table = mytables,
- elements = myLink,
- type = "ts",
- interactive = FALSE,
- variable = myVariable)
- dataTsDaList <- .get_data_from_htmlwidget(TsDaList, widgetsNumber = idWidget)
- expect_equal(dataTsDaList$`a - a_offshore`[indexHour], 0)
- # edit myData3 to have a diff != 0
- #pb timeZone local (PC, Travis, etc)
- for (i in 0:5){
- timeEditShift <- lubridate::hours(i)
- timeEditMinus <- as.Date(timeEditValue) - timeEditShift
- timeEditPlus <- as.Date(timeEditValue) + timeEditShift
- myData3$links[ (time == timeEditMinus | time == timeEditPlus) & link == "a - a_offshore", `FLOW LIN.` := as.integer(`FLOW LIN.` + 2500)]
- }
- TsDaList <- tsPlot(x = myDataList,
- refStudy = myData1,
- table = mytables,
- elements = myLink,
- type = "ts",
- interactive = FALSE,
- variable = myVariable)
- dataTsDaList <- .get_data_from_htmlwidget(TsDaList, widgetsNumber = idWidget)
- expect_equal(dataTsDaList$`a - a_offshore`[indexHour], 2500)
-})
-
-describe("tsPlot, interactive, x and refStudy are antaresDataTable", {
- myData1 <- readAntares(links = "all", showProgress = FALSE)
- myData2 <- readAntares(links = "all", showProgress = FALSE)
- myLink <- "a - a_offshore"
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- # no interactive
- tsDa1 <- tsPlot(x = myData1,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE)
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -9)
- # interactive
- tsDa1Int <- tsPlot(x = myData1,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- dateRange = DR)
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- expect_equal(tsDa1Int$ncharts, 1)
- expect_equal(tsDa1Int$ncol, 1)
- expect_equal(tsDa1Int$nrow, 1)
- tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
- tsDa1Int$updateCharts()
- expect_equal(tsDa1Int$getValue("tables"), "links")
- expect_equal(tsDa1Int$getValue("mcYear"), "average")
- dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_lt(indexHour, 50)
- # BUG with interactive
- ## we must remove 24 hours ?
- expect_equal(dataTsDAInt$`a - a_offshore`[indexHour - 24], -9)
- # interactive with refStudy
- tsDa1Int <- tsPlot(x = myData1,
- refStudy = myData2,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- dateRange = DR)
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
- dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
- expect_equal(dataTsDAInt$`a - a_offshore`[indexHour - 24], 0)
-
- # edit myData2 to have a diff != 0
- ## pb timeZone local (PC, Travis, etc)
- for (i in 0:5){
- timeEditShift <- lubridate::hours(i)
- timeEditMinus <- as.Date(timeEditValue) - timeEditShift
- timeEditPlus <- as.Date(timeEditValue) + timeEditShift
- myData2[ (time == timeEditMinus | time == timeEditPlus) & link == myLink, `FLOW LIN.` := as.integer(`FLOW LIN.` + 2500)]
- }
- tsDa1Int <- tsPlot(x = myData2,
- refStudy = myData1,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- dateRange = DR)
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
- dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
- expect_equal(dataTsDAInt$`a - a_offshore`[indexHour - 24], 2500)
-})
-
-describe("tsPlot, interactive, x and refStudy are antaresDataList", {
- myData1 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
- myData2 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
- myArea <- "b"
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- # no interactive
- tsDa1 <- tsPlot(x = myData1,
- table = "areas",
- elements = myArea,
- type = "ts",
- interactive = FALSE)
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDa1$b[indexHour], 2427150)
- # interactive
- tsDa1Int <- tsPlot(x = myData1,
- table = "areas",
- elements = myArea,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- dateRange = DR)
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- expect_equal(tsDa1Int$ncharts, 1)
- expect_equal(tsDa1Int$ncol, 1)
- expect_equal(tsDa1Int$nrow, 1)
- tsDa1Int$setValue("mcYear", "average", reactive = TRUE)
- tsDa1Int$setValue("tables", "areas", reactive = TRUE)
- tsDa1Int$setValue("elements", "b", reactive = TRUE)
- tsDa1Int$updateCharts()
- expect_equal(tsDa1Int$getValue("tables"), "areas")
- expect_equal(tsDa1Int$getValue("mcYear"), "average")
- expect_equal(tsDa1Int$getValue("elements"), "b")
- dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_lt(indexHour, 50)
- # BUG with interactive
- ## we must remove 24 hours ?
- expect_equal(dataTsDAInt$b[indexHour - 24], 2427150)
- # interactive with refStudy
- tsDa1Int <- tsPlot(x = myData1,
- refStudy = myData2,
- table = "areas",
- elements = myArea,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- dateRange = DR)
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
- dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
- expect_equal(dataTsDAInt$b[indexHour - 24], 0)
-
- # edit myData2 to have a diff != 0
- ## pb timeZone local (PC, Travis, etc)
- for (i in 0:5){
- timeEditShift <- lubridate::hours(i)
- timeEditMinus <- as.Date(timeEditValue) - timeEditShift
- timeEditPlus <- as.Date(timeEditValue) + timeEditShift
- myData2$areas[ (time == timeEditMinus | time == timeEditPlus) & area == myArea, `OV. COST` := as.integer(`OV. COST` + 2500)]
- }
- tsDa1Int <- tsPlot(x = myData2,
- refStudy = myData1,
- table = "areas",
- elements = myArea,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- dateRange = DR)
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- tsDa1Int$setValue("mcYear", "average", reactive = TRUE)
- tsDa1Int$setValue("tables", "areas", reactive = TRUE)
- tsDa1Int$setValue("elements", "b", reactive = TRUE)
- tsDa1Int$updateCharts()
- dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
- expect_equal(dataTsDAInt$b[indexHour - 24], 2500)
-})
-
-describe("tsPlot, no interactive, x and refStudy are optsH5 ", {
- if (.requireRhdf5_Antares(stopP = FALSE)){
- skip_if_not(.runTsPlotTest)
- suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
- optsH5 <- setSimulationPath(pathtemp)
- myLink <- "a - a_offshore"
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- # no interactive
- tsDa1 <- tsPlot(x = optsH5,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE)
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -9)
- #ref Study
- tsDa1 <- tsPlot(x = optsH5,
- refStudy = optsH5,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE)
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDa1$`a - a_offshore`[indexHour], 0)
- # Edit H5 file
- ## create a new folder h5
- pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
- pathNewH5 <- file.path(pathInitial, "testH5")
- if (!dir.exists(pathNewH5)){
- dir.create(pathNewH5)
- }
- #write the study
- #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
- optsData <- antaresRead::setSimulationPath(path = studyPath)
- suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData,
- overwrite = TRUE, supressMessages = TRUE))
-
- pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5))
- .h5Antares_edit_variable(
- pathH5 = pathNewH5File,
- link = myLink,
- timeId = 1:100,
- antVar = "FLOW LIN.",
- newValue = 15000
- )
-
- optsH5New <- setSimulationPath(path = pathNewH5File)
- tsDa1 <- tsPlot(x = optsH5New,
- refStudy = optsH5,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE)
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_equal(dataTsDa1$`a - a_offshore`[indexHour], 15009)
- }
-})
-
-describe("tsPlot, no interactive, x is a list of optH5 and refStudy are optsH5 ", {
- if (.requireRhdf5_Antares(stopP = FALSE)){
- skip_if_not(.runTsPlotTest)
- suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
- optsH5 <- setSimulationPath(pathtemp)
-
- # with new Studies H5 test if compare prodStack works
- ## create new folders h5
- pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
-
- listFolderToCreate <- c("testH5v2", "testH5v3", "testH5v4")
- for (folder in listFolderToCreate){
- pathNewH5 <- file.path(pathInitial, folder)
- if (!dir.exists(pathNewH5)){
- dir.create(pathNewH5)
- }
- #write the study
- #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
- optsData <- antaresRead::setSimulationPath(path = studyPath)
- suppressWarnings(
- writeAntaresH5(
- path = pathNewH5,
- opts = optsData,
- overwrite = TRUE,
- supressMessages = TRUE)
- )
- }
- idWidgetToEdit <- 2
- pathH5FolderToEdit <- file.path(pathInitial, listFolderToCreate[[idWidgetToEdit]])
- pathH5FileToEdit <- file.path(pathH5FolderToEdit, list.files(pathH5FolderToEdit))
- newValueFlow <- 15000
- myLink <- getLinks()[1]
- .h5Antares_edit_variable(
- pathH5 = pathH5FileToEdit,
- link = myLink,
- timeId = 1:100,
- antVar = "FLOW LIN.",
- newValue = newValueFlow
- )
- optsList <- list()
- antaresDataListH5 <- list()
- for (i in 1:length(listFolderToCreate)){
- pathOptsI <- file.path(pathInitial, listFolderToCreate[[i]])
- optsList[[i]] <- setSimulationPath(path = pathOptsI)
- antaresDataListH5[[i]] <- readAntares(links = myLink)
- }
- #test the data from h5
- #get the data from the h5 file
- antaresDataRef <- readAntares(opts = optsH5, links = myLink)
- expect_equal(max(antaresDataListH5[[idWidgetToEdit]]$`FLOW LIN.`), newValueFlow)
- expect_equal(max(antaresDataListH5[[1]]$`FLOW LIN.`), max(antaresDataRef$`FLOW LIN.`))
- expect_equal(max(antaresDataListH5[[3]]$`FLOW LIN.`), max(antaresDataRef$`FLOW LIN.`))
- # get the data from htmlwidget
- myArea <- "a"
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- tsDa1 <- tsPlot(x = optsList,
- refStudy = optsH5,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE)
- dataTsDa3 <- .get_data_from_htmlwidget(tsDa1, widgetsNumber = idWidgetToEdit)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsDa3$hour)
- expect_equal(dataTsDa3$`a - a_offshore`[indexHour], 15009)
- dataTsDa2 <- .get_data_from_htmlwidget(tsDa1, widgetsNumber = 1)
- expect_equal(dataTsDa2$`a - a_offshore`[indexHour], 0)
- }
-})
-
-describe("tsPlot, interactive, x and refStudy are optsH5 ", {
- if (.requireRhdf5_Antares(stopP = FALSE)){
- skip_if_not(.runTsPlotTest)
- suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
- optsH5 <- setSimulationPath(pathtemp)
- myLink <- "a - a_offshore"
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- # no interactive
- tsDa1 <- tsPlot(x = optsH5,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE)
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -9)
- #interactive
- tsDa1Int <- tsPlot(x = optsH5,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- h5requestFiltering = list(
- mcYears = 1
- ))
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- expect_equal(tsDa1Int$ncharts, 1)
- expect_equal(tsDa1Int$ncol, 1)
- expect_equal(tsDa1Int$nrow, 1)
- expect_true(is((tsDa1Int$getValue("x_tranform")[[1]]), "antaresData"))
- tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
- tsDa1Int$setValue("tables", "areas", reactive = TRUE)
- tsDa1Int$setValue("elements", "b", reactive = TRUE)
- tsDa1Int$setValue("variable", "LOAD", reactive = TRUE)
- tsDa1Int$setValue("dateRange", DR, reactive = TRUE)
- tsDa1Int$updateCharts()
- tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
- tsDa1Int$setValue("meanYearH5", FALSE, reactive = TRUE)
- tsDa1Int$updateCharts()
- tsDa1Int$setValue("meanYearH5", FALSE, reactive = TRUE)
- tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
- expect_equal(tsDa1Int$getValue("tables"), "areas")
- expect_equal(tsDa1Int$getValue("mcYear"), 1)
- expect_equal(tsDa1Int$getValue("elements"), "b")
- expect_equal(tsDa1Int$getValue("variable"), "LOAD")
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1Int)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_gt(indexHour, 2)
- expect_equal(dataTsDa1$b[indexHour], 60262)
- # Edit H5 file
- ## create a new folder h5
- pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
- pathNewH5 <- file.path(pathInitial, "testH5")
- if (!dir.exists(pathNewH5)){
- dir.create(pathNewH5)
- }
- #write the study
- #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
- optsData <- antaresRead::setSimulationPath(path = studyPath)
- suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData,
- overwrite = TRUE, supressMessages = TRUE))
- pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5))
- .h5Antares_edit_variable(
- pathH5 = pathNewH5File,
- area = "b",
- timeId = 1:100,
- antVar = "LOAD",
- newValue = 15000,
- mcYear = 1
- )
- optsH5New <- setSimulationPath(path = pathNewH5File)
- myData <- readAntares(areas = "b",
- select = "LOAD",
- opts = optsH5New,
- mcYears = 1)
- myDataRef <- readAntares(areas = "b",
- select = "LOAD",
- opts = optsH5,
- mcYears = 1)
- expect_equal(myData[area == "b" & timeId == 2737, LOAD], 15000)
- expect_gt(myDataRef[area == "b" & timeId == 2737, LOAD], 16000)
-
- diffValue <- myData[area == "b" & timeId == 2737, LOAD] -
- myDataRef[area == "b" & timeId == 2737, LOAD]
- tsDa1Int <- tsPlot(x = optsH5New,
- refStudy = optsH5,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- h5requestFiltering = list(
- mcYears = 1
- ))
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- expect_equal(tsDa1Int$ncharts, 1)
- expect_equal(tsDa1Int$ncol, 1)
- expect_equal(tsDa1Int$nrow, 1)
- tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
- tsDa1Int$setValue("tables", "areas", reactive = TRUE)
- tsDa1Int$setValue("elements", "b", reactive = FALSE)
- tsDa1Int$setValue("variable", "LOAD", reactive = FALSE)
- tsDa1Int$setValue("dateRange", DR, reactive = FALSE)
- tsDa1Int$updateCharts()
- expect_equal(tsDa1Int$getValue("tables"), "areas")
- expect_equal(tsDa1Int$getValue("mcYear"), 1)
- expect_equal(tsDa1Int$getValue("elements"), "b")
- expect_equal(tsDa1Int$getValue("variable"), "LOAD")
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1Int)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_equal(dataTsDa1$b[indexHour], diffValue)
- # for links, no refStudy
- tsDa1Int <- tsPlot(x = optsH5New,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- h5requestFiltering = list(
- mcYears = 1
- ))
- tsDa1Int <- tsDa1Int$init()
- expect_true(is(tsDa1Int, "MWController"))
- expect_equal(tsDa1Int$ncharts, 1)
- expect_equal(tsDa1Int$ncol, 1)
- expect_equal(tsDa1Int$nrow, 1)
- tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
- tsDa1Int$setValue("tables", "links", reactive = TRUE)
- tsDa1Int$setValue("elements", myLink, reactive = FALSE)
- tsDa1Int$setValue("variable", "FLOW LIN.", reactive = FALSE)
- tsDa1Int$setValue("dateRange", DR, reactive = FALSE)
- tsDa1Int$updateCharts()
- tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
- expect_true(is((tsDa1Int$getValue("x_tranform")[[1]]), "antaresData"))
- expect_equal(tsDa1Int$getValue("tables"), "links")
- expect_equal(tsDa1Int$getValue("mcYear"), 1)
- expect_equal(tsDa1Int$getValue("elements"), myLink)
- expect_equal(tsDa1Int$getValue("variable"), "FLOW LIN.")
- dataTsDa1 <- .get_data_from_htmlwidget(tsDa1Int)
- indexHour <- grep(timeEditValue, dataTsDa1$hour)
- expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -10)
- # for links, with refStudy
- tsDa1IntRef <- tsPlot(x = optsH5New,
- refStudy = optsH5,
- type = "ts",
- interactive = TRUE,
- .runApp = FALSE,
- h5requestFiltering = list(
- mcYears = 1
- ))
- tsDa1IntRef <- tsDa1IntRef$init()
- expect_true(is(tsDa1IntRef, "MWController"))
- expect_equal(tsDa1IntRef$ncharts, 1)
- expect_equal(tsDa1IntRef$ncol, 1)
- expect_equal(tsDa1IntRef$nrow, 1)
- expect_true(is((tsDa1IntRef$getValue("x_tranform")[[1]]), "antaresData"))
- tsDa1IntRef$setValue("mcYear", 1, reactive = TRUE)
- expect_equal(tsDa1IntRef$getValue("mcYear"), 1)
- expect_equal(tsDa1IntRef$getValue("tables"), "areas")
- tsDa1IntRef$setValue("tables", "links", reactive = TRUE)
- tsDa1IntRef$setValue("elements", myLink, reactive = FALSE)
- tsDa1IntRef$setValue("variable", "FLOW LIN.", reactive = FALSE)
- tsDa1IntRef$setValue("dateRange", DR, reactive = FALSE)
- tsDa1IntRef$setValue("meanYearH5", FALSE, reactive = TRUE)
- tsDa1IntRef$updateCharts()
- tsDa1IntRef$setValue("meanYearH5", TRUE, reactive = TRUE)
- tsDa1IntRef$setValue("mcYear", 1, reactive = TRUE)
- expect_true(is((tsDa1IntRef$getValue("x_tranform")[[1]]), "antaresData"))
- expect_equal(tsDa1IntRef$getValue("tables"), "links")
- expect_true(is((tsDa1IntRef$getValue("x_tranform")[[1]]), "antaresData"))
- expect_equal(tsDa1IntRef$getValue("elements"), myLink)
- expect_equal(tsDa1IntRef$getValue("variable"), "FLOW LIN.")
- expect_equal(tsDa1IntRef$getValue("mcYear"), 1)
- dataTsDa1Ref <- .get_data_from_htmlwidget(tsDa1IntRef)
- indexHour <- grep(timeEditValue, dataTsDa1Ref$hour)
- expect_equal(dataTsDa1Ref$`a - a_offshore`[indexHour], 0)
- }
-})
-
-describe("tsPlot, interactive, x is a list of optsH5 and refStudy optsH5", {
- if (.requireRhdf5_Antares(stopP = FALSE)){
- skip_if_not(.runTsPlotTest)
- suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
- optsH5 <- setSimulationPath(pathtemp)
-
- # with new Studies H5 test if compare prodStack works
- ## create new folders h5
- pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
- listFolderToCreate <- c("testH5v2", "testH5v3", "testH5v4")
- for (folder in listFolderToCreate){
- pathNewH5 <- file.path(pathInitial, folder)
- if (!dir.exists(pathNewH5)){
- dir.create(pathNewH5)
- }
-
- #write the study
- #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
- optsData <- antaresRead::setSimulationPath(path = studyPath)
- suppressWarnings(
- writeAntaresH5(
- path = pathNewH5,
- opts = optsData,
- overwrite = TRUE,
- supressMessages = TRUE)
- )
- }
- pathH5FolderToEdit <- file.path(pathInitial, listFolderToCreate[[2]])
- pathH5FileToEdit <- file.path(pathH5FolderToEdit, list.files(pathH5FolderToEdit))
- myLink <- getLinks()[1]
- newValueFlow <- 50000
- mcYearToTestList <- c(2, NULL)
- myVar <- "FLOW LIN."
- for (mcYearToTest in mcYearToTestList){
- .h5Antares_edit_variable(
- pathH5 = pathH5FileToEdit,
- link = myLink,
- timeId = 1:100,
- antVar = myVar,
- newValue = newValueFlow,
- mcYear = mcYearToTest
- )
- #stock the data
- optsList <- list()
- antaresDataListH5 <- list()
- for (i in 1:length(listFolderToCreate)){
- pathOptsI <- file.path(pathInitial, listFolderToCreate[[i]])
- optsList[[i]] <- setSimulationPath(path = pathOptsI)
- antaresDataListH5[[i]] <- readAntares(links = myLink,
- mcYear = mcYearToTest,
- opts = optsList[[i]])
- }
- DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
- #try without refStudy and interactive == FALSE
- indexHour <- 49
- expect_equal(antaresDataListH5[[2]]$`FLOW LIN.`[[indexHour]], 50000)
- if(is.null(mcYearToTest)){
- valFlow <- (-9)
- }else{
- valFlow <- (-7)
- }
- expect_equal(antaresDataListH5[[1]]$`FLOW LIN.`[[indexHour]], valFlow)
- expect_equal(antaresDataListH5[[3]]$`FLOW LIN.`[[indexHour]], valFlow)
-
- if(!is.null(mcYearToTest)){
- expect_error(tsPlot(x = optsList,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE,
- mcYear = mcYearToTest),
- "You can't use mcYear for h5 file when interactive is set to FALSE. You can use mcYearh5.")
- }
- tsPlotNoInt <- tsPlot(x = optsList,
- table = "links",
- elements = myLink,
- type = "ts",
- interactive = FALSE,
- mcYearh5 = mcYearToTest)
- datatsPlotNoInt <- .get_data_from_htmlwidget(tsPlotNoInt, widgetsNumber = 2)
- timeEditValue <- "2018-04-25T00:00:00.000Z"
- indexHour <- grep(timeEditValue, datatsPlotNoInt$hour)
- expect_gt(indexHour, 2)
- expect_equal(datatsPlotNoInt$`a - a_offshore`[[indexHour]], 50000)
- #interactive
- tsPlotInt <- tsPlot(x = optsList,
- type = "ts",
- dateRange = DR,
- .runApp = FALSE,
- interactive = TRUE,
- h5requestFiltering = list(
- mcYears = mcYearToTest
- ))
- tsPlotInt <- tsPlotInt$init()
- expect_true(is(tsPlotInt, "MWController"))
- expect_equal(tsPlotInt$ncharts, 3)
- expect_equal(tsPlotInt$ncol, 2)
- expect_equal(tsPlotInt$nrow, 2)
- tsPlotInt$setValue("mcYear", mcYearToTest, reactive = TRUE)
- tsPlotInt$setValue("tables", "links", reactive = TRUE)
- tsPlotInt$setValue("elements", myLink, reactive = TRUE)
- tsPlotInt$setValue("variable", myVar, reactive = TRUE)
- tsPlotInt$setValue("dateRange", DR, reactive = TRUE)
- if(is.null(mcYearToTest)){
- tsPlotInt$setValue("meanYearH5", FALSE, reactive = TRUE)
- expect_equal(tsPlotInt$getValue("meanYearH5"), FALSE)
- tsPlotInt$setValue("mcYear", "average", reactive = TRUE)
- }else{
- tsPlotInt$setValue("meanYearH5", TRUE, reactive = TRUE)
- expect_equal(tsPlotInt$getValue("meanYearH5"), TRUE)
- }
- tsPlotInt$updateCharts()
- expect_equal(tsPlotInt$getValue("tables"), "links")
- tsPlotInt$setValue("mcYear", mcYearToTest, reactive = TRUE)
- if(!is.null(mcYearToTest)){
- expect_equal(tsPlotInt$getValue("mcYear"), mcYearToTest)
- }else{
- tsPlotInt$setValue("mcYear", "average", reactive = TRUE)
- expect_equal(tsPlotInt$getValue("mcYear"), "average")
- }
- expect_equal(tsPlotInt$getValue("mcYearH5"),"1")
- expect_equal(tsPlotInt$getValue("elements"), myLink)
- expect_equal(tsPlotInt$getValue("variable"), myVar)
- datatsPlotInt <- .get_data_from_htmlwidget(tsPlotInt, widgetsNumber = 2)
- indexHour <- grep(timeEditValue, datatsPlotInt$hour)
- expect_equal(datatsPlotInt$`a - a_offshore`[[indexHour]], 50000)
- datatsPlotInt2 <- .get_data_from_htmlwidget(tsPlotInt, widgetsNumber = 1)
- indexHour <- grep(timeEditValue, datatsPlotInt2$hour)
- expect_equal(datatsPlotInt2$`a - a_offshore`[[indexHour]], valFlow)
- #interactive with refStudy
- tsPlotIntRef <- tsPlot(x = optsList,
- refStudy = optsH5,
- type = "ts",
- dateRange = DR,
- .runApp = FALSE,
- interactive = TRUE,
- h5requestFiltering = list(
- mcYears = mcYearToTest
- ))
- tsPlotIntRef <- tsPlotIntRef$init()
- expect_true(is(tsPlotIntRef, "MWController"))
- expect_equal(tsPlotIntRef$ncharts, 3)
- expect_equal(tsPlotIntRef$ncol, 2)
- expect_equal(tsPlotIntRef$nrow, 2)
- tsPlotIntRef$setValue("mcYear", mcYearToTest, reactive = TRUE)
- tsPlotIntRef$setValue("tables", "links", reactive = TRUE)
- tsPlotIntRef$setValue("elements", myLink, reactive = TRUE)
- tsPlotIntRef$setValue("variable", myVar, reactive = TRUE)
- tsPlotIntRef$setValue("dateRange", DR, reactive = TRUE)
- if(is.null(mcYearToTest)){
- tsPlotIntRef$setValue("meanYearH5", FALSE, reactive = TRUE)
- expect_equal(tsPlotIntRef$getValue("meanYearH5"), FALSE)
- }else{
- tsPlotIntRef$setValue("meanYearH5", TRUE, reactive = TRUE)
- expect_equal(tsPlotIntRef$getValue("meanYearH5"), TRUE)
- }
- tsPlotIntRef$updateCharts()
- expect_equal(tsPlotIntRef$getValue("tables"), "links")
- tsPlotIntRef$setValue("mcYear", mcYearToTest, reactive = TRUE)
- if(!is.null(mcYearToTest)){
- expect_equal(tsPlotInt$getValue("mcYear"), mcYearToTest)
- expect_equal(tsPlotIntRef$getValue("mcYearH5"),"1")
- }else{
- tsPlotIntRef$setValue("mcYear", "average", reactive = TRUE)
- tsPlotIntRef$setValue("mcYearH5", "", reactive = TRUE)
- expect_equal(tsPlotIntRef$getValue("mcYearH5"),"")
- expect_equal(tsPlotIntRef$getValue("mcYear"), "average")
- }
- expect_equal(tsPlotIntRef$getValue("elements"), myLink)
- expect_equal(tsPlotIntRef$getValue("variable"), myVar)
- datatsPlotIntRef <- .get_data_from_htmlwidget(tsPlotIntRef, widgetsNumber = 2)
- indexHour <- grep(timeEditValue, datatsPlotIntRef$hour)
- expect_equal(datatsPlotIntRef$`a - a_offshore`[[indexHour]], 50000-(valFlow))
- datatsPlotIntRef2 <- .get_data_from_htmlwidget(tsPlotIntRef, widgetsNumber = 1)
- indexHour <- grep(timeEditValue, datatsPlotIntRef2$hour)
- expect_equal(datatsPlotIntRef2$`a - a_offshore`[[indexHour]], 0)
- }
- }
-})
+# describe("tsPlot, no interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
+# myData1 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
+# myData2 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
+# myData3 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
+# myData4 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
+#
+# myDataList <- list(myData2, myData3, myData4)
+# myLink <- "a - a_offshore"
+# mytables <- "links"
+# myVariable <- "FLOW LIN."
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# TsDaList <- tsPlot(x = myDataList,
+# table = mytables,
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE,
+# variable = myVariable)
+# # compare with myData3
+# idWidget <- 2
+# dataTsDaList <- .get_data_from_htmlwidget(TsDaList, widgetsNumber = idWidget)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsDaList$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDaList$`a - a_offshore`[indexHour], -9)
+# #with a refStudy
+# TsDaList <- tsPlot(x = myDataList,
+# refStudy = myData1,
+# table = mytables,
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE,
+# variable = myVariable)
+# dataTsDaList <- .get_data_from_htmlwidget(TsDaList, widgetsNumber = idWidget)
+# expect_equal(dataTsDaList$`a - a_offshore`[indexHour], 0)
+# # edit myData3 to have a diff != 0
+# #pb timeZone local (PC, Travis, etc)
+# for (i in 0:5){
+# timeEditShift <- lubridate::hours(i)
+# timeEditMinus <- as.Date(timeEditValue) - timeEditShift
+# timeEditPlus <- as.Date(timeEditValue) + timeEditShift
+# myData3$links[ (time == timeEditMinus | time == timeEditPlus) & link == "a - a_offshore", `FLOW LIN.` := as.integer(`FLOW LIN.` + 2500)]
+# }
+# TsDaList <- tsPlot(x = myDataList,
+# refStudy = myData1,
+# table = mytables,
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE,
+# variable = myVariable)
+# dataTsDaList <- .get_data_from_htmlwidget(TsDaList, widgetsNumber = idWidget)
+# expect_equal(dataTsDaList$`a - a_offshore`[indexHour], 2500)
+# })
+#
+# describe("tsPlot, interactive, x and refStudy are antaresDataTable", {
+# myData1 <- readAntares(links = "all", showProgress = FALSE)
+# myData2 <- readAntares(links = "all", showProgress = FALSE)
+# myLink <- "a - a_offshore"
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# # no interactive
+# tsDa1 <- tsPlot(x = myData1,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -9)
+# # interactive
+# tsDa1Int <- tsPlot(x = myData1,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# dateRange = DR)
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# expect_equal(tsDa1Int$ncharts, 1)
+# expect_equal(tsDa1Int$ncol, 1)
+# expect_equal(tsDa1Int$nrow, 1)
+# tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
+# tsDa1Int$updateCharts()
+# expect_equal(tsDa1Int$getValue("tables"), "links")
+# expect_equal(tsDa1Int$getValue("mcYear"), "average")
+# dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_lt(indexHour, 50)
+# # BUG with interactive
+# ## we must remove 24 hours ?
+# expect_equal(dataTsDAInt$`a - a_offshore`[indexHour - 24], -9)
+# # interactive with refStudy
+# tsDa1Int <- tsPlot(x = myData1,
+# refStudy = myData2,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# dateRange = DR)
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
+# dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
+# expect_equal(dataTsDAInt$`a - a_offshore`[indexHour - 24], 0)
+#
+# # edit myData2 to have a diff != 0
+# ## pb timeZone local (PC, Travis, etc)
+# for (i in 0:5){
+# timeEditShift <- lubridate::hours(i)
+# timeEditMinus <- as.Date(timeEditValue) - timeEditShift
+# timeEditPlus <- as.Date(timeEditValue) + timeEditShift
+# myData2[ (time == timeEditMinus | time == timeEditPlus) & link == myLink, `FLOW LIN.` := as.integer(`FLOW LIN.` + 2500)]
+# }
+# tsDa1Int <- tsPlot(x = myData2,
+# refStudy = myData1,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# dateRange = DR)
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
+# dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
+# expect_equal(dataTsDAInt$`a - a_offshore`[indexHour - 24], 2500)
+# })
+#
+# describe("tsPlot, interactive, x and refStudy are antaresDataList", {
+# myData1 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
+# myData2 <- readAntares(links = "all", areas = "all", showProgress = FALSE)
+# myArea <- "b"
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# # no interactive
+# tsDa1 <- tsPlot(x = myData1,
+# table = "areas",
+# elements = myArea,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDa1$b[indexHour], 2427150)
+# # interactive
+# tsDa1Int <- tsPlot(x = myData1,
+# table = "areas",
+# elements = myArea,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# dateRange = DR)
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# expect_equal(tsDa1Int$ncharts, 1)
+# expect_equal(tsDa1Int$ncol, 1)
+# expect_equal(tsDa1Int$nrow, 1)
+# tsDa1Int$setValue("mcYear", "average", reactive = TRUE)
+# tsDa1Int$setValue("tables", "areas", reactive = TRUE)
+# tsDa1Int$setValue("elements", "b", reactive = TRUE)
+# tsDa1Int$updateCharts()
+# expect_equal(tsDa1Int$getValue("tables"), "areas")
+# expect_equal(tsDa1Int$getValue("mcYear"), "average")
+# expect_equal(tsDa1Int$getValue("elements"), "b")
+# dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_lt(indexHour, 50)
+# # BUG with interactive
+# ## we must remove 24 hours ?
+# expect_equal(dataTsDAInt$b[indexHour - 24], 2427150)
+# # interactive with refStudy
+# tsDa1Int <- tsPlot(x = myData1,
+# refStudy = myData2,
+# table = "areas",
+# elements = myArea,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# dateRange = DR)
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# tsDa1Int$setValue("mcYear", "average", reactive = FALSE)
+# dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
+# expect_equal(dataTsDAInt$b[indexHour - 24], 0)
+#
+# # edit myData2 to have a diff != 0
+# ## pb timeZone local (PC, Travis, etc)
+# for (i in 0:5){
+# timeEditShift <- lubridate::hours(i)
+# timeEditMinus <- as.Date(timeEditValue) - timeEditShift
+# timeEditPlus <- as.Date(timeEditValue) + timeEditShift
+# myData2$areas[ (time == timeEditMinus | time == timeEditPlus) & area == myArea, `OV. COST` := as.integer(`OV. COST` + 2500)]
+# }
+# tsDa1Int <- tsPlot(x = myData2,
+# refStudy = myData1,
+# table = "areas",
+# elements = myArea,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# dateRange = DR)
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# tsDa1Int$setValue("mcYear", "average", reactive = TRUE)
+# tsDa1Int$setValue("tables", "areas", reactive = TRUE)
+# tsDa1Int$setValue("elements", "b", reactive = TRUE)
+# tsDa1Int$updateCharts()
+# dataTsDAInt <- .get_data_from_htmlwidget(tsDa1Int)
+# expect_equal(dataTsDAInt$b[indexHour - 24], 2500)
+# })
+#
+# describe("tsPlot, no interactive, x and refStudy are optsH5 ", {
+# testthat::skip("Reason: .runTsPlotTest is not TRUE")
+# if (.requireRhdf5_Antares(stopP = FALSE)){
+# skip_if_not(.runTsPlotTest)
+# suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
+# optsH5 <- setSimulationPath(pathtemp)
+# myLink <- "a - a_offshore"
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# # no interactive
+# tsDa1 <- tsPlot(x = optsH5,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -9)
+# #ref Study
+# tsDa1 <- tsPlot(x = optsH5,
+# refStudy = optsH5,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDa1$`a - a_offshore`[indexHour], 0)
+# # Edit H5 file
+# ## create a new folder h5
+# pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
+# pathNewH5 <- file.path(pathInitial, "testH5")
+# if (!dir.exists(pathNewH5)){
+# dir.create(pathNewH5)
+# }
+# #write the study
+# #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
+# optsData <- antaresRead::setSimulationPath(path = studyPath)
+# suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData,
+# overwrite = TRUE, supressMessages = TRUE))
+#
+# pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5))
+# .h5Antares_edit_variable(
+# pathH5 = pathNewH5File,
+# link = myLink,
+# timeId = 1:100,
+# antVar = "FLOW LIN.",
+# newValue = 15000
+# )
+#
+# optsH5New <- setSimulationPath(path = pathNewH5File)
+# tsDa1 <- tsPlot(x = optsH5New,
+# refStudy = optsH5,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_equal(dataTsDa1$`a - a_offshore`[indexHour], 15009)
+# }
+# })
+#
+# describe("tsPlot, no interactive, x is a list of optH5 and refStudy are optsH5 ", {
+# if (.requireRhdf5_Antares(stopP = FALSE)){
+# skip_if_not(.runTsPlotTest)
+# suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
+# optsH5 <- setSimulationPath(pathtemp)
+#
+# # with new Studies H5 test if compare prodStack works
+# ## create new folders h5
+# pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
+#
+# listFolderToCreate <- c("testH5v2", "testH5v3", "testH5v4")
+# for (folder in listFolderToCreate){
+# pathNewH5 <- file.path(pathInitial, folder)
+# if (!dir.exists(pathNewH5)){
+# dir.create(pathNewH5)
+# }
+# #write the study
+# #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
+# optsData <- antaresRead::setSimulationPath(path = studyPath)
+# suppressWarnings(
+# writeAntaresH5(
+# path = pathNewH5,
+# opts = optsData,
+# overwrite = TRUE,
+# supressMessages = TRUE)
+# )
+# }
+# idWidgetToEdit <- 2
+# pathH5FolderToEdit <- file.path(pathInitial, listFolderToCreate[[idWidgetToEdit]])
+# pathH5FileToEdit <- file.path(pathH5FolderToEdit, list.files(pathH5FolderToEdit))
+# newValueFlow <- 15000
+# myLink <- getLinks()[1]
+# .h5Antares_edit_variable(
+# pathH5 = pathH5FileToEdit,
+# link = myLink,
+# timeId = 1:100,
+# antVar = "FLOW LIN.",
+# newValue = newValueFlow
+# )
+# optsList <- list()
+# antaresDataListH5 <- list()
+# for (i in 1:length(listFolderToCreate)){
+# pathOptsI <- file.path(pathInitial, listFolderToCreate[[i]])
+# optsList[[i]] <- setSimulationPath(path = pathOptsI)
+# antaresDataListH5[[i]] <- readAntares(links = myLink)
+# }
+# #test the data from h5
+# #get the data from the h5 file
+# antaresDataRef <- readAntares(opts = optsH5, links = myLink)
+# expect_equal(max(antaresDataListH5[[idWidgetToEdit]]$`FLOW LIN.`), newValueFlow)
+# expect_equal(max(antaresDataListH5[[1]]$`FLOW LIN.`), max(antaresDataRef$`FLOW LIN.`))
+# expect_equal(max(antaresDataListH5[[3]]$`FLOW LIN.`), max(antaresDataRef$`FLOW LIN.`))
+# # get the data from htmlwidget
+# myArea <- "a"
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# tsDa1 <- tsPlot(x = optsList,
+# refStudy = optsH5,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa3 <- .get_data_from_htmlwidget(tsDa1, widgetsNumber = idWidgetToEdit)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsDa3$hour)
+# expect_equal(dataTsDa3$`a - a_offshore`[indexHour], 15009)
+# dataTsDa2 <- .get_data_from_htmlwidget(tsDa1, widgetsNumber = 1)
+# expect_equal(dataTsDa2$`a - a_offshore`[indexHour], 0)
+# }
+# })
+#
+# describe("tsPlot, interactive, x and refStudy are optsH5 ", {
+# if (.requireRhdf5_Antares(stopP = FALSE)){
+# skip_if_not(.runTsPlotTest)
+# suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
+# optsH5 <- setSimulationPath(pathtemp)
+# myLink <- "a - a_offshore"
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# # no interactive
+# tsDa1 <- tsPlot(x = optsH5,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE)
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -9)
+# #interactive
+# tsDa1Int <- tsPlot(x = optsH5,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# h5requestFiltering = list(
+# mcYears = 1
+# ))
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# expect_equal(tsDa1Int$ncharts, 1)
+# expect_equal(tsDa1Int$ncol, 1)
+# expect_equal(tsDa1Int$nrow, 1)
+# expect_true(is((tsDa1Int$getValue("x_tranform")[[1]]), "antaresData"))
+# tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
+# tsDa1Int$setValue("tables", "areas", reactive = TRUE)
+# tsDa1Int$setValue("elements", "b", reactive = TRUE)
+# tsDa1Int$setValue("variable", "LOAD", reactive = TRUE)
+# tsDa1Int$setValue("dateRange", DR, reactive = TRUE)
+# tsDa1Int$updateCharts()
+# tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
+# tsDa1Int$setValue("meanYearH5", FALSE, reactive = TRUE)
+# tsDa1Int$updateCharts()
+# tsDa1Int$setValue("meanYearH5", FALSE, reactive = TRUE)
+# tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
+# expect_equal(tsDa1Int$getValue("tables"), "areas")
+# expect_equal(tsDa1Int$getValue("mcYear"), 1)
+# expect_equal(tsDa1Int$getValue("elements"), "b")
+# expect_equal(tsDa1Int$getValue("variable"), "LOAD")
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1Int)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(dataTsDa1$b[indexHour], 60262)
+# # Edit H5 file
+# ## create a new folder h5
+# pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
+# pathNewH5 <- file.path(pathInitial, "testH5")
+# if (!dir.exists(pathNewH5)){
+# dir.create(pathNewH5)
+# }
+# #write the study
+# #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
+# optsData <- antaresRead::setSimulationPath(path = studyPath)
+# suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData,
+# overwrite = TRUE, supressMessages = TRUE))
+# pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5))
+# .h5Antares_edit_variable(
+# pathH5 = pathNewH5File,
+# area = "b",
+# timeId = 1:100,
+# antVar = "LOAD",
+# newValue = 15000,
+# mcYear = 1
+# )
+# optsH5New <- setSimulationPath(path = pathNewH5File)
+# myData <- readAntares(areas = "b",
+# select = "LOAD",
+# opts = optsH5New,
+# mcYears = 1)
+# myDataRef <- readAntares(areas = "b",
+# select = "LOAD",
+# opts = optsH5,
+# mcYears = 1)
+# expect_equal(myData[area == "b" & timeId == 2737, LOAD], 15000)
+# expect_gt(myDataRef[area == "b" & timeId == 2737, LOAD], 16000)
+#
+# diffValue <- myData[area == "b" & timeId == 2737, LOAD] -
+# myDataRef[area == "b" & timeId == 2737, LOAD]
+# tsDa1Int <- tsPlot(x = optsH5New,
+# refStudy = optsH5,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# h5requestFiltering = list(
+# mcYears = 1
+# ))
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# expect_equal(tsDa1Int$ncharts, 1)
+# expect_equal(tsDa1Int$ncol, 1)
+# expect_equal(tsDa1Int$nrow, 1)
+# tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
+# tsDa1Int$setValue("tables", "areas", reactive = TRUE)
+# tsDa1Int$setValue("elements", "b", reactive = FALSE)
+# tsDa1Int$setValue("variable", "LOAD", reactive = FALSE)
+# tsDa1Int$setValue("dateRange", DR, reactive = FALSE)
+# tsDa1Int$updateCharts()
+# expect_equal(tsDa1Int$getValue("tables"), "areas")
+# expect_equal(tsDa1Int$getValue("mcYear"), 1)
+# expect_equal(tsDa1Int$getValue("elements"), "b")
+# expect_equal(tsDa1Int$getValue("variable"), "LOAD")
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1Int)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_equal(dataTsDa1$b[indexHour], diffValue)
+# # for links, no refStudy
+# tsDa1Int <- tsPlot(x = optsH5New,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# h5requestFiltering = list(
+# mcYears = 1
+# ))
+# tsDa1Int <- tsDa1Int$init()
+# expect_true(is(tsDa1Int, "MWController"))
+# expect_equal(tsDa1Int$ncharts, 1)
+# expect_equal(tsDa1Int$ncol, 1)
+# expect_equal(tsDa1Int$nrow, 1)
+# tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
+# tsDa1Int$setValue("tables", "links", reactive = TRUE)
+# tsDa1Int$setValue("elements", myLink, reactive = FALSE)
+# tsDa1Int$setValue("variable", "FLOW LIN.", reactive = FALSE)
+# tsDa1Int$setValue("dateRange", DR, reactive = FALSE)
+# tsDa1Int$updateCharts()
+# tsDa1Int$setValue("mcYear", 1, reactive = TRUE)
+# expect_true(is((tsDa1Int$getValue("x_tranform")[[1]]), "antaresData"))
+# expect_equal(tsDa1Int$getValue("tables"), "links")
+# expect_equal(tsDa1Int$getValue("mcYear"), 1)
+# expect_equal(tsDa1Int$getValue("elements"), myLink)
+# expect_equal(tsDa1Int$getValue("variable"), "FLOW LIN.")
+# dataTsDa1 <- .get_data_from_htmlwidget(tsDa1Int)
+# indexHour <- grep(timeEditValue, dataTsDa1$hour)
+# expect_equal(dataTsDa1$`a - a_offshore`[indexHour], -10)
+# # for links, with refStudy
+# tsDa1IntRef <- tsPlot(x = optsH5New,
+# refStudy = optsH5,
+# type = "ts",
+# interactive = TRUE,
+# .runApp = FALSE,
+# h5requestFiltering = list(
+# mcYears = 1
+# ))
+# tsDa1IntRef <- tsDa1IntRef$init()
+# expect_true(is(tsDa1IntRef, "MWController"))
+# expect_equal(tsDa1IntRef$ncharts, 1)
+# expect_equal(tsDa1IntRef$ncol, 1)
+# expect_equal(tsDa1IntRef$nrow, 1)
+# expect_true(is((tsDa1IntRef$getValue("x_tranform")[[1]]), "antaresData"))
+# tsDa1IntRef$setValue("mcYear", 1, reactive = TRUE)
+# expect_equal(tsDa1IntRef$getValue("mcYear"), 1)
+# expect_equal(tsDa1IntRef$getValue("tables"), "areas")
+# tsDa1IntRef$setValue("tables", "links", reactive = TRUE)
+# tsDa1IntRef$setValue("elements", myLink, reactive = FALSE)
+# tsDa1IntRef$setValue("variable", "FLOW LIN.", reactive = FALSE)
+# tsDa1IntRef$setValue("dateRange", DR, reactive = FALSE)
+# tsDa1IntRef$setValue("meanYearH5", FALSE, reactive = TRUE)
+# tsDa1IntRef$updateCharts()
+# tsDa1IntRef$setValue("meanYearH5", TRUE, reactive = TRUE)
+# tsDa1IntRef$setValue("mcYear", 1, reactive = TRUE)
+# expect_true(is((tsDa1IntRef$getValue("x_tranform")[[1]]), "antaresData"))
+# expect_equal(tsDa1IntRef$getValue("tables"), "links")
+# expect_true(is((tsDa1IntRef$getValue("x_tranform")[[1]]), "antaresData"))
+# expect_equal(tsDa1IntRef$getValue("elements"), myLink)
+# expect_equal(tsDa1IntRef$getValue("variable"), "FLOW LIN.")
+# expect_equal(tsDa1IntRef$getValue("mcYear"), 1)
+# dataTsDa1Ref <- .get_data_from_htmlwidget(tsDa1IntRef)
+# indexHour <- grep(timeEditValue, dataTsDa1Ref$hour)
+# expect_equal(dataTsDa1Ref$`a - a_offshore`[indexHour], 0)
+# }
+# })
+#
+# describe("tsPlot, interactive, x is a list of optsH5 and refStudy optsH5", {
+# if (.requireRhdf5_Antares(stopP = FALSE)){
+# skip_if_not(.runTsPlotTest)
+# suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
+# optsH5 <- setSimulationPath(pathtemp)
+#
+# # with new Studies H5 test if compare prodStack works
+# ## create new folders h5
+# pathInitial <- file.path(dirname(pathtemp), basename(pathtemp))
+# listFolderToCreate <- c("testH5v2", "testH5v3", "testH5v4")
+# for (folder in listFolderToCreate){
+# pathNewH5 <- file.path(pathInitial, folder)
+# if (!dir.exists(pathNewH5)){
+# dir.create(pathNewH5)
+# }
+#
+# #write the study
+# #windows pb ? pathNewH5 <- gsub("/", "\\", pathNewH5, fixed = TRUE)
+# optsData <- antaresRead::setSimulationPath(path = studyPath)
+# suppressWarnings(
+# writeAntaresH5(
+# path = pathNewH5,
+# opts = optsData,
+# overwrite = TRUE,
+# supressMessages = TRUE)
+# )
+# }
+# pathH5FolderToEdit <- file.path(pathInitial, listFolderToCreate[[2]])
+# pathH5FileToEdit <- file.path(pathH5FolderToEdit, list.files(pathH5FolderToEdit))
+# myLink <- getLinks()[1]
+# newValueFlow <- 50000
+# mcYearToTestList <- c(2, NULL)
+# myVar <- "FLOW LIN."
+# for (mcYearToTest in mcYearToTestList){
+# .h5Antares_edit_variable(
+# pathH5 = pathH5FileToEdit,
+# link = myLink,
+# timeId = 1:100,
+# antVar = myVar,
+# newValue = newValueFlow,
+# mcYear = mcYearToTest
+# )
+# #stock the data
+# optsList <- list()
+# antaresDataListH5 <- list()
+# for (i in 1:length(listFolderToCreate)){
+# pathOptsI <- file.path(pathInitial, listFolderToCreate[[i]])
+# optsList[[i]] <- setSimulationPath(path = pathOptsI)
+# antaresDataListH5[[i]] <- readAntares(links = myLink,
+# mcYear = mcYearToTest,
+# opts = optsList[[i]])
+# }
+# DR <- c("2018-04-24 00:00:00 UTC", "2018-04-26 00:00:00 UTC")
+# #try without refStudy and interactive == FALSE
+# indexHour <- 49
+# expect_equal(antaresDataListH5[[2]]$`FLOW LIN.`[[indexHour]], 50000)
+# if(is.null(mcYearToTest)){
+# valFlow <- (-9)
+# }else{
+# valFlow <- (-7)
+# }
+# expect_equal(antaresDataListH5[[1]]$`FLOW LIN.`[[indexHour]], valFlow)
+# expect_equal(antaresDataListH5[[3]]$`FLOW LIN.`[[indexHour]], valFlow)
+#
+# if(!is.null(mcYearToTest)){
+# expect_error(tsPlot(x = optsList,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE,
+# mcYear = mcYearToTest),
+# "You can't use mcYear for h5 file when interactive is set to FALSE. You can use mcYearh5.")
+# }
+# tsPlotNoInt <- tsPlot(x = optsList,
+# table = "links",
+# elements = myLink,
+# type = "ts",
+# interactive = FALSE,
+# mcYearh5 = mcYearToTest)
+# datatsPlotNoInt <- .get_data_from_htmlwidget(tsPlotNoInt, widgetsNumber = 2)
+# timeEditValue <- "2018-04-25T00:00:00.000Z"
+# indexHour <- grep(timeEditValue, datatsPlotNoInt$hour)
+# expect_gt(indexHour, 2)
+# expect_equal(datatsPlotNoInt$`a - a_offshore`[[indexHour]], 50000)
+# #interactive
+# tsPlotInt <- tsPlot(x = optsList,
+# type = "ts",
+# dateRange = DR,
+# .runApp = FALSE,
+# interactive = TRUE,
+# h5requestFiltering = list(
+# mcYears = mcYearToTest
+# ))
+# tsPlotInt <- tsPlotInt$init()
+# expect_true(is(tsPlotInt, "MWController"))
+# expect_equal(tsPlotInt$ncharts, 3)
+# expect_equal(tsPlotInt$ncol, 2)
+# expect_equal(tsPlotInt$nrow, 2)
+# tsPlotInt$setValue("mcYear", mcYearToTest, reactive = TRUE)
+# tsPlotInt$setValue("tables", "links", reactive = TRUE)
+# tsPlotInt$setValue("elements", myLink, reactive = TRUE)
+# tsPlotInt$setValue("variable", myVar, reactive = TRUE)
+# tsPlotInt$setValue("dateRange", DR, reactive = TRUE)
+# if(is.null(mcYearToTest)){
+# tsPlotInt$setValue("meanYearH5", FALSE, reactive = TRUE)
+# expect_equal(tsPlotInt$getValue("meanYearH5"), FALSE)
+# tsPlotInt$setValue("mcYear", "average", reactive = TRUE)
+# }else{
+# tsPlotInt$setValue("meanYearH5", TRUE, reactive = TRUE)
+# expect_equal(tsPlotInt$getValue("meanYearH5"), TRUE)
+# }
+# tsPlotInt$updateCharts()
+# expect_equal(tsPlotInt$getValue("tables"), "links")
+# tsPlotInt$setValue("mcYear", mcYearToTest, reactive = TRUE)
+# if(!is.null(mcYearToTest)){
+# expect_equal(tsPlotInt$getValue("mcYear"), mcYearToTest)
+# }else{
+# tsPlotInt$setValue("mcYear", "average", reactive = TRUE)
+# expect_equal(tsPlotInt$getValue("mcYear"), "average")
+# }
+# expect_equal(tsPlotInt$getValue("mcYearH5"),"1")
+# expect_equal(tsPlotInt$getValue("elements"), myLink)
+# expect_equal(tsPlotInt$getValue("variable"), myVar)
+# datatsPlotInt <- .get_data_from_htmlwidget(tsPlotInt, widgetsNumber = 2)
+# indexHour <- grep(timeEditValue, datatsPlotInt$hour)
+# expect_equal(datatsPlotInt$`a - a_offshore`[[indexHour]], 50000)
+# datatsPlotInt2 <- .get_data_from_htmlwidget(tsPlotInt, widgetsNumber = 1)
+# indexHour <- grep(timeEditValue, datatsPlotInt2$hour)
+# expect_equal(datatsPlotInt2$`a - a_offshore`[[indexHour]], valFlow)
+# #interactive with refStudy
+# tsPlotIntRef <- tsPlot(x = optsList,
+# refStudy = optsH5,
+# type = "ts",
+# dateRange = DR,
+# .runApp = FALSE,
+# interactive = TRUE,
+# h5requestFiltering = list(
+# mcYears = mcYearToTest
+# ))
+# tsPlotIntRef <- tsPlotIntRef$init()
+# expect_true(is(tsPlotIntRef, "MWController"))
+# expect_equal(tsPlotIntRef$ncharts, 3)
+# expect_equal(tsPlotIntRef$ncol, 2)
+# expect_equal(tsPlotIntRef$nrow, 2)
+# tsPlotIntRef$setValue("mcYear", mcYearToTest, reactive = TRUE)
+# tsPlotIntRef$setValue("tables", "links", reactive = TRUE)
+# tsPlotIntRef$setValue("elements", myLink, reactive = TRUE)
+# tsPlotIntRef$setValue("variable", myVar, reactive = TRUE)
+# tsPlotIntRef$setValue("dateRange", DR, reactive = TRUE)
+# if(is.null(mcYearToTest)){
+# tsPlotIntRef$setValue("meanYearH5", FALSE, reactive = TRUE)
+# expect_equal(tsPlotIntRef$getValue("meanYearH5"), FALSE)
+# }else{
+# tsPlotIntRef$setValue("meanYearH5", TRUE, reactive = TRUE)
+# expect_equal(tsPlotIntRef$getValue("meanYearH5"), TRUE)
+# }
+# tsPlotIntRef$updateCharts()
+# expect_equal(tsPlotIntRef$getValue("tables"), "links")
+# tsPlotIntRef$setValue("mcYear", mcYearToTest, reactive = TRUE)
+# if(!is.null(mcYearToTest)){
+# expect_equal(tsPlotInt$getValue("mcYear"), mcYearToTest)
+# expect_equal(tsPlotIntRef$getValue("mcYearH5"),"1")
+# }else{
+# tsPlotIntRef$setValue("mcYear", "average", reactive = TRUE)
+# tsPlotIntRef$setValue("mcYearH5", "", reactive = TRUE)
+# expect_equal(tsPlotIntRef$getValue("mcYearH5"),"")
+# expect_equal(tsPlotIntRef$getValue("mcYear"), "average")
+# }
+# expect_equal(tsPlotIntRef$getValue("elements"), myLink)
+# expect_equal(tsPlotIntRef$getValue("variable"), myVar)
+# datatsPlotIntRef <- .get_data_from_htmlwidget(tsPlotIntRef, widgetsNumber = 2)
+# indexHour <- grep(timeEditValue, datatsPlotIntRef$hour)
+# expect_equal(datatsPlotIntRef$`a - a_offshore`[[indexHour]], 50000-(valFlow))
+# datatsPlotIntRef2 <- .get_data_from_htmlwidget(tsPlotIntRef, widgetsNumber = 1)
+# indexHour <- grep(timeEditValue, datatsPlotIntRef2$hour)
+# expect_equal(datatsPlotIntRef2$`a - a_offshore`[[indexHour]], 0)
+# }
+# }
+# })