#21 add function addConvergencePriceArea

rte-antares-rpackage · Nov 26, 2018 · f870507 · f870507
1 parent fafce19
commit f870507
Show file tree

Hide file tree

Showing 3 changed files with 179 additions and 0 deletions.
diff --git a/NEWS b/NEWS
@@ -7,6 +7,7 @@ NEW FEATURES:
 * New function correctBalance() corrects the BALANCE with 'ROW BAL' (#33).
 * New functions neighbours(), addNeighbours() and getAllNeighbours() to get neighbours (#21).
 * New functions addConvergencePriceSystem() computes the biggest system without congestion (#21).
+* New functions addConvergencePriceArea() computes the biggest system without congestion for each area (#21).
 
 Changes in version 0.16.0 (2018-09-28)
 

diff --git a/R/addConvergencePriceArea.R b/R/addConvergencePriceArea.R
@@ -0,0 +1,85 @@
+#' addConvergencePriceArea
+#'
+#' This function computes priceConvergenceArea, priceConvergenceArea represent
+#' the biggest system without congestion for one area.
+#'
+#' @param antaresData Object of class \code{antaresData} created with function
+#'   \code{\link[antaresRead]{readAntares}}. antaresData must contains areas and
+#'   links details hourly data with linkCapacity.
+#' @export
+addConvergencePriceArea <- function(antaresData = NULL){
+  .check_x(antaresData)
+  if((!is(antaresData, "antaresDataList")) | !("areas" %in% names(antaresData))){
+    stop("Import areas data. antaresData must be an antaresDataList.")
+  }
+  if(attr(antaresData, "synthesis") | attr(antaresData, "timeStep") != "hourly"){
+    stop("Import hourly details data")
+  }
+
+  if(is.null(antaresData$areas$neighbours)){
+      addNeighbours(antaresData)
+  }
+  if(is.null(antaresData$areas$priceConvergenceSystem)){
+    addConvergencePriceSystem(antaresData)
+  }
+  #priceConvergenceArea = area
+  antaresData$areas[, priceConvergenceAreaN := as.character(area),
+                    by=.(area, mcYear, timeId)]
+  antaresData$areas[, ':=' (neighboursN = neighbours)]
+
+  #we must get the virtual areas
+  resAttr <- attributes(antaresData)
+  virtualAreas <- resAttr$virtualNodes$storageFlexibility
+  virtualAreas <- c(virtualAreas, resAttr$virtualNodes$production)
+
+  #priceConvergenceArea = area + neighbours in priceConvergenceSystem if area in priceConvergenceSystem
+  #init
+  antaresData$areas[, priceConvergenceAreaN1 := priceConvergenceAreaN]
+  indexToEdit <- antaresData$areas[stringi::stri_detect_fixed(pattern = area,
+                                                     str = priceConvergenceSystem),
+                                   which=TRUE]
+
+  antaresData$areas[indexToEdit, ':=' (priceConvergenceAreaN1 = paste(sort(unique(c(intersect(strsplit(priceConvergenceSystem, split = " ")[[1]],
+                                                                                              strsplit(neighboursN, split = " ")[[1]]),
+                                                                                    strsplit(priceConvergenceAreaN, split = " ")[[1]]))),
+                                                                      collapse = " ")),
+                    by = .(priceConvergenceSystem, priceConvergenceAreaN)]
+
+  #for all index where priceConvergenceArea != priceConvergenceSystem
+  #then test if neighbours of neighbours are in priceConvergenceSystem
+  #init system
+  antaresData$areas[, ':=' (neighboursN = neighbours)]
+  antaresData$areas[, ':=' (neighboursN1 = neighbours)]
+
+  #antaresData$areas[, priceConvergenceAreaN1 := priceConvergenceAreaN]
+  indexWhereSomethingChange <- c(1, 2)
+  i <- 0
+  while (length(indexWhereSomethingChange) > 0) {
+    indexWhereSomethingChange <- antaresData$areas[priceConvergenceAreaN!=priceConvergenceAreaN1, which=TRUE]
+
+    # iterate N1 := N
+    antaresData$areas[indexWhereSomethingChange, priceConvergenceAreaN := priceConvergenceAreaN1]
+    antaresData$areas[indexWhereSomethingChange, ':=' (neighboursN = neighboursN1)]
+
+    #compute N1
+    antaresData$areas[indexWhereSomethingChange, ':=' (neighboursN1 = paste(getAllNeighbours(neighboursN,
+                                                                                             virtualAreas = virtualAreas),
+                                                                            collapse = " ")),
+                      by = .(neighboursN)]
+    antaresData$areas[indexWhereSomethingChange, ':=' (priceConvergenceAreaN1 = paste(sort(unique(c(intersect(strsplit(priceConvergenceSystem, split = " ")[[1]],
+                                                                                                              strsplit(neighboursN1, split = " ")[[1]]),
+                                                                                                    strsplit(priceConvergenceAreaN, split = " ")[[1]]))),
+                                                                                      collapse = " ")),
+                      by = .(priceConvergenceSystem, priceConvergenceAreaN)]
+
+    i <- i +1
+  }
+
+  antaresData$areas[, priceConvergenceArea := priceConvergenceAreaN1]
+
+  antaresData$areas[, c("priceConvergenceAreaN",
+                        "priceConvergenceAreaN1",
+                        "neighboursN",
+                        "neighboursN1") := NULL]
+  invisible(antaresData)
+}
diff --git a/tests/testthat/test-addConvergencePriceArea.R b/tests/testthat/test-addConvergencePriceArea.R
@@ -0,0 +1,93 @@
+context("Function addConvergencePriceArea")
+
+opts <- setSimulationPath(studyPath)
+
+test_that("addConvergencePriceArea works with an antaresDataList.
+          antaresData must contains areas and links details data with linkCapacity.", {
+  myData <- readAntares(clusters = "all", showProgress = FALSE)
+  expect_error(addConvergencePriceArea(myData))
+  myData <- readAntares(areas = "all", showProgress = FALSE)
+  expect_error(addConvergencePriceArea(myData))
+  myData <- readAntares(areas = "all",
+                        links = "all",
+                        showProgress = FALSE)
+  expect_error(addConvergencePriceArea(myData))
+  myData <- readAntares(areas = "all",
+                        links = "all",
+                        showProgress = FALSE,
+                        mcYears = "all")
+  expect_error(addConvergencePriceArea(myData))
+  myData <- suppressWarnings(readAntares(areas = "all",
+                                         links = "all",
+                                         showProgress = FALSE,
+                                         linkCapacity = TRUE,
+                                         mcYears = "all"))
+  addConvergencePriceArea(myData)
+})
+
+test_that("addConvergencePriceArea add a column priceConvergenceArea
+          For each time, priceConvergenceArea represent the system without congestion
+          for one area", {
+            myData <- suppressWarnings(readAntares(areas = "all",
+                                                   links = "all",
+                                                   showProgress = FALSE,
+                                                   linkCapacity = TRUE,
+                                                   mcYears = "all"))
+            myDataRV <- removeVirtualAreas(x = myData,
+                                           storageFlexibility = getAreas(c("psp", "hub")),
+                                           production = getAreas("off"))
+            addConvergencePriceArea(myDataRV)
+
+            expect_true("priceConvergenceArea" %in% names(myDataRV$areas))
+            expect_true(is.character(class(myDataRV$areas$priceConvergenceArea)))
+
+            #when there is priceConvergenceArea = "a b c" then we have the same prices
+            indexAll <- myDataRV$areas[priceConvergenceArea=="a b c", which = TRUE]
+            myDataPrice <- myDataRV$areas[indexAll,
+                                          .(area, mcYear, timeId, `MRG. PRICE`)]
+            IdCols <- getIdCols(myDataPrice)
+            #without mcYear
+            IdColsWA <- IdCols[IdCols!="area"]
+            myFormula <- sprintf("%s ~ area", paste(IdColsWA, collapse = "+"))
+            diffPrice <- data.table::dcast(data = myDataPrice,
+                         as.formula(myFormula),
+                         value.var = "MRG. PRICE")
+            diffPrice[, ':=' (diffBA = abs(b - a),
+                              diffCB = abs(c - b)) ]
+
+            maxHurdl <- max(myDataRV$links[link=="b - c", hurdlesCostDirect])
+            maxHurdlInd <- max(myDataRV$links[link=="b - c", hurdlesCostIndirect])
+            maxDiffNormal <- max(maxHurdl, maxHurdlInd)
+            #diff price not bigger than hurdle cost
+            expect_true(max(diffPrice$diffBA) <= maxDiffNormal)
+            expect_true(max(diffPrice$diffCB) <= maxDiffNormal)
+
+            # when PriceAreaSystem == "a" then big difference between price
+            indexAB <- myDataRV$areas[priceConvergenceArea=="a b", which = TRUE]
+            myDataPrice <- myDataRV$areas[indexAB,
+                                          .(area, mcYear, timeId, `MRG. PRICE`)]
+
+            diffPrice <- data.table::dcast(data = myDataPrice,
+                               as.formula(myFormula),
+                               value.var = "MRG. PRICE")
+            diffPrice[, ':=' (diffBA = abs(b - a))]
+            #diff price not bigger than hurdle cost for A / B but not for C / B
+            expect_true(max(diffPrice$diffBA) <= maxDiffNormal)
+
+            #when priceConvergenceArea = "a - b" the area is a or b
+            expect_false("c" %in% unique(myDataRV$areas[priceConvergenceArea=="a b",
+                                           (area)]))
+            expect_true("a" %in% unique(myDataRV$areas[priceConvergenceArea=="a b",
+                                           (area)]))
+            expect_true("b" %in% unique(myDataRV$areas[priceConvergenceArea=="a b",
+                                                       (area)]))
+
+            #when priceConvergenceArea = "a" the area is a
+            expect_true("a" %in% unique(myDataRV$areas[priceConvergenceArea=="a",
+                                                        (area)]))
+            expect_false("b" %in% unique(myDataRV$areas[priceConvergenceArea=="a",
+                                                       (area)]))
+            expect_false("c" %in% unique(myDataRV$areas[priceConvergenceArea=="a",
+                                                       (area)]))
+
+})