geographic trimming + updated thermal functions (#195)

* added thermalData option in readInputThermal * added readInputRES() * geographic trimming function * updated doc * updated website --------- Co-authored-by: MANSOURI Assil Ext <[email protected]>
rte-antares-rpackage · Feb 14, 2023 · dfa7c5f · dfa7c5f
1 parent 2cdbac1
commit dfa7c5f
Show file tree

Hide file tree

Showing 19 changed files with 587 additions and 23 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -37,6 +37,7 @@ export(extractDataList)
 export(getAlias)
 export(getAreas)
 export(getDistricts)
+export(getGeographicTrimming)
 export(getIdCols)
 export(getLinks)
 export(hvdcModification)
@@ -52,6 +53,7 @@ export(readClusterResDesc)
 export(readIni)
 export(readIniAPI)
 export(readIniFile)
+export(readInputRES)
 export(readInputTS)
 export(readInputThermal)
 export(readLayout)

diff --git a/NEWS.md b/NEWS.md
@@ -4,10 +4,12 @@
 
 NEW FEATURES:
 
-Function `getLinks()` now has a new argument **withTransmission**. if TRUE, return additional
-column with type of transmission capacities
+* New function `getGeographicTrimming()` returns filtering options for selected areas (links optional).
+* New function added : `readInputRes()` for reading renewable clusters input data 
 
 
+* Existing function `getLinks()` now has a new argument **withTransmission**. if TRUE, return additional column with type of transmission capacities.
+* Existing function `readInputThermal()` : added new argument for thermalData
 
 
 # antaresRead 2.4.1
@@ -38,11 +40,11 @@ Major upgrade to `aggregateResult()` and `parAggregateMCall()` :
 
 NEW FEATURES:
 
-added "profit by cluster" when reading cluster data
+added "profit by cluster" when reading cluster data.
 
 BUGFIXES:
 
-Fix for 404 error when some output is missing in API mode(#188)
+Fix for 404 error when some output is missing in API mode(#188).
 
 
 

diff --git a/R/getGeographicTrimming.R b/R/getGeographicTrimming.R
@@ -0,0 +1,49 @@
+#Copyright © 2016 RTE Réseau de transport d’électricité
+
+#' Read geographic trimming (filtering) options
+#'
+#' @param areas Character. vector of areas
+#' @param links Logical. if TRUE, return filtering options for all links starting from selected areas
+#' @param opts List. simulation options
+#'
+#' @return list of filtering options for areas and links
+#'
+#' @export
+getGeographicTrimming <- function(areas = NULL, links = TRUE, opts = simOptions()){
+  if (is.null(areas)) stop("You need to select at least one area.")
+  if (areas == "all") areas <- opts$areaList
+
+  res <- list()
+
+  if(!is.null(areas)){
+    areaData <- lapply(as.list(areas), .readPropertiesFunction, opts2 = opts, type = "areas")
+    names(areaData) <- areas
+    res$areas <- areaData
+  }
+
+  if (links){
+    linkData <- lapply(as.list(areas), .readPropertiesFunction, opts2 = opts, type = "links")
+    names(linkData) <- areas
+    linkData <- unlist(linkData, recursive = F)
+    names(linkData) <- gsub("\\.", " - ", names(linkData))
+    res$links <- linkData
+  }
+
+  res
+}
+
+.readPropertiesFunction <- function(x, opts2, type){
+  if (type == "areas"){
+    if (opts2$typeLoad != "api"){
+      inputPath <- file.path(opts2$inputPath, "areas", x, "optimization.ini")
+      readIniFile(inputPath)$filtering
+    } else readIni(file.path("input", "areas", x, "optimization"))$filtering
+
+  } else if (type == "links"){
+    if (opts2$typeLoad != "api"){
+      inputPath <- file.path(opts2$inputPath, "links", x, "properties.ini")
+      lapply(as.list(readIniFile(inputPath)), function(x){x[grep("filter", names(x))]})
+    } else lapply(as.list(readIni(file.path("input", "links", x, "properties"))), function(x){x[grep("filter", names(x))]})
+  }
+} 
+
diff --git a/R/importInput.R b/R/importInput.R
@@ -324,6 +324,52 @@
 
 }
 
+
+
+
+.importThermalData <- function(area, opts, timeStep, unselect = NULL, ...) {
+  if (!area %in% opts$areasWithClusters) return(NULL)
+  unselect <- unselect$areas
+  path <- file.path(opts$inputPath, "thermal/prepro", area)
+
+  if(!"api" %in% opts$typeLoad){
+    clusters <- list.files(path)
+  } else {
+    clusters <- names(read_secure_json(path, token = opts$token, timeout = opts$timeout, config = opts$httr_config))
+  }
+
+  beginName <- c("FODuration", "PODuration", "FORate", "PORate", "NPOMin", "NPOMax")
+  if(!is.null(unselect)){
+    colSelect <- which(!beginName%in%unselect)
+    names <- beginName[colSelect]
+  }else{
+    colSelect <- NULL
+    names <- beginName
+  }
+
+
+  res <- ldply(clusters, function(cl) {
+    if(is.null(colSelect))
+    {
+      # data <- fread(file.path(path, cl, "data.txt"), colClasses = "numeric")
+      data <- fread_antares(opts = opts, file = file.path(path, cl, "data.txt"), colClasses = "numeric")
+    }else{
+      # data <- fread(file.path(path, cl, "data.txt"), select = colSelect, colClasses = "numeric")
+      data <- fread_antares(opts = opts, file = file.path(path, cl, "data.txt"), select = colSelect, colClasses = "numeric")
+    }
+
+    setnames(data, 
+             names(data), names)
+
+    data$area <- area
+    data$cluster <- cl
+    data <- data[opts$timeIdMin:opts$timeIdMax]
+    data$timeId <- opts$timeIdMin:opts$timeIdMax
+
+    changeTimeStep(data, timeStep, "daily", fun = "mean")
+  })
+}
+
 .importThermalModulation <- function(area, opts, timeStep, unselect = NULL, ...) {
   if (!area %in% opts$areasWithClusters) return(NULL)
   unselect <- unselect$areas
@@ -359,11 +405,8 @@
     setnames(modulation, 
              names(modulation), names)
 
-
-
     if (all(modulation$minGenModulation == 0)) 
       modulation[, minGenModulation := NA_real_]
-
     modulation$area <- area
     modulation$cluster <- cl
     modulation <- modulation[opts$timeIdMin:opts$timeIdMax]

diff --git a/R/readInputThermal.R → R/readInputClusters.R b/R/readInputThermal.R → R/readInputClusters.R
@@ -9,11 +9,12 @@
 #' 
 #' @param clusters vector of clusters names for which thermal time series must be read.
 #' @param thermalModulation if TRUE, return thermalModulation data
+#' @param thermalData if TRUE, return thermalData from prepro
 #' @inheritParams readAntares
 #' 
 #' @return 
-#' If thermalModulation is TRUE, an object of class "antaresDataList" is returned. It is a list of
-#' data.tables for thermalAvailabilities and thermalModulation
+#' If thermalModulation or thermalData is TRUE, an object of class "antaresDataList" is returned. It is a list of
+#' data.tables for selected input
 #' 
 #' Else the result is a data.table with class "antaresDataTable".
 #' 
@@ -26,7 +27,7 @@
 #' \code{\link{getAreas}}, \code{\link{getLinks}}
 #' 
 #' @export
-readInputThermal <- function(clusters = NULL, thermalModulation = FALSE, 
+readInputThermal <- function(clusters = NULL, thermalModulation = FALSE, thermalData = FALSE,
                              opts = simOptions(),
                              timeStep = c("hourly", "daily", "weekly", "monthly", "annual"),
                              simplify = TRUE, parallel = FALSE,
@@ -86,9 +87,97 @@ readInputThermal <- function(clusters = NULL, thermalModulation = FALSE,
 
     if (nrow(thermalMod) > 0) res$thermalModulation <- thermalMod
   }
+
+  # thermalData processing
+  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)
+}
+
+
+
+
+#' Read Input RES time series
+#' 
+#' @description 
+#' \code{readInputRes} is a function that reads renewable time series from an antares 
+#' 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 clusters vector of RES clusters names for which renewable time series must be read.
+#' @inheritParams readAntares
+#' 
+#' @return 
+#' data.table with class "antaresDataTable".
+#' 
+#' @seealso 
+#' \code{\link{setSimulationPath}}, \code{\link{readAntares}}, 
+#' \code{\link{getAreas}}, \code{\link{getLinks}}
+#' 
+#' @export
+readInputRES <- function(clusters = NULL, opts = simOptions(),
+                         timeStep = c("hourly", "daily", "weekly", "monthly", "annual"),
+                         simplify = TRUE, parallel = FALSE,
+                         showProgress = TRUE) {
+
+  timeStep <- match.arg(timeStep)
+
+  # 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 <- readClusterResDesc()[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")
+  }
+
+  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){
+      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())
+      mid$area <- x
+      mid$cluster <- cl
+      mid
+    })
+
+    resCl <- dcast(as.data.table(resCl), area + cluster + timeId ~ tsId, value.var = "production")
+  }))
+
+  tsCols <- setdiff(colnames(ResTS), c("area", "cluster", "timeId"))
+  setnames(ResTS, tsCols, paste0("ts",tsCols))
+  setcolorder(ResTS, c("area", "cluster", "timeId", setdiff(names(ResTS), c("area", "cluster", "timeId"))))
+
+  if (nrow(ResTS) > 0) res$ResProduction <- ResTS
+
+  if (length(res) == 0) stop("At least one argument of readInputRes has to be defined.")
+
   # Class and attributes
   res <- .addClassAndAttributes(res, NULL, timeStep, opts, simplify)
   addDateTimeColumns(res)

diff --git a/docs/articles/antaresH5.html b/docs/articles/antaresH5.html
diff --git a/docs/articles/antaresRead.html b/docs/articles/antaresRead.html
diff --git a/docs/news/index.html b/docs/news/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -4,5 +4,5 @@ pkgdown_sha: ~
 articles:
   antaresH5: antaresH5.html
   antaresRead: antaresRead.html
-last_built: 2023-02-10T15:06Z
+last_built: 2023-02-14T09:00Z