tests/testthat/test-removeVirtualAreas.R

In antaresRead: Import, Manipulate and Explore the Results of an 'Antares' Simulation

#Copyright © 2016 RTE Réseau de transport d’électricité

context("removeVirtualAreas function")

sapply(studyPathS, function(studyPath){
  
  opts <- setSimulationPath(studyPath)
  
  data <- suppressWarnings(readAntares(areas = "all", links = "all", districts = "all" , 
                                       showProgress = FALSE, linkCapacity = TRUE, select = "nostat"))
  
  vareas <- c("psp in-2", "psp out-2")
  
  dataCorrected <- suppressWarnings(removeVirtualAreas(data, 
                                                       storageFlexibility = vareas))
  
  test_that("removeVirtualAreas effectively removes virtual areas", {
    expect_false(any(dataCorrected$areas$area %in% vareas))
    expect_false(any(dataCorrected$links$link %in% getLinks(vareas)))
  })
  
  test_that("Balance is corrected for nodes connected to virtual nodes but not the others", {
    setkeyv(data$areas, .idCols(data$areas))
    expect_equal(data$areas[! area %in% c("hub", vareas)]$BALANCE, 
                 dataCorrected$areas[! area %in% c("hub", vareas)]$BALANCE)
    
    correction <- - data$links[link %in% getLinks(vareas), 
                               sum(`FLOW LIN.`), keyby = timeId]$V1
    
    expect_equal(dataCorrected$areas[area=="hub"]$BALANCE - data$areas[area=="hub"]$BALANCE,
                 correction)
    
  })
  
  test_that("A column has been created for each storage/flexibility area", {
    expect_true(all(vareas %in% names(dataCorrected$areas)))
    expect_equal(data$links[link=="hub - psp in-2"]$`FLOW LIN.`, 
                 - dataCorrected$areas[area == "hub"]$`psp in-2`)
  })
  
  test_that("RemoveVirtualAreas corrects column 'area' in the table 'clusters'", {
    data <- suppressWarnings(readAntares("all", "all", "all", showProgress = FALSE, mcYears = "all", linkCapacity = TRUE, select = "nostat"))
    dataCorrected <- removeVirtualAreas(data, storageFlexibility = vareas, production = "psp in-2")
    
    expect_false(any(dataCorrected$clusters$area == "psp in-2"))
  })
  
  test_that("RemoveVirtualAreas removes production areas", {
    dataCorrected <- suppressWarnings(removeVirtualAreas(x = data, 
                                                         production = "a_offshore", 
                                                         reassignCosts = TRUE))
    
    expect_equal(dataCorrected$areas[area == "a", `OP. COST`], 
                 data$areas[area == "a", `OP. COST`] + data$areas[area == "a_offshore", `OP. COST`])
    
    expect_false(is.null(dataCorrected$areas$WIND_virtual))
    expect_null(dataCorrected$areas$GAS_virtual)
  })
  
  test_that("RemoveVirtualAreas() corrects production columns if newCols = FALSE", {
    dataCorrected <- suppressWarnings(removeVirtualAreas(data, 
                                                         production = "a_offshore"))
    wind1 <- dataCorrected$areas[, WIND + WIND_virtual]
    dataCorrected2 <- suppressWarnings(removeVirtualAreas(data, 
                                                          production = "a_offshore", 
                                                          newCols = FALSE))
    wind2 <- dataCorrected2$areas$WIND
    expect_true(is.null(dataCorrected2$areas$WIND_virtual))
    expect_equal(wind1, wind2)
  })
  
  test_that("Hub management works", {
    dataCorrected <- suppressWarnings(removeVirtualAreas(x = data, 
                                                         storageFlexibility = c("hub", vareas)))
    
    dataCorrected2 <- suppressWarnings(removeVirtualAreas(data, 
                                                          storageFlexibility = c(vareas)))
    dataCorrected2 <- suppressWarnings(removeVirtualAreas(x = dataCorrected2, 
                                                          storageFlexibility = "hub"))
    
    expect_equal(dataCorrected$areas$BALANCE, dataCorrected2$areas$BALANCE)
    expect_equal(dataCorrected$areas$`OP. COST`, dataCorrected2$areas$`OP. COST`)
    
    expect_null(dataCorrected$areas$`psp in`)
  })
  
  test_that("RemoveVirtualAreas also works on non-synthesis results", {
    data <- suppressWarnings(readAntares("all", "all", showProgress = FALSE, mcYears = "all", linkCapacity = TRUE, select = "nostat"))
    dataCorrected <- removeVirtualAreas(data, storageFlexibility = vareas)
    
    correction <- - data$links[link %in% getLinks(vareas), 
                               sum(`FLOW LIN.`), keyby = .(mcYear, timeId)]$V1
    
    setkey(data$areas, mcYear, timeId)
    setkey(dataCorrected$areas, mcYear, timeId)
    expect_equal(dataCorrected$areas[area=="hub"]$BALANCE - data$areas[area=="hub"]$BALANCE,
                 correction)
  })
  
  test_that("reassignCosts works correctly", {
    dataCorrected <- suppressWarnings(removeVirtualAreas(x = data, 
                                                         storageFlexibility = c("psp out"),
                                                         reassignCosts = TRUE))
    # NOTE: this test fails if flows at some timeId are equal to 0 but costs are 
    # greater than 0
    
    
    # Check that total cost is preserved
    oldCosts <- data$areas[, .(cost = sum(as.numeric(`OV. COST`))), by = area]
    newCosts <- dataCorrected$areas[, .(cost = sum(as.numeric(`OV. COST`))), by = area]
    expect_equal(oldCosts[area %in% c("a", "b", "psp out"), sum(cost)],
                 newCosts[area %in% c("a", "b"), sum(cost)])
    
    # Check the repartition of the costs
    prop <- data$links[link == "b - psp out", abs(`FLOW LIN.`)] / 
      (data$links[link == "b - psp out", abs(`FLOW LIN.`)] + data$links[link == "a - psp out", abs(`FLOW LIN.`)])
    prop[is.na(prop)] <- 0
    
    expect_equal(
      data$areas[area == "a", `OV. COST`] + (1 - prop) * data$areas[area == "psp out", `OV. COST`],
      dataCorrected$areas[area == "a", `OV. COST`]
    )
  })
  
  test_that("removeVirtualAreas corrects variable PSP if newCols=FALSE", {
    psp1 <- dataCorrected$areas[, PSP + `psp in-2` + `psp out-2`]
    dataCorrected2 <- suppressWarnings(removeVirtualAreas(x = data, 
                                                          storageFlexibility = vareas, 
                                                          newCols = FALSE))
    psp2 <- dataCorrected2$areas$PSP
    
    expect_equal(psp1, psp2)
    expect_true(is.null(dataCorrected2$areas$`psp in-2`))
  })
  
  test_that("removeVirtualAreas removes virtual links, but keeps the data needed to compute margins", {
    expect_true(nrow(dataCorrected$links[link == "a - psp out-2"]) == 0)
    
    if(!is.null(dataCorrected$areas)){
      expect_false(is.null(dataCorrected$areas$storageCapacity))
      expect_false(is.null(dataCorrected$areas$pumpingCapacity))
      expect_gt(min(dataCorrected$areas$storageCapacity), -1)
      expect_gt(min(dataCorrected$areas$pumpingCapacity), -1)
    }
    
    if(!is.null(dataCorrected$districts)){
      expect_false(is.null(dataCorrected$districts$storageCapacity))
      expect_false(is.null(dataCorrected$districts$pumpingCapacity))
      expect_gt(min(dataCorrected$districts$storageCapacity), -1)
      expect_gt(min(dataCorrected$districts$pumpingCapacity), -1)
    }
    
  })
  
  test_that("removeVirtualAreas compute storage and pumping capacities", {
    dataCorrectedStep <- suppressWarnings(removeVirtualAreas(x = data, 
                                                             storageFlexibility = getAreas("psp")))
    
    expect_equal(unique(dataCorrectedStep$areas[area=="a", pumpingCapacity]), 3000)
    expect_equal(unique(dataCorrectedStep$areas[area=="a", storageCapacity]), 3000)
    
    expect_equal(unique(dataCorrectedStep$areas[area=="c", pumpingCapacity]), 0)
    expect_equal(unique(dataCorrectedStep$areas[area=="c", storageCapacity]), 0)
    
  })
  
  test_that("removeVirtualAreas move the cluster from virtual areas to real areas", {
    data <- suppressWarnings(readAntares(areas="all", links = "all", clusters = "all", districts = "all", showProgress = FALSE, mcYears = "all", linkCapacity = TRUE, select = "nostat"))
    
    #for this example we use psp virtual areas like virtual production areas
    dataCorrected <- removeVirtualAreas(data, production = getAreas(select = c("psp in-2", "psp out-2")))
    
    expect_equal(dim(dataCorrected$clusters[area %in% vareas,])[1], 0)
    
    expect_gt(dim(data$clusters[area %in% vareas,])[1], dim(dataCorrected$clusters[area %in% vareas,])[1])
    
    #cluster was in virtal areas
    clusterVirual<-unique(data$clusters[area %in% vareas, cluster])
    
    rarea<-unique(dataCorrected$clusters[cluster %in% clusterVirual, area])
    
    expect_equal(as.character(rarea), "hub")
  })
  
  test_that("bug #119, removeVirtualAreas correct district data", {
    
    for(i in c(1, 2, NULL)){
      data <- suppressWarnings(readAntares(areas = "all", 
                                           links = "all", 
                                           districts = "all" , 
                                           showProgress = FALSE,
                                           linkCapacity = TRUE, 
                                           select = "nostat",
                                           mcYears = i))
      
      vareas <- getAreas(select = c("psp", "hub"))
      dataCorrected <- removeVirtualAreas(data, 
                                          storageFlexibility = vareas,
                                          production = getAreas("off"))
      
      ### BEFORE : COMPARE BALANCE DISTRICT(AREAS) WITH LINC B-C
      oldDistrict <- c("a", "b", "a_offshore", "psp in", "psp out")
      data$areas[area %in% oldDistrict, SumDistrictBefore := sum(BALANCE), by = c("timeId")]
      
      resSup <- data$areas[area %in% oldDistrict[1], SumDistrictBefore] > data$links[link=="b - c", `FLOW LIN.`]+1
      resInf <- data$areas[area %in% oldDistrict[1], SumDistrictBefore] < data$links[link=="b - c", `FLOW LIN.`]-1
      
      expect_false(TRUE %in% c(resSup, resInf))
      
      ### AFTER : COMPARE BALANCE DISTRICT(AREAS) WITH LINC B-C
      newAreas <- c("a", "b")
      dataCorrected$areas[area %in% newAreas, SumDistrictAfter:= sum(BALANCE), by = c("timeId")]
      
      resSup <- dataCorrected$areas[area %in% newAreas[1], SumDistrictAfter] > data$links[link=="b - c", `FLOW LIN.`]+1
      resInf <- dataCorrected$areas[area %in% newAreas[1], SumDistrictAfter] < data$links[link=="b - c", `FLOW LIN.`]-1
      
      expect_false(TRUE %in% c(resSup, resInf))
      
      ## BEFORE AND AFTER : COMPARE BALANCE DISTRICT(AREAS)
      resSup <- dataCorrected$areas[area %in% newAreas[1], SumDistrictAfter] > data$areas[area %in% oldDistrict[1], SumDistrictBefore]+1
      resInf <- dataCorrected$areas[area %in% newAreas[1], SumDistrictAfter] < data$areas[area %in% oldDistrict[1], SumDistrictBefore]-1
      
      expect_false(TRUE %in% c(resSup, resInf))
      
      ## BEFORE : COMPARE BALANCE DISTRICT(DISTRICT) AND AREAS
      data$areas[area %in% newAreas, SumDistrictBefore:= sum(BALANCE), by = c("timeId")]
      resSup <- data$areas[area %in% newAreas, SumDistrictBefore] > data$districts[, BALANCE]+1
      resInf <- data$areas[area %in% newAreas, SumDistrictBefore] < data$districts[, BALANCE]-1
      expect_false(TRUE %in% c(resSup, resInf))    
      
      ## AFTER :  COMPARE BALANCE DISTRICT(DISTRICT) AND AREAS
      resSup <- dataCorrected$areas[area %in% newAreas[1], SumDistrictAfter]  > dataCorrected$districts[, BALANCE]+1
      resInf <- dataCorrected$areas[area %in% newAreas[1], SumDistrictAfter]  < dataCorrected$districts[, BALANCE]-1
      expect_false(TRUE %in% c(resSup, resInf))  
      
      ## BALANCE OF DISTRICT MUST CHANGE
      expect_error(expect_equal(dataCorrected$districts[, BALANCE],
                                data$districts[, BALANCE]))
      
    }
    colCostToCorrect <-  c("OV. COST", "OP. COST", "CO2 EMIS.", "NP COST")
    colMustChange <- c("PSP", "WIND", "BALANCE", colCostToCorrect)
    
    data <- suppressWarnings(readAntares(areas = "all", 
                                         links = "all", 
                                         districts = "all" , 
                                         showProgress = FALSE,
                                         linkCapacity = TRUE, 
                                         mcYears = 2))
    
    
    vareas <- getAreas(select = c("psp", "hub"))
    dataCorrected <- removeVirtualAreas(data, 
                                        storageFlexibility = vareas,
                                        production = getAreas("off"))
    
    for(i in colMustChange){
      varSumCal <- paste0("sum", i)
      dataCorrected$areas[area %in% newAreas, c(varSumCal):= sum(get(i)), by = c("timeId")]
      resSup <- dataCorrected$areas[area %in% newAreas[1], get(varSumCal)]  > dataCorrected$districts[, get(i)]+1
      resInf <- dataCorrected$areas[area %in% newAreas[1], get(varSumCal)]  < dataCorrected$districts[, get(i)]-1
      expect_false(TRUE %in% c(resSup, resInf),
                   paste0("pb with : ", i))  
    }
  })
  
  test_that("RemoveVirtualAreas corrects column 'BALANCE' if rowBal is TRUE", {
    data <- suppressWarnings(readAntares(areas = "all", 
                                         links = "all", 
                                         districts = "all", 
                                         showProgress = FALSE, 
                                         mcYears = "all", 
                                         linkCapacity = TRUE, 
                                         select = "nostat"))
    byArea <- c("area", "mcYear", "timeId")
    data$areas[, `ROW BAL.`:= as.integer(rnorm(1,mean = 2000, sd = 5)), 
               by = byArea]
    dataCorrected <- removeVirtualAreas(data, 
                                        storageFlexibility = c("psp in-2"),
                                        rowBal = TRUE)
    data$areas[, BALANCE := BALANCE -`ROW BAL.`, by = byArea]
    
    realAreas <- c("a", "b", "c")
    for(realA in realAreas){
      expect_true(all.equal(dataCorrected$areas[area %in% realA,
                                                BALANCE , 
                                                by = byArea],
                            data$areas[area %in% realA, 
                                       BALANCE, 
                                       by = byArea],
                            check.attributes = FALSE))
      
      expect_equal(unique(dataCorrected$areas[area %in% realA, 
                                              `ROW BAL.`]),
                   0)
    }
    
    expect_false("BALANCE.x" %in% names(dataCorrected$areas))
    expect_false("BALANCE.x" %in% names(dataCorrected$districts))
    expect_false("ROW BAL..x" %in% names(dataCorrected$areas))
    expect_false("ROW BAL..x" %in% names(dataCorrected$areas))
  })
  
  test_that("add pumpingCapacity and storageCapacity to district if storageFlex is not NULL", {
    mydata <- suppressWarnings({readAntares(areas = "all",
                                            districts ="all",
                                            links = "all",
                                            showProgress = FALSE,
                                            hydroStorageMaxPower = TRUE,
                                            linkCapacity = TRUE,
                                            mcYears = 1)})
    mydataCorrected <- removeVirtualAreas(mydata,
                                          storageFlexibility = c(getAreas("psp"),
                                                                 getAreas("hub")))
    
    expect_false(is.null(mydataCorrected$areas$pumpingCapacity))
    expect_false(is.null(mydataCorrected$areas$storageCapacity))
    expect_false(is.null(mydataCorrected$districts$pumpingCapacity))
    expect_false(is.null(mydataCorrected$districts$storageCapacity))
  })
  
  
  
  test_that("List for storageFlexibility", {
    
    # opts <- setSimulationPath(studyPathS[1])
    
    mydata <- suppressWarnings({
      readAntares(areas = "all",
                  districts ="all",
                  links = "all",
                  showProgress = FALSE,
                  hydroStorageMaxPower = TRUE,
                  linkCapacity = TRUE,
                  mcYears = 1)
    })
    
    # must be a named list
    expect_error({
      removeVirtualAreas(
        mydata,
        storageFlexibility = list(getAreas("psp"), getAreas("hub")), 
        newCols = FALSE,
        reassignCosts = FALSE, 
        rowBal = FALSE
      )
    })
    
    grid_test <- expand.grid(reassignCosts = c(TRUE, FALSE), rowBal = c(TRUE, FALSE))
    
    for(j in 1:nrow(grid_test)){
      
      data_rm_storage <- removeVirtualAreas(
        mydata,
        storageFlexibility = c(getAreas("psp"),
                               getAreas("hub")), 
        newCols = TRUE, 
        reassignCosts = grid_test$reassignCosts[j], 
        rowBal = grid_test$rowBal[j]
      )
      
      data_rm_storage_column <- removeVirtualAreas(
        mydata,
        storageFlexibility = list(psp = getAreas("psp"), hub = getAreas("hub")), 
        newCols = FALSE,
        reassignCosts = grid_test$reassignCosts[j], 
        rowBal = grid_test$rowBal[j]
      )
      
      psp_area <- getAreas("psp")[getAreas("psp") %in% names(data_rm_storage$areas)]
      
      ## Test identical for sum
      expect_true(identical(rowSums(data_rm_storage$areas[, .SD, .SDcols = psp_area]),
                            data_rm_storage_column$areas$psp))
      
      psp_districts <- getAreas("psp")[getAreas("psp") %in% names(data_rm_storage$districts)]
      expect_true(identical(rowSums(data_rm_storage$districts[, .SD, .SDcols = psp_districts]),
                            data_rm_storage_column$districts$psp))
      
      ## Test for hub
      expect_true(identical(data_rm_storage$areas$hub, data_rm_storage_column$areas$hub))
      
      ## Other columns
      common_columns_area <- intersect(colnames(data_rm_storage$areas), colnames(data_rm_storage_column$areas)) 
      expect_equal(
        data_rm_storage$areas[, common_columns_area, with = FALSE], 
        data_rm_storage_column$areas[, common_columns_area, with = FALSE]
      )
      
      common_columns_district <- intersect(colnames(data_rm_storage$districts), colnames(data_rm_storage_column$districts)) 
      expect_equal(
        data_rm_storage$districts[, common_columns_district, with = FALSE], 
        data_rm_storage_column$districts[, common_columns_district, with = FALSE]
      )
      
      expect_equal(
        data_rm_storage$links, 
        data_rm_storage_column$links
      )
      
      ## loop
      data_rm_storage_no_loop <- removeVirtualAreas(
        mydata,
        storageFlexibility = list(psp = psp_area), 
        newCols = FALSE,
        reassignCosts = grid_test$reassignCosts[j], 
        rowBal = grid_test$rowBal[j]
      )
      
      ## list non unique names
      ll <- lapply(psp_area, function(x) x)
      names(ll) <- rep("psp", length(ll))
      
      data_rm_storage_list_names <- removeVirtualAreas(
        mydata,
        storageFlexibility = ll, 
        newCols = FALSE,
        reassignCosts = grid_test$reassignCosts[j], 
        rowBal = grid_test$rowBal[j]
      )
      
      expect_true(identical(data_rm_storage_list_names, data_rm_storage_no_loop))

      ## Test walk exect
      data_rm_storage_loop <- mydata
      for(i in psp_area){
        data_rm_storage_loop <- removeVirtualAreas(
          data_rm_storage_loop,
          storageFlexibility = list(psp = i),
          newCols = FALSE,
          reassignCosts = grid_test$reassignCosts[j], 
          rowBal = grid_test$rowBal[j]
        )
      }
      
      expect_equal(attr(data_rm_storage_loop, "virtualNodes"), attr(data_rm_storage_no_loop, "virtualNodes"))
      
      expect_true(identical(data_rm_storage_loop$areas$psp, data_rm_storage_no_loop$areas$psp))
      
      expect_equal(
        data_rm_storage_no_loop$areas, data_rm_storage_loop$areas[, colnames(data_rm_storage_no_loop$areas), with = FALSE]
      )
      
      expect_equal(
        data_rm_storage_no_loop$links, data_rm_storage_loop$links[, colnames(data_rm_storage_no_loop$links), with = FALSE]
      )
      
      expect_equal(
        data_rm_storage_no_loop$districts, data_rm_storage_loop$districts[, colnames(data_rm_storage_no_loop$districts), with = FALSE]
      )
      
      ## Test On psps directly
      data_rm_storage <- removeVirtualAreas(
        mydata,
        storageFlexibility = c(getAreas("psp"),
                               getAreas("hub")), 
        newCols = FALSE,
        reassignCosts = grid_test$reassignCosts[j], 
        rowBal = grid_test$rowBal[j]
      )
      
      data_rm_storage_all <- removeVirtualAreas(
        mydata,
        storageFlexibility = list(PSP = c(getAreas("psp"),
                                          getAreas("hub"))),
        newCols = FALSE,
        reassignCosts = grid_test$reassignCosts[j], 
        rowBal = grid_test$rowBal[j]
      )
      
      expect_equal(attr(data_rm_storage, "virtualNodes"), attr(data_rm_storage_all, "virtualNodes"))
      
      expect_equal(
        data_rm_storage$areas, data_rm_storage_all$areas[, colnames(data_rm_storage$areas), with = FALSE]
      )
      
      expect_equal(
        data_rm_storage$links, data_rm_storage_all$links[, colnames(data_rm_storage$links), with = FALSE]
      )
      
      expect_equal(
        data_rm_storage$districts, data_rm_storage_all$districts[, colnames(data_rm_storage$districts), with = FALSE]
      )
      
    }
  })
  
})