Feature/ant 863

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: antaresViz
 Type: Package
 Title: Antares Visualizations
-Version: 0.18.0
+Version: 0.18.1
 Authors@R: c(
     person("Tatiana", "Vargas", email = "[email protected]", role = c("aut", "cre")),
     person("Jalal-Edine", "Zawam", role = "aut"),
@@ -55,5 +55,6 @@ Suggests:
     hexbin,
     knitr,
     visNetwork,
-    rmarkdown
+    rmarkdown,
+    antaresEditObject
 VignetteBuilder: knitr

NAMESPACE

@@ -13,6 +13,7 @@ export(getInteractivity)
 export(leafletDragPointsOutput)
 export(limitSizeGraph)
 export(mapLayout)
+export(mapLayout_no_interactive)
 export(modRpart)
 export(modXY)
 export(plotMap)
@@ -56,6 +57,7 @@ importFrom(grDevices,rainbow)
 importFrom(grDevices,rgb)
 importFrom(graphics,par)
 importFrom(graphics,plot.default)
+importFrom(methods,as)
 importFrom(methods,is)
 importFrom(plotly,add_bars)
 importFrom(plotly,add_heatmap)
@@ -64,6 +66,7 @@ importFrom(plotly,add_trace)
 importFrom(plotly,config)
 importFrom(plotly,layout)
 importFrom(plotly,plot_ly)
+importFrom(sf,st_read)
 importFrom(shiny,runApp)
 importFrom(stats,as.formula)
 importFrom(stats,density)

NEWS.md

@@ -1,5 +1,10 @@
 Copyright 2016 RTE Reseau de transport d'electricite
 
+# antaresViz 0.18.1
+
+## new feature : 
+* `mapLayout_no_interactive()` make an object of class "mapLayout" from external geojson file
+
 # antaresViz 0.18.0
 * fix deprecated dependencies (issue #200)
   * packages `rgeos`, `raster` removed and replaced by `sf`

R/map_layout.R

@@ -646,3 +646,136 @@ plot.mapLayout <- function(x, colAreas =  x$coords$color, dataAreas = 1,
   # Add shadows to elements
   map %>% addShadows()
 }
+
+
+
+
+
+utils::globalVariables("from")
+
+#' @title Build a `mapLayout` object with gesojson file
+#'
+#' @description 
+#' 
+#' This function creates a 'mapLayout' object from a study and an external 
+#' 'geojson' file.  
+#'  
+#' This function should be used only once per study.  
+#' 
+#' The result should then be saved in an external file and be reused.
+#' 
+#' @param path_geojson_file `character` path of geojson file
+#' @param opts list of simulation parameters returned by 
+#' the function \code{\link[antaresRead]{setSimulationPath}}
+#' 
+#' @importFrom methods as
+#' @importFrom sf st_read
+#' 
+#' @export
+#' @note The 'geojson' file must contain zones compatible with the study.
+#' 
+#' @return Object of class "mapLayout"
+#' 
+#' @examples 
+#' \dontrun{
+#' # set informations to your study ("input" mode is enough)
+#' setSimulationPath(path = "path/my_study", simulation = "input")
+#' 
+#' path_geojson <- "path/my_geosjonfile.geojson"
+#' 
+#' mapLayout_no_interactive(path_geojson_file = path_geojson)
+#' 
+#' }
+mapLayout_no_interactive <- function(path_geojson_file, 
+                                        opts = simOptions()){
+  # check parameters
+  assertthat::assert_that(inherits(path_geojson_file, "character"))
+  assertthat::assert_that(inherits(opts, "simOptions"))
+
+  # read file
+  sf_object <- st_read(path_geojson_file)
+
+  # check geojson file
+  if(!"name"%in%names(sf_object))
+    stop("geosjon file must have key 'name'", 
+         call. = FALSE)
+  if(!all(c("Lat", "Long")%in%names(sf_object)))
+    stop("geosjon file must have key {'Lat;'Long'}", 
+         call. = FALSE)
+
+  # check areas if compatible with geojson file
+  areas_names <- getAreas()
+  if(!any(areas_names%in%tolower(sf_object$name)))
+    stop("study must have areas according to geojson file", 
+         call. = FALSE)
+
+  cat("\nstudy compatible with geojson file\n")
+
+  # conversion to "sp" class
+  geojson_as_sp <- as(sf_object, "Spatial")
+
+  ##
+  # build "mapLayout" object
+  ##
+  all_coords <- data.table(
+    area = tolower(geojson_as_sp@data$name),
+    x = geojson_as_sp@data$Long,
+    y = geojson_as_sp@data$Lat,
+    color = rep("#0080FF", times = length(geojson_as_sp@data$name)),
+    geoAreaId = seq(seq_along(geojson_as_sp@data$name))
+  )
+
+  # keep area and id
+  zone_geoArea_table <- data.frame(
+    ZONE = all_coords$area,
+    geoAreaId = all_coords$geoAreaId
+  )
+
+  # update "SpatialPolygonsDataFrame" object
+  geojson_as_sp@data<-zone_geoArea_table
+
+  setcolorder(all_coords, c("area", "x", "y", "color", "geoAreaId"))
+
+  ##
+  # Manage study's links
+  ##
+  links <- data.table(
+    opts$linksDef
+  )
+
+  if(nrow(links) %in% 0)
+    stop("no links are found in study", 
+         call. = FALSE)
+
+  # keep links according to your study
+  links <- links[from %in% all_coords$area & to %in% all_coords$area]
+
+  # add coordonates links "from"
+  links <- merge(
+    x = links,
+    y = all_coords[, list(from = area, x0 = x, y0 = y)],
+    by = "from"
+  )
+
+  # add coordonates links "to"
+  links <- merge(
+    x = links,
+    y = all_coords[, list(to = area, x1 = x, y1 = y)],
+    by = "to"
+  )
+
+  setcolorder(links, c("link", "from", "to", "x0", "y0", "x1", "y1"))
+
+  # final object
+  zone_layout <- list(
+    coords = all_coords,
+    links = links,
+    map = geojson_as_sp,
+    all_coords = all_coords
+  )
+
+  class(zone_layout) <- "mapLayout"
+  attr(zone_layout, "type") <- "areas"
+
+  return(zone_layout)
+}

tests/testthat/test-map_layout.R

@@ -0,0 +1,101 @@
+
+test_that("build objet 'mapLayout' no interactive", {
+  skip_if_not_installed("antaresEditObject", 
+                        minimum_version = "0.3.0")
+
+ # create study ----
+  # create study with areas/links according to geojson file test
+  suppressWarnings(
+    antaresEditObject::createStudy(path = tempdir(), 
+                                   study_name = "zonal_test", 
+                                   antares_version = "8.2.0")
+  )
+
+  lapply(c("21_FR", "24_FR", "23_FR", "16_FR"), 
+         antaresEditObject::createArea)
+
+  antaresEditObject::createLink(from = "21_FR", 
+             to = "24_FR")
+
+ # read geojson ----
+  path_geojson_test <- system.file("mapLayout/filter_zonal.geojson", 
+                                   package = "antaresViz")
+
+  geo_file <- sf::st_read(path_geojson_test)
+
+ # error case ----
+    # bad areas name
+  bad_area_name <- geo_file
+  bad_area_name$name <- sample(c("titi", "toto"), 
+                          size = length(bad_area_name$name), 
+                          replace = TRUE)
+
+  bad_area_name <- geojsonio::geojson_write(input = bad_area_name)
+
+  testthat::expect_error(
+    mapLayout_no_interactive(path_geojson_file = bad_area_name$path), 
+    regexp = "study must have areas according to geojson file"
+  )
+
+    # bad structure geojson file
+  bad_struct_file <- geo_file
+  bad_struct_file <- bad_struct_file[, setdiff(names(bad_struct_file), "name")]
+
+  bad_struct_file <- geojsonio::geojson_write(input = bad_struct_file)
+
+  testthat::expect_error(
+    mapLayout_no_interactive(path_geojson_file = bad_struct_file$path), 
+    regexp = "geosjon file must have key 'name'"
+  )
+
+    # no "Long" "Lat" key
+  bad_struct_file <- geo_file
+  bad_struct_file <- bad_struct_file[, setdiff(names(bad_struct_file), 
+                                               c("Lat", "Long"))]
+
+  bad_struct_file <- geojsonio::geojson_write(input = bad_struct_file)
+
+  testthat::expect_error(
+    mapLayout_no_interactive(path_geojson_file = bad_struct_file$path), 
+    regexp = "geosjon file must have key \\{'Lat;'Long'\\}"
+  )
+
+  # remove file
+  file.remove(bad_struct_file$path)
+
+  # good case ----
+  # build "mapLayout" object
+  obj_mapLayout <- mapLayout_no_interactive(path_geojson_file = path_geojson_test)
+
+  # tests
+  testthat::expect_s3_class(obj_mapLayout, 'mapLayout')
+  testthat::expect_true(all(
+    c("coords", "links", "map", "all_coords") %in%
+                          names(obj_mapLayout)))
+
+  # delete study ----
+  unlink(file.path(tempdir(), "zonal_test"), recursive = TRUE)
+
+  # # @examples
+  #   # commented code if you want to test to plot this "mapLayout"
+  # 
+  # # run from ui if it don't work
+  # runSimulation("zonal_testsim",
+  #               path_solver = "D:/AppliRTE/bin/antares-8.2-solver.exe") 
+  # 
+  # # read only one simulation
+  # opts_zonal <- setSimulationPath(file.path(tempdir(),
+  #                                           "zonal_test"))
+  # 
+  # mydata <- readAntares(areas = obj_mapLayout$coords$area,
+  #                       links = obj_mapLayout$links$link,
+  #                       timeStep = "daily",
+  #                       select = "nostat",
+  #                       opts = simOptions())
+  # 
+  # # viz
+  # myOption <- plotMapOptions(areaChartColors = c("yellow", "violetred"),
+  #                            linkDefaultCol = "green")
+  # plotMap(x = mydata, mapLayout = obj_mapLayout,
+  #         options = myOption)
+})

tests/testthat/test-plotMap.R

@@ -2,7 +2,7 @@ context("plotMap")
 
 test_that("plotMap, no interactive", {
 
-  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   testClass <- function(obj){
     class(obj)[1] == 'combineWidgets'
   }
@@ -23,7 +23,7 @@ test_that("plotMap, no interactive", {
 
 test_that("plotMap, no interactive return error", {
 
-  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   load(system.file("mapLayout/ml.rda", package = "antaresViz"))
 
   expect_error(plotMap(x = dta, mapLayout = ml , interactive = FALSE, compare = "areas"))
@@ -32,15 +32,15 @@ test_that("plotMap, no interactive return error", {
 })
 
 test_that("plotMap, interactive", {
-  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   load(system.file("mapLayout/ml.rda", package = "antaresViz"))
   VV <- plotMap(x = dta, mapLayout = ml, .runApp = FALSE, interactive = TRUE)
   VV$init()
   expect_true("MWController" %in% class(VV))
 })
 
 test_that("plotMap, no interactive, x and refStudy are antaresDataList", {
-  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  dta <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   load(system.file("mapLayout/ml.rda", package = "antaresViz"))
   resPlotMap <- plotMap(x = dta,
                         mapLayout = ml,
@@ -67,7 +67,7 @@ test_that("plotMap, no interactive, x and refStudy are antaresDataList", {
                                     htmlPlotMap = resPlotMap)
   expect_equal(valToValid, 0)
   # edit myData
-  data2 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  data2 <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   data2$areas[ , LOAD := as.double(LOAD)][area=="c", LOAD := as.double(LOAD +2500.0)]
   resPlotMap2 <- plotMap(x = data2,
                         refStudy = dta,
@@ -84,7 +84,7 @@ test_that("plotMap, no interactive, x and refStudy are antaresDataList", {
 })
 
 test_that("plotMap, no interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
-  data1 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  data1 <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   dataList <- list(data1, data1, data1)
   load(system.file("mapLayout/ml.rda", package = "antaresViz"))
   resPlotMap <- plotMap(x = dataList,
@@ -114,8 +114,8 @@ test_that("plotMap, no interactive, x is a list of antaresDataList and refStudy
                                     idWidget = 2)
   expect_equal(valToValid, 0)
   # edit myData
-  data2 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
-  data1 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
+  data2 <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
+  data1 <- readAntares(areas = "all", links = "all", showProgress = FALSE, opts = opts)
   data2$areas[ , LOAD := as.double(LOAD)][area=="c", LOAD := as.double(LOAD +2500.0)]
   dataList2 <- list(data1, data2, data1)
   expect_equal(dataList2[[2]]$areas[area=="c", LOAD], dataList2[[1]]$areas[area=="c", LOAD] + 2500)