Dev readInputThermal, add area parameter + parameter thermalavailabilities + default matrix when no time series in cluster

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: antaresRead
 Type: Package
 Title: Import, Manipulate and Explore the Results of an 'Antares' Simulation
-Version: 2.7.0
+Version: 2.7.1
 Authors@R: c(
     person("Tatiana", "Vargas", email = "[email protected]", role = c("aut", "cre")),
     person("Jalal-Edine", "ZAWAM", role = "aut"),

NEWS.md

@@ -1,5 +1,23 @@
 > Copyright © 2016 RTE Réseau de transport d’électricité
 
+# antaresRead 2.7.1 (development)
+
+NEW FEATURES:
+
+* `readInputThermal()` :
+    - new parameter **areas** to get desired clusters from selected areas.
+    - new parameter **thermalAvailabilities** to import time series.  
+* `readInputRES()` new parameter **areas** to get desired clusters from selected areas.
+
+BREAKING CHANGES :
+
+* `readInputThermal()` / `readInputRES()` default value when no time series in the selected clusters.
+
+BUGFIXES :  
+
+* `readInputThermal()` return data from file data.txt with `thermalData` parameter
+
+
 # antaresRead 2.7.0
 
 ### Breaking changes (Antares v8.7.0) : 
@@ -24,7 +42,7 @@ Dependencies :
 
 
 
-# antaresRead 2.6.2 (development)
+# antaresRead 2.6.2 
 
 BUGFIXES :
 * `readIniFile()` : avoid `utils::type.convert` on specific cases (ex : 789e or 123i) 
@@ -46,6 +64,8 @@ BUGFIXES :
 BREAKING CHANGES :  
 
 * `api_get()` has a new parameter to control JSON file parsing
+* `readInputThermal()` default value when no time series in the selected clusters.
+* `readInputRES()` default value when no time series in the selected clusters
 * `readClusterDesc()`/ `readClusterRESDesc()` / `readClusterSTDesc()` 
 return empty dataTable and warning if no cluster in Antares study.
 
@@ -61,7 +81,7 @@ BREAKING CHANGES (Antares v8.6) :
 * `readInputTS()` is now compatible to read time series with :  
   - "short-term storage"  
   - "mingen" (pmin hydro value)
-* `setSimulationPath()` has new parameter `areasWithSTClusters` (name of area with "st-storage" cluster)
+* `setSimulationPath()` has new parameter **areasWithSTClusters** (name of area with "st-storage" cluster)
 
 
 BUGFIXES : 

R/importInput.R

@@ -369,8 +369,13 @@
 
     data$area <- area
     data$cluster <- cl
-    data <- data[opts$timeIdMin:opts$timeIdMax]
-    data$timeId <- opts$timeIdMin:opts$timeIdMax
+
+    # index blocks
+    a <- opts$parameters$general$simulation.start
+    b <- opts$parameters$general$simulation.end
+
+    data <- data[a:b]
+    data$timeId <- a:b
 
     changeTimeStep(data, timeStep, "daily", fun = "mean")
   })

R/readInputClusters.R

@@ -7,7 +7,9 @@
 #' project. But contrary to \code{\link{readAntares}}, it only reads time series
 #' stored in the input folder, so it can work in "input" mode. 
 #' 
+#' @param areas vector of areas names for which thermal time series must be read.
 #' @param clusters vector of clusters names for which thermal time series must be read.
+#' @param thermalAvailabilities if TRUE, return thermalAvailabilities data
 #' @param thermalModulation if TRUE, return thermalModulation data
 #' @param thermalData if TRUE, return thermalData from prepro
 #' @inheritParams readAntares
@@ -27,82 +29,120 @@
 #' \code{\link{getAreas}}, \code{\link{getLinks}}
 #' 
 #' @export
-readInputThermal <- function(clusters = NULL, thermalModulation = FALSE, thermalData = FALSE,
+readInputThermal <- function(areas = "all",
+                             clusters,
+                             thermalAvailabilities = TRUE,
+                             thermalModulation = FALSE,
+                             thermalData = FALSE,
                              opts = simOptions(),
                              timeStep = c("hourly", "daily", "weekly", "monthly", "annual"),
-                             simplify = TRUE, parallel = FALSE,
+                             simplify = TRUE,
+                             parallel = FALSE,
                              showProgress = TRUE) {
 
+  if(!any(thermalAvailabilities, thermalModulation, thermalData)){
+    stop("At least one type of data should be selected")
+  }
+
   timeStep <- match.arg(timeStep)
+  areas <- tolower(unique(areas))
+  clusters <- tolower(unique(clusters))
 
   # Can the importation be parallelized ?
   if (parallel) {
     if(!requireNamespace("foreach")) stop("Parallelized importation impossible. Please install the 'foreach' package and a parallel backend provider like 'doParallel'.")
     if (!foreach::getDoParRegistered()) stop("Parallelized importation impossible. Please register a parallel backend, for instance with function 'registerDoParallel'")
   }
 
-  allAreasClusters <- readClusterDesc(opts = opts)[area %in% opts$areasWithClusters, c("area", "cluster")]
-  allClusters <- unique(allAreasClusters$cluster)
-  # Manage special value "all"
-  if(identical(clusters, "all")) clusters <- allClusters
-
-  if (length(setdiff(tolower(clusters), tolower(allClusters))) > 0){
-    cat(c("the following clusters are not available : ",setdiff(tolower(clusters), tolower(allClusters))))
-    stop("Some clusters are not available in the areas specified")
+  allAreasClusters <- readClusterDesc(opts = opts)[, c("area", "cluster")]
+
+  #To compare with area and cluster selected
+  allAreasClusters$lower_area <- tolower(allAreasClusters$area)
+  allAreasClusters$lower_cluster <- tolower(allAreasClusters$cluster)
+
+  if (identical(areas, "all")) {
+    areas <- allAreasClusters$area
+  }else{
+    # Check for unavailable areas
+    diff_areas <- setdiff(areas, allAreasClusters$lower_area)
+    if (length(diff_areas) > 0) {
+      stop(paste0("the following areas are not available:", diff_areas))
+    }
+  }
+  # All areas selected with corresponding clusters
+  allAreasClusters_filtered_area <- allAreasClusters[area %in% areas]
+
+  if (identical(clusters, "all")) {
+    clusters <- allAreasClusters_filtered_area$cluster
+  }else{
+    # Check for unavailable clusters
+    diff_clusters <- setdiff(clusters, allAreasClusters_filtered_area$lower_cluster)
+    if (length(diff_clusters) > 0) {
+      stop(paste0("the following clusters are not available:", diff_clusters))
+    }
   }
+  # Couple areas/clusters of interest.
+  allAreasClusters_filtered <- allAreasClusters_filtered_area[cluster %in% clusters]
+
+  # To loop
+  clusters <- unique(allAreasClusters_filtered$cluster)
 
-  ind_cluster <- which(tolower(allClusters) %in% tolower(clusters))
-  clusters <- unique(allClusters[ind_cluster])
   res <- list() # Object the function will return
 
-  thermalTS <- as.data.table(ldply(clusters, function(cl) {
+  # ThermalAvailabilities processing (/series)
+  if (thermalAvailabilities){
+    thermalTS <- as.data.table(ldply(clusters, function(cl) {
+      areas <- allAreasClusters_filtered[cluster == cl]$area
+      resCl <- ldply(areas, function(x){
+        filePattern <- sprintf("%s/%s/%%s/series.txt", "thermal/series", x)
+        mid <- .importInputTS(cl, timeStep, opts, filePattern, "ThermalAvailabilities",
+                              inputTimeStep = "hourly", type = "matrix")
+
+        if (is.null(mid)){
+          nb_rows_ts <- opts$timeIdMax
+          timeId_value <- seq(1,nb_rows_ts)
+          tsId_value <- replicate(nb_rows_ts,1)
+          ThermalAvailabilities_value <- replicate(nb_rows_ts,0)
+          mid <- data.table("timeId" = timeId_value, "tsId" = tsId_value, "ThermalAvailabilities" = ThermalAvailabilities_value)
+        }
+        mid$area <- x
+        mid$cluster <- cl
+        mid
+      })
+      resCl <- dcast(as.data.table(resCl), area + cluster + timeId ~ tsId, value.var = "ThermalAvailabilities")
+    }))
 
-    area <- unique(allAreasClusters[cluster == cl]$area)
-    if (length(area) > 1) warning(cl," is in more than one area")
-    resCl <- ldply(area, function(x){
-      filePattern <- sprintf("%s/%s/%%s/series.txt", "thermal/series", x)
-      mid <- .importInputTS(cl, timeStep, opts, filePattern, "ThermalAvailabilities",
-                            inputTimeStep = "hourly", type = "matrix")
-      if (is.null(mid)) return (data.table())
-      mid$area <- x
-      mid$cluster <- cl
-      mid
-    })
+    tsCols <- setdiff(colnames(thermalTS), c("area", "cluster", "timeId"))
+    setnames(thermalTS, tsCols, paste0("ts",tsCols))
+    setcolorder(thermalTS, c("area", "cluster", "timeId", setdiff(names(thermalTS), c("area", "cluster", "timeId"))))
 
-    resCl <- dcast(as.data.table(resCl), area + cluster + timeId ~ tsId, value.var = "ThermalAvailabilities")
-  }))
-
-  tsCols <- setdiff(colnames(thermalTS), c("area", "cluster", "timeId"))
-  setnames(thermalTS, tsCols, paste0("ts",tsCols))
-  setcolorder(thermalTS, c("area", "cluster", "timeId", setdiff(names(thermalTS), c("area", "cluster", "timeId"))))
-
-  if (nrow(thermalTS) > 0) res$thermalAvailabilities <- thermalTS
+    if (nrow(thermalTS) > 0) res$thermalAvailabilities <- thermalTS
+  }
 
-  # thermalModulation processing
+  # thermalModulation processing (/prepro/.../.../modulation.txt)
   if (thermalModulation){
-    areas <- unique(allAreasClusters[cluster %in% clusters]$area)
     thermalMod <- as.data.table(ldply(areas, .importThermalModulation, opts = opts, timeStep = timeStep))
     thermalMod <- thermalMod[cluster %in% clusters]
     setcolorder(thermalMod, c("area", "cluster", "timeId", setdiff(names(thermalMod), c("area", "cluster", "timeId"))))
 
     if (nrow(thermalMod) > 0) res$thermalModulation <- thermalMod
   }
 
-  # thermalData processing
+  # thermalData processing (/prepro/.../.../data.txt)
   if (thermalData){
-    areas <- unique(allAreasClusters[cluster %in% clusters]$area)
     thermalDat <- as.data.table(ldply(areas, .importThermalData, opts = opts, timeStep = timeStep))
     thermalDat <- thermalDat[cluster %in% clusters]
     setcolorder(thermalDat, c("area", "cluster", "timeId", setdiff(names(thermalDat), c("area", "cluster", "timeId"))))
 
     if (nrow(thermalDat) > 0) res$thermalData <- thermalDat
   }
-    
+
   if (length(res) == 0) stop("At least one argument of readInputTS has to be defined.")
 
   # Class and attributes
   res <- .addClassAndAttributes(res, NULL, timeStep, opts, simplify)
   addDateTimeColumns(res)
+
 }
 
 
@@ -115,6 +155,7 @@ readInputThermal <- function(clusters = NULL, thermalModulation = FALSE, thermal
 #' project. But contrary to \code{\link{readAntares}}, it only reads time series
 #' stored in the input folder, so it can work in "input" mode. 
 #' 
+#' @param areas vector of RES areas names for which renewable time series must be read.
 #' @param clusters vector of RES clusters names for which renewable time series must be read.
 #' @inheritParams readAntares
 #' 
@@ -126,12 +167,17 @@ readInputThermal <- function(clusters = NULL, thermalModulation = FALSE, thermal
 #' \code{\link{getAreas}}, \code{\link{getLinks}}
 #' 
 #' @export
-readInputRES <- function(clusters = NULL, opts = simOptions(),
+readInputRES <- function(areas = "all",
+                         clusters,
+                         opts = simOptions(),
                          timeStep = c("hourly", "daily", "weekly", "monthly", "annual"),
-                         simplify = TRUE, parallel = FALSE,
+                         simplify = TRUE,
+                         parallel = FALSE,
                          showProgress = TRUE) {
 
   timeStep <- match.arg(timeStep)
+  areas <- tolower(unique(areas))
+  clusters <- tolower(unique(clusters))
 
   # Can the importation be parallelized ?
   if (parallel) {
@@ -140,28 +186,48 @@ readInputRES <- function(clusters = NULL, opts = simOptions(),
   }
 
   allAreasClusters <- readClusterResDesc(opts = opts)[area %in% opts$areasWithResClusters, c("area", "cluster")]
-  allClusters <- unique(allAreasClusters$cluster)
-  # Manage special value "all"
-  if(identical(clusters, "all")) clusters <- allClusters
-
-  if (length(setdiff(tolower(clusters), tolower(allClusters))) > 0){
-    cat(c("the following clusters are not available : ",setdiff(tolower(clusters), tolower(allClusters))))
-    stop("Some clusters are not available in the areas specified")
+  allAreasClusters$lower_area <- tolower(allAreasClusters$area)
+  allAreasClusters$lower_cluster <- tolower(allAreasClusters$cluster)
+
+  if (identical(areas, "all")) {
+    areas <- allAreasClusters$area
+  }else{
+    # Check for unavailable areas
+    diff_areas <- setdiff(areas, allAreasClusters$lower_area)
+    if (length(diff_areas) > 0) {
+      stop(paste0("the following areas are not available:", diff_areas))
+    }
+  }
+  allAreasClusters_filtered_area <- allAreasClusters[area %in% areas]
+
+  if (identical(clusters, "all")) {
+    clusters <- allAreasClusters_filtered_area$cluster
+  }else{
+    # Check for unavailable clusters
+    diff_clusters <- setdiff(clusters, allAreasClusters_filtered_area$lower_cluster)
+    if (length(diff_clusters) > 0) {
+      stop(paste0("the following clusters are not available:", diff_clusters))
+    }
   }
+  allAreasClusters_filtered <- allAreasClusters_filtered_area[cluster %in% clusters]
+  clusters <- unique(allAreasClusters_filtered$cluster)
 
-  ind_cluster <- which(tolower(allClusters) %in% tolower(clusters))
-  clusters <- unique(allClusters[ind_cluster])
   res <- list() # Object the function will return
 
   ResTS <- as.data.table(ldply(clusters, function(cl) {
 
-    area <- unique(allAreasClusters[cluster == cl]$area)
-    if (length(area) > 1) warning(cl," is in more than one area")
-    resCl <- ldply(area, function(x){
+    areas <- allAreasClusters_filtered[cluster == cl]$area
+    resCl <- ldply(areas, function(x){
       filePattern <- sprintf("%s/%s/%%s/series.txt", "renewables/series", x)
       mid <- .importInputTS(cl, timeStep, opts, filePattern, "production",
                             inputTimeStep = "hourly", type = "matrix")
-      if (is.null(mid)) return (data.table())
+      if (is.null(mid)){
+        nb_rows_ts <- opts$timeIdMax
+        timeId_value <- seq(1,nb_rows_ts)
+        tsId_value <- replicate(nb_rows_ts,1)
+        production_value <- replicate(nb_rows_ts,0)
+        mid <- data.table("timeId" = timeId_value, "tsId" = tsId_value, "production" = production_value)
+      }
       mid$area <- x
       mid$cluster <- cl
       mid