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 = "tatiana.vargas@rte-france.com", 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)