Ant843 bis

R/importOutput.R

@@ -40,6 +40,7 @@
   colname
 }
 
+
 #' .importOutput
 #'
 #' Private function used to import the results of a simulation. The type of result
@@ -277,6 +278,55 @@
   )
 }
 
+
+#' .get_value_columns_details_file
+#'
+#' Private function used to get the column names for the details-<timeStep>.txt or details-res-<timestep>.txt.
+#' Used in .importOutputForClusters() and importOutputForResClusters() 
+#'
+#' @return
+#' a vector
+#'
+#' @noRd
+#'
+.get_value_columns_details_file <- function(opts, type) {
+
+  ## details part
+  if(type == "details") {
+    # Order is important. There is a correspondance between elements.
+    all_thematic_variables <- c("DTG by plant", "NP Cost by plant", "NODU by plant")
+    all_output_colnames <- c("production", "NP Cost", "NODU")
+    if (opts$antaresVersion >= 830){
+      all_thematic_variables <- c(all_thematic_variables, "Profit by plant")
+      all_output_colnames <- c(all_output_colnames, "profit")
+    }
+    colNames <- all_output_colnames
+    if ("variables selection" %in% names(opts$parameters)) {
+      selection_type <- unique(names(opts$parameters$`variables selection`))
+      selected_variables <- unlist(opts$parameters$`variables selection`, use.names = FALSE)
+      # Index of the variables found in the section "variables selection"
+      idx_vars <- which(all_thematic_variables %in% selected_variables)
+      if (length(idx_vars) > 0) {
+        if (selection_type == "select_var -") {
+          # vars to remove
+          colNames <- colNames[-idx_vars]
+        } else if (selection_type == "select_var +") {
+          # vars to keep
+          colNames <- colNames[idx_vars]
+        }
+      }
+    }  
+  }
+
+  ## details-res part
+  if(type == "details-res") {
+    colNames <- c("production")
+  }  
+
+  return(colNames)
+}
+
+
 #' .importOutputForClusters
 #'
 #' Private function used to import the output for the thermal clusters of one area
@@ -295,6 +345,7 @@
   # To improve greatly the performance we use our knowledge of the position of 
   # the columns instead of using more general functions like dcast.
   reshapeFun <- function(x) {
+
     # Get cluster names
     n <- names(x)
     idx <- ! n %in% pkgEnv$idVars
@@ -304,28 +355,19 @@
     idVarsId <- which(!idx)
     idVarsNames <- n[idVarsId]
 
-    # Get final value columns
-    if (sum(idx) / length(clusterNames) == 4) {
-      colNames <- c("production", "NP Cost", "NODU", "profit")
-    } else if (sum(idx) / length(clusterNames) == 3) {
-      colNames <- c("production", "NP Cost", "NODU")
-    } else if (sum(idx) / length(clusterNames) == 2) {
-      colNames <- c("production", "NP Cost")
-    } else {
-      colNames <- c("production")
-    }
+    # Column names of the output table
+    colNames <- .get_value_columns_details_file(opts, "details")    
 
     # Loop over clusters
     nclusters <- length(clusterNames)
-    ncols <- length(colNames)
 
     res <- llply(1:nclusters, function(i) {
-      dt <- x[, c(nclusters * 0:(ncols - 1) + i, idVarsId), with = FALSE]
+      dt <- x[, c(nclusters * 0:(length(colNames) - 1) + i, idVarsId), with = FALSE]
       setnames(dt, c(colNames, idVarsNames))
       dt[, cluster := as.factor(clusterNames[i])]
       dt
     })
-    
+
     rbindlist(res)
   }
 
@@ -457,6 +499,7 @@
   # To improve greatly the performance we use our knowledge of the position of 
   # the columns instead of using more general functions like dcast.
   reshapeFun <- function(x) {
+
     # Get cluster names
     n <- names(x)
     idx <- ! n %in% pkgEnv$idVars
@@ -466,23 +509,14 @@
     idVarsId <- which(!idx)
     idVarsNames <- n[idVarsId]
 
-    # Get final value columns
-    # Get final value columns
-    # colNames <- c("resProduction")
-    if (sum(idx) / length(clusterNames) == 3) {
-      colNames <- c("production", "NP Cost", "NODU")
-    } else if (sum(idx) / length(clusterNames) == 2) {
-      colNames <- c("production", "NP Cost")
-    } else {
-      colNames <- c("production")
-    }
+    # Column names of the output table
+    colNames <- .get_value_columns_details_file(opts, "details-res")  
 
     # Loop over clusters
     nclusters <- length(clusterNames)
-    ncols <- length(colNames)
 
     res <- llply(1:nclusters, function(i) {
-      dt <- x[, c(nclusters * 0:(ncols - 1) + i, idVarsId), with = FALSE]
+      dt <- x[, c(nclusters * 0:(length(colNames) - 1) + i, idVarsId), with = FALSE]
       setnames(dt, c(colNames, idVarsNames))
       dt[, cluster := as.factor(clusterNames[i])]
       dt

R/zzz.R

@@ -107,6 +107,12 @@ utils::globalVariables(
     "MRG. PRICE", "H. LEV", "V2", "V1")
 )
 
+# Correspondance between output column name and data table column name
+pkgEnv$output_correspondance <- read.table(system.file("format_output/referentiel_output_name_column.csv", 
+                                        package = "antaresRead"),
+                            sep = ";", 
+                            header = TRUE)
+
 #-----------------------------  HDF5 ------------------------------------#
 
 

inst/format_output/referentiel_output_name_column.csv

@@ -0,0 +1,6 @@
+ANTARES_OUTPUT_TYPE;ANTARES_OUTPUT_FILE_COLUMN_NAME;ANTARES_OUTPUT_R_VARIABLE;ANTARES_OUTPUT_ORDINAL_POSITION
+clusters;MWh;production;1
+clusters;NP Cost - Euro;NP Cost;2
+clusters;NODU;NODU;3
+clusters;Profit - Euro;profit;4
+res_clusters;MWh;production;1

tests/testthat/test-readAntares.R

@@ -28,6 +28,16 @@ sapply(studyPathS, function(studyPath){
     expect_equal(nrow(clusters), 24 * 7 * nweeks * nrow(readClusterDesc()))
   })
 
+  test_that("Clusters importation column names are ok", {
+    clusters <- readAntares(clusters = opts$areasWithClusters,
+                            timeStep = "hourly",
+                            mcYears = "all",
+                            opts = opts,
+                            showProgress = FALSE)
+    expect_is(clusters, "data.table")
+    expect_equal(setdiff(colnames(clusters),pkgEnv$idVars), c("production", "NP Cost", "NODU"))
+  })
+
   test_that("importation of different objects works", {
     out <- readAntares(areas = opts$areaList, links=opts$linkList,
                        clusters=opts$areasWithClusters, showProgress= FALSE, timeStep = "annual")