Merge commit '62450dcd52655105636f2802f1225ef0ea90bdc3' of https://gi…

…thub.com/rte-antares-rpackage/antaresRead into getGeographicTrimming

NEWS.md

@@ -5,8 +5,11 @@
 NEW FEATURES:
 
 * New function `getGeographicTrimming()` returns filtering options for selected areas (links optional).
-* Existing function `getLinks()` now has a new argument **withTransmission**. if TRUE, return additional column with type of transmission capacities.
+* 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

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
@@ -360,10 +406,9 @@
              names(modulation), names)
 
 
-
     if (all(modulation$minGenModulation == 0)) 
       modulation[, minGenModulation := NA_real_]
-    
+
     modulation$area <- area
     modulation$cluster <- cl
     modulation <- modulation[opts$timeIdMin:opts$timeIdMax]

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)

tests/testthat/test-readInputThermal.R → tests/testthat/test-readInputClusters.R

@@ -23,5 +23,13 @@ sapply(studyPathS, function(studyPath){
       expect_equal(nrow(input$thermalModulation) %% (24 * 7 * nweeks), 0)
     })
 
+    test_that("Thermal data importation works", {
+      input <- readInputThermal(clusters = "peak_must_run_partial", thermalModulation = TRUE, showProgress = FALSE)
+      expect_is(input, "antaresDataList")
+      expect_is(input$thermalModulation, "antaresDataTable")
+      expect_gt(nrow(input$thermalModulation), 0)
+      expect_equal(nrow(input$thermalModulation) %% (24 * 7 * nweeks), 0)
+    })
+
   }
 })