From 1a53c92a430a8821706847cf5a87adaaf69fd4a3 Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 25 Oct 2018 12:03:38 +0200 Subject: [PATCH 01/26] #33 add correctBalance() : work with opts, antaresDataList and antaresData --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/correctBalance.R | 154 +++++++++++++ R/h5_processing.R | 12 +- R/zzz.R | 54 +++++ man/addProcessingH5.Rd | 9 +- man/correctBalance.Rd | 34 +++ tests/testthat/test-correctBalance.R | 316 +++++++++++++++++++++++++++ 8 files changed, 577 insertions(+), 5 deletions(-) create mode 100644 R/correctBalance.R create mode 100644 man/correctBalance.Rd create mode 100644 tests/testthat/test-correctBalance.R diff --git a/DESCRIPTION b/DESCRIPTION index 5c2a5ac..8e29e5e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: antaresProcessing Type: Package Title: 'Antares' Results Processing -Version: 0.16.0 +Version: 0.16.0.901 Date: 2018-09-28 Authors@R: c( person("Jalal-Edine", "ZAWAM", , "jalal-edine.zawam@rte-france.com", role = c("aut", "cre")), diff --git a/NAMESPACE b/NAMESPACE index 224ca90..96d7ef3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ export(addNetLoad) export(addProcessingH5) export(addUpwardMargin) export(compare) +export(correctBalance) export(externalDependency) export(getValues) export(loadFactor) diff --git a/R/correctBalance.R b/R/correctBalance.R new file mode 100644 index 0000000..2e8b5b2 --- /dev/null +++ b/R/correctBalance.R @@ -0,0 +1,154 @@ +#Copyright © 2016 RTE Réseau de transport d’électricité + +#' correctBalance +#' +#' This function correct the BALANCE with 'ROW BAL.'. +#' +#' @return +#' \code{correctBalance} modifies its input by editing BALANCE and 'ROW BAL.'. +#' Formulas : +#' \enumerate{ +#' \item \eqn{BALANCE = BALANCE - 'ROW. BAL.'} +#' \item \eqn{ROW. BAL = 0} +#' } +#' +#' @inheritParams addUpwardMargin +#' +#' @examples +#' \dontrun{ +#' # First simulation +#' studyPath <- "path/to/study/" +#' +#' setSimulationPath(studyPath, 1) +#' mydata1 <- readAntares(areas = "all", districts = "all", synthesis = FALSE) +#' correctBalance(mydata1) +#' +#' } +#' +#' @export +#' +correctBalance <- function(x) { + .check_x(x) + + if(.isSimOpts(x)){ + .correctBalanceOpts(x) + return(invisible()) + }else{ + if (is(x, "antaresDataList")) { + if(!is.null(x$areas)){ + x$areas <- .correctBalanceAreas(x$areas) + } + if(!is.null(x$districts)){ + x$districts <- .correctBalanceAreas(x$districts) + } + }else{ + if("area" %in% names(x) | "district" %in% names(x)){ + x <- .correctBalanceAreas(x) + } + } + } + + return(x) + +} + +.correctBalanceAreas <- function(x){ + .check_x(x) + oldBalance <- NULL + x[, oldBalance := BALANCE] + x[, BALANCE := BALANCE - `ROW BAL.`] + x[, `ROW BAL.` := 0] + + return(x) + +} + +.correctBalanceOpts <- function(optsP = NULL){ + + sapply(pkgEnv$timeStepPosible, function(timeStepS){ + for(mcYearIns in c("mcInd", "mcAll")){ + suppressWarnings(addProcessingH5(opts = optsP, + mcY = mcYearIns, + timeStep = timeStepS, + evalAreas = list( + oldBalance = "BALANCE" + ), + evalDistricts = list( + oldBalance = "BALANCE" + ))) + #read the data + if(mcYearIns=="mcInd"){ + mcYearRead <- "all" + }else{ + mcYearRead <- NULL + } + dataRead <- readAntares(opts = optsP, + areas = "all", + districts = "all", + select = c("BALANCE", "ROW BAL."), + mcYears = mcYearRead, + timeStep = timeStepS) + #correct the data + dataCor <- correctBalance(x = dataRead) + #write the corrected data + .writeH5Antares(dataC = dataCor, opts = optsP, timeStepC = timeStepS) + } + }) +} + +.writeH5Antares <- function(dataC = NULL, opts = NULL, timeStepC = NULL){ + #loop data + for(typeData in c("areas", "districts")){ + if(typeData=="district"){ + print("test") + } + dataToC <- dataC[[typeData]] + ifelse(typeData=="areas", keyData <- "area", keyData <- "district") + if(!is.null(dataToC)){ + keyToW <- unique(dataToC[[keyData]]) + #correct only the values + varToCorrect <- setdiff(names(dataToC), .idCols(dataToC)) + if(attr(dataC, "synthesis")){ + sapply(varToCorrect, function(varS){ + sapply(keyToW, function(keyToS){ + timeIdW <- unique(dataToC[get(keyData)==keyToS, timeId]) + dataCVar <- dataToC[get(keyData)==keyToS, get(varS)] + .h5Antares_edit_variable( + pathH5 = opts$h5path, + instanceData = keyToS, + classData = typeData, + timeId = timeIdW, + antVar = varS, + newValue = dataCVar, + mcYear = NULL, + allTimeId = TRUE, + timeStep = timeStepC + ) + }) + }) + }else{ + mcYearW <- unique(dataToC$mcYear) + sapply(X = mcYearW, FUN = function(mcYearS){ + sapply(varToCorrect, function(varS){ + sapply(keyToW, function(keyToS){ + timeIdW <- unique(dataToC[get(keyData)==keyToS, timeId]) + dataCVar <- dataToC[get(keyData)==keyToS & mcYear == mcYearS, + get(varS)] + .h5Antares_edit_variable( + pathH5 = opts$h5path, + instanceData = keyToS, + classData = typeData, + timeId = timeIdW, + antVar = varS, + newValue = dataCVar, + mcYear = mcYearS, + allTimeId = TRUE, + timeStep = timeStepC + ) + }) + }) + }) + } + } + } +} diff --git a/R/h5_processing.R b/R/h5_processing.R index 6498d1a..7078714 100644 --- a/R/h5_processing.R +++ b/R/h5_processing.R @@ -10,6 +10,7 @@ #' @param addUpwardMargin \code{boolean} refer to \link[antaresProcessing]{addUpwardMargin} #' @param addExportAndImport \code{boolean} refer to \link[antaresProcessing]{addExportAndImport} #' @param addLoadFactorLink \code{boolean} refer to \link[antaresProcessing]{addLoadFactorLink} +#' @param correctBalance \code{boolean} refer to \link[antaresProcessing]{correctBalance} #' @param externalDependency \code{boolean} refer to \link[antaresProcessing]{externalDependency} #' @param loadFactor \code{boolean} refer to \link[antaresProcessing]{loadFactor} #' @param modulation \code{boolean} refer to \link[antaresProcessing]{modulation} @@ -54,6 +55,7 @@ #' addUpwardMargin = TRUE, #' addExportAndImport = TRUE, #' addLoadFactorLink = TRUE, +#' correctBalance = TRUE, #' externalDependency = TRUE, #' loadFactor = TRUE, #' modulation = TRUE, @@ -83,6 +85,7 @@ addProcessingH5 <- function(opts = simOptions(), addUpwardMargin = FALSE, addExportAndImport = FALSE, addLoadFactorLink = FALSE, + correctBalance = FALSE, externalDependency = FALSE, loadFactor = FALSE, modulation = FALSE, @@ -104,6 +107,12 @@ addProcessingH5 <- function(opts = simOptions(), stop("opts not refear to an h5 file") } + if(correctBalance){ + try({ + correctBalance(x = opts) + }) + } + allData <- allProcess if(allData){ addNetLoad <- TRUE @@ -395,7 +404,7 @@ addProcessingH5 <- function(opts = simOptions(), links = ln, clusters = clu, districts = dr, - opts = opts, select = c(select,columnsToSelects), + opts = opts, select = c(select, columnsToSelects), mcYears = mcYears, timeStep = timeStep) res <- as.antaresDataList(res) @@ -755,6 +764,7 @@ addProcessingH5 <- function(opts = simOptions(), res$clusters <- merge(res$clusters, surplusClusters, by = idC) }) } + options(warn = oldw) res } diff --git a/R/zzz.R b/R/zzz.R index c312586..d9f66fd 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -80,6 +80,12 @@ c("areas", "clusters", "mcYears", "WIND", "SOLAR", "H. ROR", "H. STOR", "MRG. PRICE") ) + + setAlias( + "correctBalance", + "Data required by function 'correctBalance()'", + c("areas", "BALANCE", "ROW BAL.") + ) sapply(names(pkgEnv$process), function(X){ tpAlias <- pkgEnv$process[[X]] X <- paste0("Out_", X) @@ -116,6 +122,12 @@ globalVariables( .idCols <- antaresRead:::.idCols .addClassAndAttributes <- antaresRead:::.addClassAndAttributes .groupByDistrict <- antaresRead:::.groupByDistrict +.check_x <- antaresRead:::.check_x +.h5Antares_edit_variable <- antaresRead:::.h5Antares_edit_variable +#.skipFunctionH5 <- antaresRead:::.skipFunctionH5 +#.check_if_h5_is_in_tmp <- antaresRead:::.check_if_h5_is_in_tmp +.isSimOpts <- antaresRead:::.isSimOpts +.get_by_area <- antaresRead:::.get_by_area pkgEnv <- antaresRead:::pkgEnv @@ -127,6 +139,8 @@ pkgEnv <- antaresRead:::pkgEnv pkgEnv$process$addNetLoad$areas <- c("netLoad") pkgEnv$process$addNetLoad$districts <- c("netLoad") +pkgEnv$process$correctBalance$areas <- c("oldBalance") +pkgEnv$process$correctBalance$districts <- c("oldBalance") pkgEnv$process$addDownwardMargin$areas <- c("isolatedDownwardMargin", "interconnectedDownwardMargin") @@ -217,3 +231,43 @@ pkgEnv$processDispo <- data.frame( "surplusClusters" )) + +.check_if_h5_is_in_tmp<-function(h5filePath=NULL, path=NULL, stop=FALSE, printMessage=TRUE){ + + resH5NotInTmp<-!grepl("Temp", h5filePath, ignore.case = TRUE) & !grepl("tmp", h5filePath, ignore.case = TRUE) + if(resH5NotInTmp){ + if(printMessage){ + print(paste0("h5file : ", h5filePath)) + print(paste0("path : ", path)) + } + }else{ + return(TRUE) + } + + messageToPrint<-"h5file is not in temp folder" + if(stop & resH5NotInTmp){ + stop(messageToPrint) + } + if(resH5NotInTmp){ + if(printMessage){ + message(messageToPrint) + } + } + + return(FALSE) +} + + +.skipFunctionH5<-function(h5file = NULL){ + testthat::skip_if(is.null(h5file), "h5file is null") + if(!is.null(h5file)){ + testthat::skip_if(!.check_if_h5_is_in_tmp(h5file), "h5file is not in temp folder") + } + testthat::skip_if_not(.requireRhdf5_Antares(stopP = FALSE), + "please install a correct rhdf5 version") + + #I dont why but according to CRAN Team antaresProcessing try to write in the user library + # but there are checks to verify that h5 file is in tmp folder + #to comment in the futur + testthat::skip_on_cran() +} diff --git a/man/addProcessingH5.Rd b/man/addProcessingH5.Rd index fcd62fe..5239b19 100644 --- a/man/addProcessingH5.Rd +++ b/man/addProcessingH5.Rd @@ -7,9 +7,9 @@ addProcessingH5(opts = simOptions(), mcY = c("mcInd", "mcAll"), timeStep = "hourly", addNetLoad = FALSE, addDownwardMargin = FALSE, addUpwardMargin = FALSE, addExportAndImport = FALSE, - addLoadFactorLink = FALSE, externalDependency = FALSE, - loadFactor = FALSE, modulation = FALSE, netLoadRamp = FALSE, - surplus = FALSE, surplusClusters = FALSE, + addLoadFactorLink = FALSE, correctBalance = FALSE, + externalDependency = FALSE, loadFactor = FALSE, modulation = FALSE, + netLoadRamp = FALSE, surplus = FALSE, surplusClusters = FALSE, thermalAvailabilities = FALSE, linkCapacity = FALSE, mustRun = FALSE, allProcess = FALSE, evalAreas = list(), evalLinks = list(), evalClusters = list(), evalDistricts = list(), @@ -32,6 +32,8 @@ addProcessingH5(opts = simOptions(), mcY = c("mcInd", "mcAll"), \item{addLoadFactorLink}{\code{boolean} refer to \link[antaresProcessing]{addLoadFactorLink}} +\item{correctBalance}{\code{boolean} refer to \link[antaresProcessing]{correctBalance}} + \item{externalDependency}{\code{boolean} refer to \link[antaresProcessing]{externalDependency}} \item{loadFactor}{\code{boolean} refer to \link[antaresProcessing]{loadFactor}} @@ -92,6 +94,7 @@ addProcessingH5(opts = opts, mcY = "mcInd", addUpwardMargin = TRUE, addExportAndImport = TRUE, addLoadFactorLink = TRUE, + correctBalance = TRUE, externalDependency = TRUE, loadFactor = TRUE, modulation = TRUE, diff --git a/man/correctBalance.Rd b/man/correctBalance.Rd new file mode 100644 index 0000000..4783f70 --- /dev/null +++ b/man/correctBalance.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctBalance.R +\name{correctBalance} +\alias{correctBalance} +\title{correctBalance} +\usage{ +correctBalance(x) +} +\arguments{ +\item{x}{An object of class \code{\link[antaresRead]{readAntares}} (or \code{\link[antaresRead]{simOptions}}) created with 'readAntares()' (or 'setSimulationPath()')} +} +\value{ +\code{correctBalance} modifies its input by editing BALANCE and 'ROW BAL.'. +Formulas : +\enumerate{ +\item \eqn{BALANCE = BALANCE - 'ROW. BAL.'} +\item \eqn{ROW. BAL = 0} +} +} +\description{ +This function correct the BALANCE with 'ROW BAL.'. +} +\examples{ +\dontrun{ +# First simulation +studyPath <- "path/to/study/" + +setSimulationPath(studyPath, 1) +mydata1 <- readAntares(areas = "all", districts = "all", synthesis = FALSE) +correctBalance(mydata1) + +} + +} diff --git a/tests/testthat/test-correctBalance.R b/tests/testthat/test-correctBalance.R new file mode 100644 index 0000000..482b8d1 --- /dev/null +++ b/tests/testthat/test-correctBalance.R @@ -0,0 +1,316 @@ +context("Function correctBalance") + +opts <- setSimulationPath(studyPath) + +test_that("correctBalance get an antaresData in x", { + expect_error(correctBalance(x = 1e-10)) +}) + +test_that("correctBalance must work with an antaresDataTable areas", { + myDataAreas <- readAntares(areas = "all", showProgress = FALSE, mcYears = 1) + myDataAreasCopy <- data.table::copy(myDataAreas) + expect_true(all.equal(unique(myDataAreasCopy$`ROW BAL.`), 0)) + vecCorect <- as.integer(round(rnorm(69, mean = 100, sd = 5),0)) + myDataAreasCopy[area == "b" & timeId > 2710 & timeId < 2780, `ROW BAL.` := vecCorect] + expect_false(identical(unique(myDataAreasCopy$`ROW BAL.`), 0)) + correctBalance(x = myDataAreasCopy) + expect_true(all.equal(unique(myDataAreasCopy$`ROW BAL.`), 0)) + expect_equal(unique(myDataAreasCopy$`ROW BAL.`), 0) + #check the Balance value + expect_equal(myDataAreasCopy[area == "b" & timeId > 2710 & timeId < 2780, (BALANCE)], + myDataAreas[area == "b" & timeId > 2710 & timeId < 2780, (BALANCE)] - vecCorect) + expect_true("oldBalance" %in% names(myDataAreasCopy)) +}) + +test_that("correctBalance must work with an antaresDataTable districts", { + myDataDistricts <- readAntares(districts = "all", showProgress = FALSE, mcYears = 1) + myDataDistrictCopy <- data.table::copy(myDataDistricts) + expect_true(all.equal(unique(myDataDistrictCopy$`ROW BAL.`), 0)) + vecCorect <- as.integer(round(rnorm(69, mean = 100, sd = 5),0)) + myDataDistrictCopy[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, `ROW BAL.` := vecCorect] + expect_false(identical(unique(myDataDistrictCopy$`ROW BAL.`), 0)) + correctBalance(x = myDataDistrictCopy) + expect_true(all.equal(unique(myDataDistrictCopy$`ROW BAL.`), 0)) + expect_equal(unique(myDataDistrictCopy$`ROW BAL.`), 0) + #check the Balance value + expect_equal(myDataDistrictCopy[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, (BALANCE)], + myDataDistricts[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, (BALANCE)] - vecCorect) + + expect_true("oldBalance" %in% names(myDataDistrictCopy)) +}) + +test_that("correctBalance must work with an antaresDataList", { + myDataArDi <- readAntares(areas = "all", districts = "all", showProgress = FALSE, mcYears = 1) + myDataDistrictCopy <- data.table::copy(myDataArDi) + expect_true(all.equal(unique(myDataDistrictCopy$districts$`ROW BAL.`), 0)) + vecCorect <- as.integer(round(rnorm(69, mean = 100, sd = 5),0)) + myDataDistrictCopy$districts[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, `ROW BAL.` := vecCorect] + expect_false(identical(unique(myDataDistrictCopy$districts$`ROW BAL.`), 0)) + corBalance <- correctBalance(x = myDataDistrictCopy) + expect_true(all.equal(unique(corBalance$districts$`ROW BAL.`), 0)) + expect_equal(unique(corBalance$districts$`ROW BAL.`), 0) + #check the Balance value + myDataDistrictCopy$districts[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, (BALANCE)] + expect_equal(myDataDistrictCopy$districts[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, (BALANCE)], + myDataArDi$district[district == getDistricts()[1] & timeId > 2710 & timeId < 2780, (BALANCE)] - vecCorect) + +}) + +test_that("correctBalance must work with an antaresDataTable links", { + myDataLinks <- readAntares(links = "all", showProgress = FALSE, mcYears = 1) + myDataLinksCopy <- data.table::copy(myDataLinks) + expect_true(all.equal(myDataLinksCopy, correctBalance(x = myDataLinksCopy))) +}) + +test_that("correctBalance must work with an antaresDataList without areas or districts", { + myDataLinksClusters <- readAntares(links = "all", clusters = "all", showProgress = FALSE, mcYears = 1) + myDataLinksClustersCopy <- data.table::copy(myDataLinksClusters) + expect_true(all.equal(myDataLinksClustersCopy, correctBalance(x = myDataLinksClustersCopy))) +}) + +test_that("h5 : processing correctBalance when mcYear is set to NULL", { + .skipFunctionH5(h5file) + optsH5 <- setSimulationPath(h5file) + correctBalance(x = optsH5) + # with a new Study H5 test + ## create a new folder h5 + pathInitial <- file.path(dirname(studyPath)) + pathNewH5 <- file.path(pathInitial, "testH5") + if (!dir.exists(pathNewH5)){ + dir.create(pathNewH5) + } + + #write a new H5 file + optsData <- antaresRead::setSimulationPath(path = studyPath) + suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData, + overwrite = TRUE, supressMessages = TRUE)) + pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) + .h5Antares_edit_variable( + pathH5 = pathNewH5File, + instanceData = "b", + classData = "areas", + timeId = 1:100, + antVar = "ROW BAL.", + newValue = 15000, + mcYear = NULL + ) + + optsH5New <- setSimulationPath(path = pathNewH5File) + myDataB <- readAntares(opts = optsH5New, areas = "b", mcYears = NULL) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 15000) + correctBalance(x = optsH5New) + myDataB <- readAntares(opts = optsH5New, areas = "b", mcYears = NULL) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 0) + +}) + +test_that("h5 : processing correctBalance when mcYear is set to 1", { + .skipFunctionH5(h5file) + optsH5 <- setSimulationPath(h5file) + correctBalance(x = optsH5) + # with a new Study H5 test + ## create a new folder h5 + pathInitial <- file.path(dirname(studyPath)) + pathNewH5 <- file.path(pathInitial, "testH5") + if (!dir.exists(pathNewH5)){ + dir.create(pathNewH5) + } + + #write a new H5 file + optsData <- antaresRead::setSimulationPath(path = studyPath) + suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData, + overwrite = TRUE, supressMessages = TRUE)) + + pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) + .h5Antares_edit_variable( + pathH5 = pathNewH5File, + instanceData = "b", + classData = "areas", + timeId = 1:100, + antVar = "ROW BAL.", + newValue = 15000, + mcYear = 1 + ) + + optsH5New <- setSimulationPath(path = pathNewH5File) + myDataB <- readAntares(opts = optsH5New, areas = "b", mcYears = 1) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 15000) + correctBalance(x = optsH5New) + myDataB <- readAntares(opts = optsH5New, areas = "b", + mcYears = 1, select = c("BALANCE", "ROW BAL.", "oldBalance")) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 0) + expect_true("oldBalance" %in% names(myDataB)) +}) + +test_that("h5 : processing correctBalance when mcYear is set to 1 for weekly or monthly data", { + .skipFunctionH5(h5file) + optsH5 <- setSimulationPath(h5file) + correctBalance(x = optsH5) + # with a new Study H5 test + ## create a new folder h5 + pathInitial <- file.path(dirname(studyPath)) + pathNewH5 <- file.path(pathInitial, "testH5") + if (!dir.exists(pathNewH5)){ + dir.create(pathNewH5) + } + + #write a new H5 file + optsData <- antaresRead::setSimulationPath(path = studyPath) + suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData, + overwrite = TRUE, supressMessages = TRUE)) + + pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) + .h5Antares_edit_variable( + pathH5 = pathNewH5File, + instanceData = "b", + classData = "areas", + timeId = 1, + antVar = "ROW BAL.", + newValue = 15000, + mcYear = 1, + timeStep = "weekly" + ) + + optsH5New <- setSimulationPath(path = pathNewH5File) + myDataB <- readAntares(opts = optsH5New, areas = "b", + mcYears = 1, timeStep = "weekly") + expect_equal(max(unique(myDataB$`ROW BAL.`)), 15000) + correctBalance(x = optsH5New) + myDataB <- readAntares(opts = optsH5New, areas = "b", + mcYears = 1, + select = c("BALANCE", "ROW BAL.", "oldBalance"), + timeStep = "weekly") + expect_equal(max(unique(myDataB$`ROW BAL.`)), 0) + expect_true("oldBalance" %in% names(myDataB)) + + # monthly data + timeStepToTest <- "monthly" + optsH5 <- antaresRead::setSimulationPath(path = h5file) + myDataB <- readAntares(opts = optsH5, + areas = "b", + mcYears = 1, timeStep = timeStepToTest) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 0) + pathInitial <- file.path(dirname(studyPath)) + pathNewH5 <- file.path(pathInitial, "testH5") + if (!dir.exists(pathNewH5)){ + dir.create(pathNewH5) + } + #write a new H5 file + optsData <- antaresRead::setSimulationPath(path = studyPath) + suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData, + overwrite = TRUE, supressMessages = TRUE)) + + pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) + .h5Antares_edit_variable( + pathH5 = pathNewH5File, + instanceData = "b", + classData = "areas", + timeId = 1, + antVar = "ROW BAL.", + newValue = 15000, + mcYear = 1, + timeStep = timeStepToTest + ) + myDataB <- readAntares(opts = optsH5New, areas = "b", + mcYears = 1, timeStep = timeStepToTest) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 15000) + correctBalance(x = optsH5New) + myDataB <- readAntares(opts = optsH5New, areas = "b", + mcYears = 1, + timeStep = timeStepToTest, + select = c("BALANCE", "ROW BAL.", "oldBalance")) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 0) + expect_true("oldBalance" %in% names(myDataB)) +}) + +test_that("h5 : processing correctBalance when mcYear is set to 1 for monthly data on districts", { + .skipFunctionH5(h5file) + # monthly data + timeStepToTest <- "monthly" + optsH5 <- antaresRead::setSimulationPath(path = h5file) + districtToC <- getDistricts()[1] + myDataC <- readAntares(opts = optsH5, + districts = districtToC, + mcYears = 1, + timeStep = timeStepToTest) + expect_equal(max(unique(myDataC$`ROW BAL.`)), 0) + pathInitial <- file.path(dirname(studyPath)) + pathNewH5 <- file.path(pathInitial, "testH5") + if (!dir.exists(pathNewH5)){ + dir.create(pathNewH5) + } + #write a new H5 file + optsData <- antaresRead::setSimulationPath(path = studyPath) + suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData, + overwrite = TRUE, supressMessages = TRUE)) + pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) + + pathNewH5File <- "E:\\ANTARES\\Exemple_antares\\1_h5_test\\20170707-1355eco-test.h5" + optsH5New <- setSimulationPath(path = pathNewH5File) + .h5Antares_edit_variable( + pathH5 = pathNewH5File, + instanceData = districtToC, + classData = "districts", + timeId = 1, + antVar = "ROW BAL.", + newValue = 15000, + mcYear = 1, + timeStep = timeStepToTest + ) + myDataC <- readAntares(opts = optsH5New, district = districtToC, + mcYears = 1, timeStep = timeStepToTest) + expect_equal(max(unique(myDataC$`ROW BAL.`)), 15000) + correctBalance(x = optsH5New) + myDataC <- readAntares(opts = optsH5New, + district = districtToC, + mcYears = 1, + timeStep = timeStepToTest, + select = c("BALANCE", "ROW BAL.", "oldBalance")) + expect_equal(max(unique(myDataC$`ROW BAL.`)), 0) + expect_true("oldBalance" %in% names(myDataC)) +}) + +test_that("h5 : processing correctBalance with addProcessingH5", { + .skipFunctionH5(h5file) + optsH5 <- setSimulationPath(h5file) + correctBalance(x = optsH5) + myData <- readAntares(opts = optsH5, areas = "b", mcYears = 1) + expect_equal(max(unique(myData$`ROW BAL.`)), 0) + # with a new Study H5 test + ## create a new folder h5 + pathInitial <- file.path(dirname(studyPath)) + pathNewH5 <- file.path(pathInitial, "testH5") + if (!dir.exists(pathNewH5)){ + dir.create(pathNewH5) + } + + #write a new H5 file + optsData <- antaresRead::setSimulationPath(path = studyPath) + suppressWarnings(writeAntaresH5(path = pathNewH5, opts = optsData, + overwrite = TRUE, supressMessages = TRUE)) + + pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) + .h5Antares_edit_variable( + pathH5 = pathNewH5File, + instanceData = "b", + classData = "areas", + timeId = 1:100, + antVar = "ROW BAL.", + newValue = 15000, + mcYear = 1 + ) + + optsH5New <- setSimulationPath(path = pathNewH5File) + myDataB <- readAntares(opts = optsH5New, areas = "b", mcYears = 1) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 15000) + + addProcessingH5(opts = optsH5New, + correctBalance = TRUE, + mcY = "mcInd") + + myDataB <- readAntares(opts = optsH5New, areas = "b", + mcYears = 1, select = c("BALANCE", "ROW BAL.", "oldBalance")) + expect_equal(max(unique(myDataB$`ROW BAL.`)), 0) + + expect_true("oldBalance" %in% names(myDataB)) +}) From 30e9ecdcfbc5ba08380c7b6de0bbc0d2d2326a0d Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 25 Oct 2018 12:04:28 +0200 Subject: [PATCH 02/26] move some internal H5 functions to zzz.R --- tests/testthat/helper_init.R | 31 ++-------------- tests/testthat/test-h5_processing.R | 57 +++++++++++------------------ 2 files changed, 25 insertions(+), 63 deletions(-) diff --git a/tests/testthat/helper_init.R b/tests/testthat/helper_init.R index 67df22c..f949c75 100644 --- a/tests/testthat/helper_init.R +++ b/tests/testthat/helper_init.R @@ -6,31 +6,6 @@ path <- tempdir() sourcedir <- system.file("inst/testdata", package = "antaresRead") if(sourcedir == ""){ sourcedir <- system.file("testdata", package = "antaresRead")} -check_if_h5_is_in_tmp<-function(h5filePath=NULL,path=NULL, stop=FALSE, printMessage=TRUE){ - - resH5NotInTmp<-!grepl("Temp", h5filePath, ignore.case = TRUE) & !grepl("tmp", h5filePath, ignore.case = TRUE) - if(resH5NotInTmp){ - if(printMessage){ - print(paste0("h5file : ", h5filePath)) - print(paste0("path : ", path)) - } - }else{ - return(TRUE) - } - - messageToPrint<-"h5file is not in temp folder" - if(stop & resH5NotInTmp){ - stop(messageToPrint) - } - if(resH5NotInTmp){ - if(printMessage){ - message(messageToPrint) - } - } - - return(FALSE) -} - Sys.unsetenv("R_TESTS") # Hack: For some unknown reason, this script is executed at some point of # the R CMD CHECK before package is correctly installed and tests actually run. @@ -57,11 +32,11 @@ if (sourcedir != "") { if(file.copy(from = h5file, to = path, overwrite = TRUE)){ assign("h5file", file.path(path, nameH5File), envir = globalenv()) #WE MUST assign h5file variable in the test environnement and not in the global environnement - if(!check_if_h5_is_in_tmp(h5file, path, printMessage = FALSE)){ + if(!.check_if_h5_is_in_tmp(h5file, path, printMessage = FALSE)){ assign("h5file", file.path(path, nameH5File)) } - check_if_h5_is_in_tmp(h5file, path) + .check_if_h5_is_in_tmp(h5file, path) } } @@ -75,7 +50,7 @@ if (sourcedir != "") { stop("h5file must not be null") } - check_if_h5_is_in_tmp(h5file, path, stop = FALSE) + .check_if_h5_is_in_tmp(h5file, path, stop = FALSE) silentf <- deprintize(showAliases) assign("silentf", silentf, envir = globalenv()) diff --git a/tests/testthat/test-h5_processing.R b/tests/testthat/test-h5_processing.R index 7b2ec36..f5935ca 100644 --- a/tests/testthat/test-h5_processing.R +++ b/tests/testthat/test-h5_processing.R @@ -1,22 +1,7 @@ context("h5 : addProcessingH5") -#write data -skipFunctionH5<-function(){ - skip_if(is.null(h5file), "h5file is null") - if(!is.null(h5file)){ - skip_if(!check_if_h5_is_in_tmp(h5file), "h5file is not in temp folder") - } - skip_if_not(.requireRhdf5_Antares(stopP = FALSE), - "please install a correct rhdf5 version") - - #I dont why but according to CRAN Team antaresProcessing try to write in the user library - # but there are checks to verify that h5 file is in tmp folder - #to comment in the futur - skip_on_cran() -} - test_that("h5 : processing, write results", { - skipFunctionH5() + .skipFunctionH5(h5file) .setAliasH5() optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd", @@ -25,6 +10,7 @@ test_that("h5 : processing, write results", { addUpwardMargin = TRUE, addExportAndImport = TRUE, addLoadFactorLink = TRUE, + correctBalance = TRUE, externalDependency = TRUE, loadFactor = TRUE, modulation = TRUE, @@ -41,7 +27,7 @@ test_that("h5 : processing, write results", { }) test_that("h5 : processing, write results mcAll", { - skipFunctionH5() + .skipFunctionH5(h5file) .setAliasH5() optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcAll", @@ -50,6 +36,7 @@ test_that("h5 : processing, write results mcAll", { addExportAndImport = TRUE, addLoadFactorLink = TRUE, externalDependency = TRUE, + correctBalance = TRUE, loadFactor = TRUE, modulation = TRUE, netLoadRamp = TRUE, @@ -66,7 +53,7 @@ test_that("h5 : processing, write results mcAll", { }) test_that("h5 : all data", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd", allProcess = TRUE)}) @@ -82,7 +69,7 @@ test_that("h5 : all data", { #read data and compare test_that("h5 : processing calc by user", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) calcData <- readAntares(areas = "all", mcYears = "all", select = c("H. STOR" , "MISC. DTG", @@ -96,7 +83,7 @@ test_that("h5 : processing calc by user", { }) test_that("h5 : processing calc by straitements", { - skipFunctionH5() + .skipFunctionH5(h5file) UpwardMargin_out <- readAntares(areas = "all", mcYears = "all", select = "Out_addUpwardMargin", showProgress = FALSE) @@ -112,7 +99,7 @@ test_that("h5 : processing calc by straitements", { }) test_that("h5 : processing calc links clusters discticcts", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd", evalLinks = list(totalLink= "`FLOW LIN.` + 10000 "), @@ -130,7 +117,7 @@ test_that("h5 : processing calc links clusters discticcts", { }) test_that("h5 : processing Out_addNetLoad", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",addNetLoad = TRUE)}) re <- readAntares(opts = optsH5, areas = "all", districts = "all", @@ -141,7 +128,7 @@ test_that("h5 : processing Out_addNetLoad", { }) test_that("h5 : processing Out_addDownwardMargin", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",addDownwardMargin = TRUE)}) re <- readAntares(opts = optsH5, areas = "all", districts = "all", @@ -154,7 +141,7 @@ test_that("h5 : processing Out_addDownwardMargin", { }) test_that("h5 : processing Out_addUpwardMargin", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",addUpwardMargin = TRUE)}) re <- readAntares(opts = optsH5, areas = "all", districts = "all", @@ -167,7 +154,7 @@ test_that("h5 : processing Out_addUpwardMargin", { }) test_that("h5 : processing Out_addExportAndImport", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",addExportAndImport = TRUE)}) re <- readAntares(opts = optsH5, areas = "all", districts = "all", @@ -180,7 +167,7 @@ test_that("h5 : processing Out_addExportAndImport", { }) test_that("h5 : processing Out_addLoadFactorLink", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",addLoadFactorLink = TRUE)}) re <- readAntares(opts = optsH5, links = "all",clusters = "all", @@ -190,7 +177,7 @@ test_that("h5 : processing Out_addLoadFactorLink", { }) test_that("h5 : processing Out_externalDependency", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",externalDependency = TRUE)}) re <- readAntares(opts = optsH5, areas = "all", districts = "all", @@ -210,7 +197,7 @@ test_that("h5 : processing Out_externalDependency", { }) test_that("h5 : processing Out_loadFactor", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",loadFactor = TRUE)}) re <- readAntares(opts = optsH5, clusters = "all", @@ -222,7 +209,7 @@ test_that("h5 : processing Out_loadFactor", { }) test_that("h5 : processing Out_modulation", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd", modulation = TRUE)}) @@ -235,7 +222,7 @@ test_that("h5 : processing Out_modulation", { }) test_that("h5 : processing netLoadRamp", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",netLoadRamp = TRUE)}) @@ -252,7 +239,7 @@ test_that("h5 : processing netLoadRamp", { }) test_that("h5 : processing surplus", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",surplus = TRUE)}) @@ -275,7 +262,7 @@ test_that("h5 : processing surplus", { }) test_that("h5 : Out_surplusClusters", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings({addProcessingH5(opts = optsH5, mcY = "mcInd",surplusClusters = TRUE)}) @@ -291,7 +278,7 @@ test_that("h5 : Out_surplusClusters", { }) test_that("No h5 opts", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) optsH5$h5path <- NULL optsH5$h5 <- NULL @@ -300,14 +287,14 @@ test_that("No h5 opts", { }) test_that("Write boolean", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) suppressWarnings(addProcessingH5(optsH5, evalAreas = list(toto = "TRUE"))) expect_false(is.null(readAntares(mcYears = 1, select = "toto", showProgress = FALSE)$toto)) }) test_that("Write character", { - skipFunctionH5() + .skipFunctionH5(h5file) optsH5 <- setSimulationPath(h5file) expect_error(addProcessingH5(optsH5, evalAreas = list(toto = "'GGG'"))) }) From 812b8faced08d2ba59a3ce3a8c2a2f05d0f0b22f Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 25 Oct 2018 12:04:43 +0200 Subject: [PATCH 03/26] update docs --- R/addUpwardMargin.R | 3 +-- man/addDownwardMargin.Rd | 3 +-- man/addUpwardMargin.Rd | 3 +-- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/R/addUpwardMargin.R b/R/addUpwardMargin.R index e1c3d46..8575cd8 100644 --- a/R/addUpwardMargin.R +++ b/R/addUpwardMargin.R @@ -5,8 +5,7 @@ #' This function computes isolated and interconnected upward margins of areas and #' add them to an antaresData object. #' -#' @param x An object of class \code{antaresData} created with -#' \code{\link[antaresRead]{readAntares}} +#' @param x An object of class \code{\link[antaresRead]{readAntares}} (or \code{\link[antaresRead]{simOptions}}) created with 'readAntares()' (or 'setSimulationPath()') #' #' @return #' The function modifies its input by adding to it two new columns diff --git a/man/addDownwardMargin.Rd b/man/addDownwardMargin.Rd index a062f09..2cddbbf 100644 --- a/man/addDownwardMargin.Rd +++ b/man/addDownwardMargin.Rd @@ -7,8 +7,7 @@ addDownwardMargin(x) } \arguments{ -\item{x}{An object of class \code{antaresData} created with -\code{\link[antaresRead]{readAntares}}} +\item{x}{An object of class \code{\link[antaresRead]{readAntares}} (or \code{\link[antaresRead]{simOptions}}) created with 'readAntares()' (or 'setSimulationPath()')} } \value{ The function modifies its input by adding to it two new columns diff --git a/man/addUpwardMargin.Rd b/man/addUpwardMargin.Rd index 6c73a9b..4a3c173 100644 --- a/man/addUpwardMargin.Rd +++ b/man/addUpwardMargin.Rd @@ -7,8 +7,7 @@ addUpwardMargin(x) } \arguments{ -\item{x}{An object of class \code{antaresData} created with -\code{\link[antaresRead]{readAntares}}} +\item{x}{An object of class \code{\link[antaresRead]{readAntares}} (or \code{\link[antaresRead]{simOptions}}) created with 'readAntares()' (or 'setSimulationPath()')} } \value{ The function modifies its input by adding to it two new columns From 0341a8b8f31363700afaadc10f03714c7b7fb6b6 Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 25 Oct 2018 12:08:53 +0200 Subject: [PATCH 04/26] use antaresRead@develop --- .travis.yml | 2 +- appveyor.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index aaa6fb3..eee1f56 100644 --- a/.travis.yml +++ b/.travis.yml @@ -20,7 +20,7 @@ r: r_github_packages: - hadley/devtools#1263 - - rte-antares-rpackage/antaresRead@next_release + - rte-antares-rpackage/antaresRead@develop #before - Bioconductor-mirror/zlibbioc # - Bioconductor-mirror/rhdf5 #after diff --git a/appveyor.yml b/appveyor.yml index c1ef022..14bb08f 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -27,7 +27,7 @@ build_script: # - ./travis-tool.sh install_github Bioconductor-mirror/rhdf5 #after - travis-tool.sh install_bioc_deps - - ./travis-tool.sh install_github rte-antares-rpackage/antaresRead@next_release + - ./travis-tool.sh install_github rte-antares-rpackage/antaresRead@develop test_script: - travis-tool.sh run_tests From e57bcc653bf32c7b6fc3586481722688deebde5f Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 25 Oct 2018 13:47:41 +0200 Subject: [PATCH 05/26] appveyor : use rtools --- appveyor.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/appveyor.yml b/appveyor.yml index 14bb08f..ec5e63c 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -17,8 +17,10 @@ environment: matrix: - R_VERSION: release R_ARCH: x64 + USE_RTOOLS: true - R_VERSION: patched + USE_RTOOLS: true build_script: From 2dad76e405b90be1e3d95b16ab00677c296db2e0 Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 25 Oct 2018 16:59:10 +0200 Subject: [PATCH 06/26] travis install devtools cran --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index eee1f56..fbeef6a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -19,8 +19,8 @@ r: r_github_packages: - - hadley/devtools#1263 - rte-antares-rpackage/antaresRead@develop +# - hadley/devtools#1263 #before - Bioconductor-mirror/zlibbioc # - Bioconductor-mirror/rhdf5 #after From cb7399e259deb737cc2dd004250a1b2bb0e9b4f6 Mon Sep 17 00:00:00 2001 From: zawam Date: Fri, 26 Oct 2018 11:23:46 +0200 Subject: [PATCH 07/26] #32 addUpwardMargin() must work with an antaresDataList without virtual areas --- tests/testthat/test-addUpwardMargin.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/testthat/test-addUpwardMargin.R b/tests/testthat/test-addUpwardMargin.R index a901139..95cfe21 100644 --- a/tests/testthat/test-addUpwardMargin.R +++ b/tests/testthat/test-addUpwardMargin.R @@ -80,3 +80,20 @@ describe("addUpwardMargin", { }) }) + + +test_that("#32 addUpwardMargin must work with an antaresDataList without virtual areas", { + dataT <- suppressWarnings(readAntares( + areas = "all", links = "all", + select = "upwardMargin", + hydroStorageMaxPower = TRUE, linkCapacity = TRUE, + showProgress = FALSE + )) + + addUpwardMargin(dataT) + + expect_true("isolatedUpwardMargin" %in% names(dataT$areas)) + expect_true("interconnectedUpwardMargin" %in% names(dataT$areas)) + expect_gt(max(unique(dataT$areas$isolatedUpwardMargin)), 1) + expect_gt(max(unique(dataT$areas$interconnectedUpwardMargin)), 1) +}) From a2aff7767baa825d8dc26fa7754e995b25bee820 Mon Sep 17 00:00:00 2001 From: zawam Date: Tue, 30 Oct 2018 10:59:49 +0100 Subject: [PATCH 08/26] test : bug : delete an old path --- tests/testthat/test-correctBalance.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-correctBalance.R b/tests/testthat/test-correctBalance.R index 482b8d1..243da71 100644 --- a/tests/testthat/test-correctBalance.R +++ b/tests/testthat/test-correctBalance.R @@ -245,7 +245,6 @@ test_that("h5 : processing correctBalance when mcYear is set to 1 for monthly da overwrite = TRUE, supressMessages = TRUE)) pathNewH5File <- file.path(pathNewH5, list.files(pathNewH5)) - pathNewH5File <- "E:\\ANTARES\\Exemple_antares\\1_h5_test\\20170707-1355eco-test.h5" optsH5New <- setSimulationPath(path = pathNewH5File) .h5Antares_edit_variable( pathH5 = pathNewH5File, From 085403efc48dcfb9461f41aeacc00a6e53178fea Mon Sep 17 00:00:00 2001 From: zawam Date: Tue, 30 Oct 2018 15:48:26 +0100 Subject: [PATCH 09/26] travis : does not work for mac travis-ci/travis-build#1553 --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index fbeef6a..21b019d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,6 +4,9 @@ language: R sudo: true cache: packages +#remove this line when this pull request is closed +# https://github.com/travis-ci/travis-build/pull/1553 +fortran: false bioc_required: true bioc_use_devel: true From 55abcf564e3fc52f822846a3d5784e37c9775a2e Mon Sep 17 00:00:00 2001 From: zawam Date: Wed, 7 Nov 2018 09:57:50 +0100 Subject: [PATCH 10/26] add function addMonotones() --- NAMESPACE | 1 + R/addMonotone.R | 79 +++++++++++++++++++++++++++++++++++++++++++++ man/addMonotones.Rd | 26 +++++++++++++++ 3 files changed, 106 insertions(+) create mode 100644 R/addMonotone.R create mode 100644 man/addMonotones.Rd diff --git a/NAMESPACE b/NAMESPACE index 96d7ef3..cc4879e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(.setAliasH5) export(addDownwardMargin) export(addExportAndImport) export(addLoadFactorLink) +export(addMonotones) export(addNetLoad) export(addProcessingH5) export(addUpwardMargin) diff --git a/R/addMonotone.R b/R/addMonotone.R new file mode 100644 index 0000000..878c804 --- /dev/null +++ b/R/addMonotone.R @@ -0,0 +1,79 @@ +#Copyright © 2016 RTE Réseau de transport d’électricité + +#' addMonotones +#' +#' This function compute monotone for some variables. +#' +#' @return +#' \code{addMonotones} modifies its input by adding monotones. +#' @inheritParams addUpwardMargin +#' +#' @examples +#' \dontrun{ +#' # First simulation +#' studyPath <- "path/to/study/" +#' +#' setSimulationPath(studyPath, 1) +#' mydata1 <- readAntares(areas = "all", districts = "all", synthesis = FALSE) +#' addMonotones(mydata1) +#' +#' } +#' +#' @export +#' +addMonotones <- function(antaresData = NULL){ + + if(attr(antaresData, "synthesis")){ + stop("antaresData are synthesis, addMonotones() needs detail data.") + } + + if(is(antaresData, "antaresDataList")){ + for(na in names(antaresData)){ + addMonotones(antaresData[[na]]) + } + }else{ + if(length(unique(antaresData$mcYear)) <= 1){ + stop("antaresData must contain at least two mcYears.") + } + #variable to take from x + idCols <- .idCols(antaresData) + varToTake <- setdiff(names(antaresData), idCols) + antaresDataCopy <- copy(antaresData[, mget(c(idCols, varToTake))]) + #by of x + getByA <- .get_by_area((antaresDataCopy)) + getByA <- setdiff(getByA, "timeId") + #get only what you want + nameNewColum <- paste0(varToTake, "Mono") + antaresDataCopy[, eval(nameNewColum) := 0L] + #maybe faster but we must deal with column/string + # resMono <- antaresData[, eval(quote(.(nameNewColum = + # sort(get(varToTake), + # decreasing = TRUE)))), + # by = getByA] + antaresDataCopy <- antaresDataCopy[, (nameNewColum) := sort(get(varToTake), + decreasing = TRUE), + by = getByA] + antaresDataCopy[, c(varToTake) := NULL] + #Cast the result to be able to make a rowMean + IdColsWMcYear <- idCols[idCols!="mcYear"] + myFormula <- sprintf("%s ~ mcYear", paste(IdColsWMcYear, collapse = "+")) + antaresDataCopy <- data.table::dcast(data = antaresDataCopy, + formula = as.formula(myFormula), + value.var = c(paste0(varToTake, "Mono"))) + data.table::setnames(x = antaresDataCopy, + old = as.character(unique(antaresData$mcYear)), + new = paste0(varToTake,"MonoMc" , unique(antaresData$mcYear))) + #make a monotone rowMean + nameNewColum <- c(paste0(varToTake, "MonoMean")) + antaresDataCopy[, eval(nameNewColum) := 0L] + antaresDataCopy <- antaresDataCopy[, eval(nameNewColum) := as.integer(round(rowMeans(.SD), 0)), + by = IdColsWMcYear, .SDcols = c("LOADMonoMc1", "LOADMonoMc2")] + #antaresData <- merge(antaresData, resMonoMean, by = IdColsWMcYear) + setkeyv(antaresDataCopy, IdColsWMcYear) + antaresData <- merge(antaresData, resMonoMean, by = IdColsWMcYear) + setcolorder(antaresData, c(idCols, varToTake, nameNewColum)) + invisible(antaresData) + } +} + + diff --git a/man/addMonotones.Rd b/man/addMonotones.Rd new file mode 100644 index 0000000..fc846f5 --- /dev/null +++ b/man/addMonotones.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/addMonotone.R +\name{addMonotones} +\alias{addMonotones} +\title{addMonotones} +\usage{ +addMonotones(antaresData = NULL) +} +\value{ +\code{addMonotones} modifies its input by adding monotones. +} +\description{ +This function compute monotone for some variables. +} +\examples{ +\dontrun{ +# First simulation +studyPath <- "path/to/study/" + +setSimulationPath(studyPath, 1) +mydata1 <- readAntares(areas = "all", districts = "all", synthesis = FALSE) +addMonotones(mydata1) + +} + +} From e09f95bcd76f56a4f9050d972737403d068ffaaf Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 8 Nov 2018 09:58:24 +0100 Subject: [PATCH 11/26] #37 addMonotones() works now with all variables types and now merge by reference --- R/addMonotone.R | 83 ++++++++++++++---- man/addMonotones.Rd | 14 ++- tests/testthat/test-addMonotones.R | 136 +++++++++++++++++++++++++++++ 3 files changed, 212 insertions(+), 21 deletions(-) create mode 100644 tests/testthat/test-addMonotones.R diff --git a/R/addMonotone.R b/R/addMonotone.R index 878c804..e72147f 100644 --- a/R/addMonotone.R +++ b/R/addMonotone.R @@ -3,9 +3,13 @@ #' addMonotones #' #' This function compute monotone for some variables. +#' @param antaresData Object of class \code{antaresData} created with function +#' \code{\link[antaresRead]{readAntares}}. +#' @param variable An ANTARES variable. #' #' @return #' \code{addMonotones} modifies its input by adding monotones. +#' #' @inheritParams addUpwardMargin #' #' @examples @@ -14,43 +18,84 @@ #' studyPath <- "path/to/study/" #' #' setSimulationPath(studyPath, 1) -#' mydata1 <- readAntares(areas = "all", districts = "all", synthesis = FALSE) -#' addMonotones(mydata1) +#' myData1 <- readAntares(areas = "all", +#' districts = "all", synthesis = FALSE) +#' addMonotones(antaresData = myData1, +#' variable = "LOAD") #' #' } #' #' @export #' -addMonotones <- function(antaresData = NULL){ +addMonotones <- function(antaresData = NULL, variable = NULL){ + + .check_x(antaresData) if(attr(antaresData, "synthesis")){ stop("antaresData are synthesis, addMonotones() needs detail data.") } + if(!is.character(variable)){ + stop("variable is not a character") + } + if(is(antaresData, "antaresDataList")){ + #chack if variable is correct + nameCol <- NULL + for(i in 1:length(antaresData)){ + nameCol <- c(nameCol, names(antaresData[[i]])) + } + if(!(variable %in% nameCol)){ + stop("incorrect variable") + } + #call antaresData for an antaresDataTable for(na in names(antaresData)){ - addMonotones(antaresData[[na]]) + if(variable %in% names(antaresData[[na]])){ + addMonotones(antaresData[[na]], variable = variable) + } } }else{ + + if(!(variable %in% names(antaresData))){ + stop("Incorrect variable") + } + classVariable <- class(antaresData[[variable]]) + if(classVariable %in% c("factor", "POSIXt", "character")){ + stop("Incorrect variable class") + }else if(classVariable=="numeric"){ + funcClass <- as.numeric + digitMonoMean <- 2 + }else if(classVariable=="integer"){ + funcClass <- as.integer + digitMonoMean <- 0 + }else if(classVariable=="double"){ + funcClass <- as.double + digitMonoMean <- 2 + }else{ + stop("wrong class variable") + } + if(length(unique(antaresData$mcYear)) <= 1){ stop("antaresData must contain at least two mcYears.") } #variable to take from x idCols <- .idCols(antaresData) - varToTake <- setdiff(names(antaresData), idCols) + varToTake <- variable + + antaresDataCopy <- copy(antaresData[, mget(c(idCols, varToTake))]) #by of x - getByA <- .get_by_area((antaresDataCopy)) - getByA <- setdiff(getByA, "timeId") + getByA <- setdiff(getIdCols(antaresDataCopy), pkgEnv$idTimeVars) + #get only what you want - nameNewColum <- paste0(varToTake, "Mono") - antaresDataCopy[, eval(nameNewColum) := 0L] + nameNewColumn <- paste0(varToTake, "Mono") + antaresDataCopy[, (nameNewColumn) := funcClass(0)] #maybe faster but we must deal with column/string - # resMono <- antaresData[, eval(quote(.(nameNewColum = + # resMono <- antaresData[, eval(quote(.(nameNewColumn = # sort(get(varToTake), # decreasing = TRUE)))), # by = getByA] - antaresDataCopy <- antaresDataCopy[, (nameNewColum) := sort(get(varToTake), + antaresDataCopy <- antaresDataCopy[, (nameNewColumn) := sort(get(varToTake), decreasing = TRUE), by = getByA] antaresDataCopy[, c(varToTake) := NULL] @@ -60,18 +105,20 @@ addMonotones <- function(antaresData = NULL){ antaresDataCopy <- data.table::dcast(data = antaresDataCopy, formula = as.formula(myFormula), value.var = c(paste0(varToTake, "Mono"))) + newNameColumnnMonoMc <- paste0(varToTake,"MonoMc" , unique(antaresData$mcYear)) data.table::setnames(x = antaresDataCopy, old = as.character(unique(antaresData$mcYear)), - new = paste0(varToTake,"MonoMc" , unique(antaresData$mcYear))) + new = newNameColumnnMonoMc) #make a monotone rowMean nameNewColum <- c(paste0(varToTake, "MonoMean")) - antaresDataCopy[, eval(nameNewColum) := 0L] - antaresDataCopy <- antaresDataCopy[, eval(nameNewColum) := as.integer(round(rowMeans(.SD), 0)), - by = IdColsWMcYear, .SDcols = c("LOADMonoMc1", "LOADMonoMc2")] + antaresDataCopy[, (nameNewColum) := funcClass(0)] + antaresDataCopy <- antaresDataCopy[, (nameNewColum) := funcClass(round(rowMeans(.SD), digitMonoMean)), + by = IdColsWMcYear, .SDcols = newNameColumnnMonoMc] #antaresData <- merge(antaresData, resMonoMean, by = IdColsWMcYear) - setkeyv(antaresDataCopy, IdColsWMcYear) - antaresData <- merge(antaresData, resMonoMean, by = IdColsWMcYear) - setcolorder(antaresData, c(idCols, varToTake, nameNewColum)) + colToAdd <- setdiff(names(antaresDataCopy), IdColsWMcYear) + antaresData[antaresDataCopy, + (colToAdd) := mget(paste0("i.", colToAdd)), + on = IdColsWMcYear] invisible(antaresData) } } diff --git a/man/addMonotones.Rd b/man/addMonotones.Rd index fc846f5..e735f9b 100644 --- a/man/addMonotones.Rd +++ b/man/addMonotones.Rd @@ -4,7 +4,13 @@ \alias{addMonotones} \title{addMonotones} \usage{ -addMonotones(antaresData = NULL) +addMonotones(antaresData = NULL, variable = NULL) +} +\arguments{ +\item{antaresData}{Object of class \code{antaresData} created with function +\code{\link[antaresRead]{readAntares}}.} + +\item{variable}{An ANTARES variable.} } \value{ \code{addMonotones} modifies its input by adding monotones. @@ -18,8 +24,10 @@ This function compute monotone for some variables. studyPath <- "path/to/study/" setSimulationPath(studyPath, 1) -mydata1 <- readAntares(areas = "all", districts = "all", synthesis = FALSE) -addMonotones(mydata1) +myData1 <- readAntares(areas = "all", +districts = "all", synthesis = FALSE) +addMonotones(antaresData = myData1, +variable = "LOAD") } diff --git a/tests/testthat/test-addMonotones.R b/tests/testthat/test-addMonotones.R new file mode 100644 index 0000000..5ebfc84 --- /dev/null +++ b/tests/testthat/test-addMonotones.R @@ -0,0 +1,136 @@ +context("Function addMonotones") + +opts <- setSimulationPath(studyPath) + +test_that("addMonotones works with an antaresData detail", { + expect_error(addMonotones(antaresData = 1e-10), + regexp = NULL) + + myDataS <- readAntares(showProgress = FALSE) + expect_error(addMonotones(antaresData = myDataS), + regexp = NULL) + +}) + +test_that("addMonotones work with a correct variable", { + myDataD <- readAntares(mcYears = "all", showProgress = FALSE) + expect_error(addMonotones(antaresData = myDataD, + variable = 3), + regexp = "variable is not a character") + myDataD <- readAntares(mcYears = "all", showProgress = FALSE) + expect_error(addMonotones(antaresData = myDataD, + variable = 3), + regexp = "variable is not a character") + myDataD <- readAntares(mcYears = "all", showProgress = FALSE, links = "all") + expect_error(addMonotones(antaresData = myDataD, + variable = "LOAD"), + regexp = "Incorrect variable") + myDataD <- readAntares(mcYears = "all", showProgress = FALSE, areas = "all") + addMonotones(antaresData = myDataD, + variable = "LOAD") +}) + +test_that("addMonotones works with an antaresDataTable", { + myDataD <- readAntares(mcYears = "all", showProgress = FALSE, areas = "all") + addMonotones(antaresData = myDataD, + variable = "LOAD") + expect_true("LOADMonoMc1" %in% names(myDataD)) + expect_true("LOADMonoMc2" %in% names(myDataD)) + expect_true("LOADMonoMean" %in% names(myDataD)) + expect_true(is.integer(myDataD$LOADMonoMc1)) + expect_true(is.integer(myDataD$LOADMonoMc2)) + expect_true(is.integer(myDataD$LOADMonoMean)) + myDataD <- readAntares(mcYears = "all", showProgress = FALSE, areas = "all") + addMonotones(antaresData = myDataD, + variable = "MRG. PRICE") + expect_true("MRG. PRICEMonoMc1" %in% names(myDataD)) + expect_true("MRG. PRICEMonoMc2" %in% names(myDataD)) + expect_true("MRG. PRICEMonoMean" %in% names(myDataD)) + expect_true(is.numeric(myDataD$`MRG. PRICEMonoMc1`)) + expect_true(is.numeric(myDataD$`MRG. PRICEMonoMc2`)) + expect_true(is.numeric(myDataD$`MRG. PRICEMonoMean`)) + + for(myArea in unique(myDataD$area)){ + priceAmc1 <- myDataD[area==myArea & mcYear==1, `MRG. PRICE` ] + priceAmc1Mono <- sort(priceAmc1, decreasing = TRUE) + expect_equal(myDataD[area==myArea & mcYear==1, `MRG. PRICEMonoMc1` ], + priceAmc1Mono) + } + for(myArea in unique(myDataD$area)){ + priceAmc1 <- myDataD[area==myArea & mcYear==2, `MRG. PRICE` ] + priceAmc1Mono <- sort(priceAmc1, decreasing = TRUE) + expect_equal(myDataD[area==myArea & mcYear==2, `MRG. PRICEMonoMc2` ], + priceAmc1Mono) + } + +}) + +test_that("addMonotones works with an antaresDataList", { + myDataD <- readAntares(mcYears = "all", + showProgress = FALSE, + areas = "all", + links = "all") + addMonotones(antaresData = myDataD, + variable = "LOAD") + expect_true("LOADMonoMc1" %in% names(myDataD$areas)) + expect_true("LOADMonoMc2" %in% names(myDataD$areas)) + expect_true("LOADMonoMean" %in% names(myDataD$areas)) + expect_true(is.integer(myDataD$areas$LOADMonoMc1)) + expect_true(is.integer(myDataD$areas$LOADMonoMc2)) + expect_true(is.integer(myDataD$areas$LOADMonoMean)) + myDataD <- readAntares(mcYears = "all", + showProgress = FALSE, + areas = "all", + links = "all") + addMonotones(antaresData = myDataD, + variable = "FLOW LIN.") + expect_true("FLOW LIN.MonoMc1" %in% names(myDataD$links)) + expect_true("FLOW LIN.MonoMc2" %in% names(myDataD$links)) + expect_true("FLOW LIN.MonoMean" %in% names(myDataD$links)) + expect_true(is.numeric(myDataD$links$`FLOW LIN.MonoMc1`)) + expect_true(is.numeric(myDataD$links$`FLOW LIN.MonoMc2`)) + expect_true(is.numeric(myDataD$links$`FLOW LIN.MonoMean`)) + + for(myLink in unique(myDataD$links$link)){ + flowLMc1 <- myDataD$links[link==myLink & mcYear==1, `FLOW LIN.` ] + flowLMc1Mono <- sort(flowLMc1, decreasing = TRUE) + expect_equal(myDataD$links[link==myLink & mcYear==1, `FLOW LIN.MonoMc1` ], + flowLMc1Mono) + } + for(myLink in unique(myDataD$links$link)){ + flowLMc2 <- myDataD$links[link==myLink & mcYear==2, `FLOW LIN.` ] + flowLMc2Mono <- sort(flowLMc2, decreasing = TRUE) + expect_equal(myDataD$links[link==myLink & mcYear==2, `FLOW LIN.MonoMc2` ], + flowLMc2Mono) + } + + myDataD <- readAntares(mcYears = "all", + showProgress = FALSE, + areas = "all", + districts = "all") + addMonotones(antaresData = myDataD, + variable = "LOAD") + expect_true("LOADMonoMc1" %in% names(myDataD$areas)) + expect_true("LOADMonoMc2" %in% names(myDataD$areas)) + expect_true("LOADMonoMean" %in% names(myDataD$areas)) + expect_true("LOADMonoMc1" %in% names(myDataD$districts)) + expect_true("LOADMonoMc2" %in% names(myDataD$districts)) + expect_true("LOADMonoMean" %in% names(myDataD$districts)) +}) + +test_that("addMonotones computes the same monotones for several years", { + myDataD <- readAntares(mcYears = "all", + showProgress = FALSE, + areas = "all") + addMonotones(antaresData = myDataD, + variable = "LOAD") + expect_true("LOADMonoMc1" %in% names(myDataD)) + expect_true("LOADMonoMc2" %in% names(myDataD)) + expect_true("LOADMonoMean" %in% names(myDataD)) + expect_equal(myDataD[mcYear==1, LOADMonoMc1], + myDataD[mcYear==2, LOADMonoMc1]) + expect_equal(myDataD[mcYear==1, LOADMonoMc2], + myDataD[mcYear==2, LOADMonoMc2]) + expect_equal(myDataD[mcYear==1, LOADMonoMean], + myDataD[mcYear==2, LOADMonoMean]) +}) From 8514f992f8b0c86b762007b08aa0c461a76ecabe Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 8 Nov 2018 09:58:44 +0100 Subject: [PATCH 12/26] update doc correctBalance --- R/correctBalance.R | 2 +- man/correctBalance.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/correctBalance.R b/R/correctBalance.R index 2e8b5b2..c2861b1 100644 --- a/R/correctBalance.R +++ b/R/correctBalance.R @@ -2,7 +2,7 @@ #' correctBalance #' -#' This function correct the BALANCE with 'ROW BAL.'. +#' This function corrects the BALANCE with 'ROW BAL.'. #' #' @return #' \code{correctBalance} modifies its input by editing BALANCE and 'ROW BAL.'. diff --git a/man/correctBalance.Rd b/man/correctBalance.Rd index 4783f70..99fce9a 100644 --- a/man/correctBalance.Rd +++ b/man/correctBalance.Rd @@ -18,7 +18,7 @@ Formulas : } } \description{ -This function correct the BALANCE with 'ROW BAL.'. +This function corrects the BALANCE with 'ROW BAL.'. } \examples{ \dontrun{ From cbe32ac7545a1001456c1afbe83ddaaa06f29517 Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 8 Nov 2018 09:59:00 +0100 Subject: [PATCH 13/26] update NEWS / Description --- DESCRIPTION | 2 +- NEWS | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8e29e5e..3cf2fbd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: antaresProcessing Type: Package Title: 'Antares' Results Processing -Version: 0.16.0.901 +Version: 0.16.0.902 Date: 2018-09-28 Authors@R: c( person("Jalal-Edine", "ZAWAM", , "jalal-edine.zawam@rte-france.com", role = c("aut", "cre")), diff --git a/NEWS b/NEWS index eaf008d..502ec34 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,11 @@ Copyright © 2016 RTE Réseau de transport d’électricité +Changes in version 0.17.0 (2018-11-08) + +NEW FEATURES: +* New function addMonotones() computes monotones and add it to the input (#37). +* New function correctBalance() corrects the BALANCE with 'ROW BAL' (#33). + Changes in version 0.16.0 (2018-09-28) NEW FEATURES: From b5cc7e47c1254bbe17016a4a387b7630fa9435fb Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 8 Nov 2018 10:20:37 +0100 Subject: [PATCH 14/26] correct doc --- R/addMonotone.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/addMonotone.R b/R/addMonotone.R index e72147f..d05b81f 100644 --- a/R/addMonotone.R +++ b/R/addMonotone.R @@ -10,7 +10,6 @@ #' @return #' \code{addMonotones} modifies its input by adding monotones. #' -#' @inheritParams addUpwardMargin #' #' @examples #' \dontrun{ From bc00a3d45e182cdea1ccad283010d310b5ce113f Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 8 Nov 2018 10:28:34 +0100 Subject: [PATCH 15/26] update doc --- R/addMonotone.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/addMonotone.R b/R/addMonotone.R index d05b81f..3ec659c 100644 --- a/R/addMonotone.R +++ b/R/addMonotone.R @@ -54,7 +54,6 @@ addMonotones <- function(antaresData = NULL, variable = NULL){ } } }else{ - if(!(variable %in% names(antaresData))){ stop("Incorrect variable") } @@ -81,7 +80,6 @@ addMonotones <- function(antaresData = NULL, variable = NULL){ idCols <- .idCols(antaresData) varToTake <- variable - antaresDataCopy <- copy(antaresData[, mget(c(idCols, varToTake))]) #by of x getByA <- setdiff(getIdCols(antaresDataCopy), pkgEnv$idTimeVars) From 28bbbad4c5d6d9dd6843b9eb0737908fb913f9cf Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 8 Nov 2018 10:29:23 +0100 Subject: [PATCH 16/26] correct name file --- R/{addMonotone.R => addMonotones.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename R/{addMonotone.R => addMonotones.R} (100%) diff --git a/R/addMonotone.R b/R/addMonotones.R similarity index 100% rename from R/addMonotone.R rename to R/addMonotones.R From 94b548dbd261b500cab2315287f37ef61fbff966 Mon Sep 17 00:00:00 2001 From: zawam Date: Thu, 22 Nov 2018 16:54:25 +0100 Subject: [PATCH 17/26] typo --- R/addMonotones.R | 2 +- man/addMonotones.Rd | 4 ++-- tests/testthat/test-addMonotones.R | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/addMonotones.R b/R/addMonotones.R index 3ec659c..24e447f 100644 --- a/R/addMonotones.R +++ b/R/addMonotones.R @@ -2,7 +2,7 @@ #' addMonotones #' -#' This function compute monotone for some variables. +#' This function computes monotones for some variables. #' @param antaresData Object of class \code{antaresData} created with function #' \code{\link[antaresRead]{readAntares}}. #' @param variable An ANTARES variable. diff --git a/man/addMonotones.Rd b/man/addMonotones.Rd index e735f9b..b0a5923 100644 --- a/man/addMonotones.Rd +++ b/man/addMonotones.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/addMonotone.R +% Please edit documentation in R/addMonotones.R \name{addMonotones} \alias{addMonotones} \title{addMonotones} @@ -16,7 +16,7 @@ addMonotones(antaresData = NULL, variable = NULL) \code{addMonotones} modifies its input by adding monotones. } \description{ -This function compute monotone for some variables. +This function computes monotones for some variables. } \examples{ \dontrun{ diff --git a/tests/testthat/test-addMonotones.R b/tests/testthat/test-addMonotones.R index 5ebfc84..9d7323d 100644 --- a/tests/testthat/test-addMonotones.R +++ b/tests/testthat/test-addMonotones.R @@ -12,7 +12,7 @@ test_that("addMonotones works with an antaresData detail", { }) -test_that("addMonotones work with a correct variable", { +test_that("addMonotones works with a correct variable", { myDataD <- readAntares(mcYears = "all", showProgress = FALSE) expect_error(addMonotones(antaresData = myDataD, variable = 3), From d2141bdc04bab89a50d6fdddd42a52bd498b438c Mon Sep 17 00:00:00 2001 From: zawam Date: Fri, 23 Nov 2018 15:17:20 +0100 Subject: [PATCH 18/26] #21 add neighbours() --- NEWS | 1 + R/neighbours.R | 80 ++++++++++++++++++++++++++++++++ man/neighbours.Rd | 47 +++++++++++++++++++ tests/testthat/test-neighbours.R | 37 +++++++++++++++ 4 files changed, 165 insertions(+) create mode 100644 R/neighbours.R create mode 100644 man/neighbours.Rd create mode 100644 tests/testthat/test-neighbours.R diff --git a/NEWS b/NEWS index 502ec34..3ecf774 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,7 @@ Changes in version 0.17.0 (2018-11-08) NEW FEATURES: * New function addMonotones() computes monotones and add it to the input (#37). * New function correctBalance() corrects the BALANCE with 'ROW BAL' (#33). +* New functions neighbours(), addNeighbours() and getAllNeighbours() to get neighbours (#21). Changes in version 0.16.0 (2018-09-28) diff --git a/R/neighbours.R b/R/neighbours.R new file mode 100644 index 0000000..20cc794 --- /dev/null +++ b/R/neighbours.R @@ -0,0 +1,80 @@ +#' neighbours +#' +#' This function return a list of neighbours. +#' @param antaresData Object of class \code{antaresData} created with function +#' \code{\link[antaresRead]{readAntares}}. +#' @param areas A vector with several areas names. +#' @param virtualAreas A vector with several virtual areas names. +#' @param areasString A string with several areas names separated by an espace, +#' see the examples. +#' +#' @return +#' \code{neighbours} return a vector with neighbours areas names. +#' \code{addNeighbours} modifies its input by adding a column neighbours. +#' \code{getAllNeighbours} return a vector with neighbours areas names. +#' +#' @examples +#' \dontrun{ +#' +#' res <- neighbours(areas = c("a", "c"), +#' virtualAreas = getAreas("psp")) +#' +#' myData <- readAntares(areas = c("a", "c"), links = getLinks("a"), +#' showProgress = FALSE) +#' +#' addNeighbours(myData) +#' +#' res <- getAllNeighbours(areasString = "a b") +#' } +#' @export +neighbours <- function(areas = NULL, virtualAreas = NULL){ + res <- NULL + res <- sapply(as.character(areas), FUN = function(myArea){ + linksNeighbours <- getLinks(areas = myArea, exclude = virtualAreas) + setdiff(unique(unlist(strsplit(linksNeighbours, split = " - " ))), myArea) + }) + #init + neighbourDT <- c(1) + if(is.null(names(res))){ + DF <- as.data.frame(res) + areasNamesDT <- names(DF) + neighbourDT <- data.table::data.table(area = areasNamesDT) + neighbourDT[, neighbours := paste(DF[[area]], collapse=" "), by=.(area)] + }else{ + areasNamesDT <- names(res) + neighbourDT <- data.table::data.table(area = areasNamesDT) + neighbourDT[, neighbours := paste(res[[area]], collapse=" "), by=.(area)] + } + + return(neighbourDT) +} + +#' @rdname neighbours +#' @export +addNeighbours <- function(antaresData = NULL){ + .check_x(antaresData) + if(!(("area" %in% names(antaresData)) | ("areas" %in% names(antaresData))) ){ + stop("Import areas data.") + } + + if(!is.null(antaresData$areas)){ + addNeighbours(antaresData$areas) + return(invisible(antaresData)) + } + resAttr <- attributes(antaresData) + virtualAreas <- resAttr$virtualNodes$storageFlexibility + + resNeigh <- neighbours(areas = unique(antaresData$area), virtualAreas = virtualAreas) + antaresData[resNeigh, neighbours := i.neighbours, + on=.(area)] + + invisible(antaresData) +} + +#' @rdname neighbours +#' @export +getAllNeighbours <- function(areasString = NULL, virtualAreas = NULL){ + res <- unlist(strsplit(areasString, split = " ")); + neighS <- neighbours(res, virtualAreas = virtualAreas); + unique(unlist(strsplit(neighS[[2]], split = " "))) +} diff --git a/man/neighbours.Rd b/man/neighbours.Rd new file mode 100644 index 0000000..bf10cf9 --- /dev/null +++ b/man/neighbours.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/neighbours.R +\name{neighbours} +\alias{neighbours} +\alias{addNeighbours} +\alias{getAllNeighbours} +\title{neighbours} +\usage{ +neighbours(areas = NULL, virtualAreas = NULL) + +addNeighbours(antaresData = NULL) + +getAllNeighbours(areasString = NULL, virtualAreas = NULL) +} +\arguments{ +\item{areas}{A vector with several areas names.} + +\item{virtualAreas}{A vector with several virtual areas names.} + +\item{antaresData}{Object of class \code{antaresData} created with function +\code{\link[antaresRead]{readAntares}}.} + +\item{areasString}{A string with several areas names separated by an espace, +see the examples.} +} +\value{ +\code{neighbours} return a vector with neighbours areas names. +\code{addNeighbours} modifies its input by adding a column neighbours. +\code{getAllNeighbours} return a vector with neighbours areas names. +} +\description{ +This function return a list of neighbours. +} +\examples{ +\dontrun{ + +res <- neighbours(areas = c("a", "c"), +virtualAreas = getAreas("psp")) + +myData <- readAntares(areas = c("a", "c"), links = getLinks("a"), +showProgress = FALSE) + +addNeighbours(myData) + +res <- getAllNeighbours(areasString = "a b") +} +} diff --git a/tests/testthat/test-neighbours.R b/tests/testthat/test-neighbours.R new file mode 100644 index 0000000..7352b47 --- /dev/null +++ b/tests/testthat/test-neighbours.R @@ -0,0 +1,37 @@ +context("Function neighbours") + +opts <- setSimulationPath(studyPath) + +test_that("neighbours get neighbours of an area", { + res <- antaresProcessing::neighbours(areas = c("a", "c"), + virtualAreas = getAreas("psp")) + expect_true(grepl("a_offshore", x = res[area=="a"]$neighbours)) + expect_true(grepl("b", x = res[area=="a"]$neighbours)) + expect_true(grepl("b", x = res[area=="c"]$neighbours)) +}) + + +test_that("addNeighbours add neighbours to antaresData", { + myData <- antaresRead::readAntares(links = getLinks("c"), showProgress = FALSE) + expect_error(addNeighbours(myData)) + myData <- antaresRead::readAntares(areas = c("a", "c"), showProgress = FALSE) + addNeighbours(myData) + expect_true("neighbours" %in% names(addNeighbours(myData))) + neiC <- unique(myData[area=="c", (neighbours)]) + expect_true(grepl("b", neiC)) + expect_true(grepl("hub", neiC)) + myData <- antaresRead::readAntares(areas = c("a", "c"), + links = getLinks("a"), + showProgress = FALSE) + addNeighbours(myData) + neiA <- unique(myData$areas[area=="a", (neighbours)]) + expect_true(grepl("b", neiA)) + expect_true(grepl("a_offshore", neiA)) +}) + +test_that("getAllNeighbours get all neighbours", { + res <- getAllNeighbours(areasString = "a b") + expect_true("a_offshore" %in% res) + expect_true("c" %in% res) +}) + From 61668ee07aa246140b98d33c913b26d687cb006e Mon Sep 17 00:00:00 2001 From: zawam Date: Fri, 23 Nov 2018 17:04:25 +0100 Subject: [PATCH 19/26] #21 add priceConvergenceSystem() --- NEWS | 1 + R/addConvergencePriceSystem.R | 39 +++++++++ man/addConvergencePriceSystem.Rd | 17 ++++ .../testthat/test-addConvergencePriceSystem.R | 80 +++++++++++++++++++ 4 files changed, 137 insertions(+) create mode 100644 R/addConvergencePriceSystem.R create mode 100644 man/addConvergencePriceSystem.Rd create mode 100644 tests/testthat/test-addConvergencePriceSystem.R diff --git a/NEWS b/NEWS index 3ecf774..33a8312 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,7 @@ NEW FEATURES: * New function addMonotones() computes monotones and add it to the input (#37). * 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). Changes in version 0.16.0 (2018-09-28) diff --git a/R/addConvergencePriceSystem.R b/R/addConvergencePriceSystem.R new file mode 100644 index 0000000..f4fcca0 --- /dev/null +++ b/R/addConvergencePriceSystem.R @@ -0,0 +1,39 @@ +#' addConvergencePriceSystem +#' +#' This function computes priceConvergenceSystem, priceConvergenceSystem represent computes the biggest system +#' without congestion. +#' +#' @param antaresData Object of class \code{antaresData} created with function +#' \code{\link[antaresRead]{readAntares}}. antaresData must contains areas and +#' links details data with linkCapacity. +#' @export +addConvergencePriceSystem <- function(antaresData = NULL){ + .check_x(antaresData) + if((!is(antaresData, "antaresDataList")) | !("areas" %in% names(antaresData)) | + !("links" %in% names(antaresData)) ){ + stop("Import areas and links data.") + } + if(attr(antaresData, "synthesis") | attr(antaresData, "timeStep") != "hourly"){ + stop("Import hourly details data") + } + + if(is.null(antaresData$links$congestion)){ + antaresData <- addLoadFactorLink(antaresData) + } + antaresData$links[, ':=' (from = strsplit(link, split = " - " )[[1]][1], + to = strsplit(link, split = " - " )[[1]][2]), + by = .(link)] + dontSeperate <- antaresData$links[congestion==0, .(mcYear, timeId, from, to)] + + converAreas <- dontSeperate[, list(allAreasTgList = list(c(from,to))) , + by=.(mcYear, timeId)] + + converAreas[ , areasConver := as.vector(paste(sort(unique(allAreasTgList[[1]])), + collapse = " ")), + by=.(mcYear, timeId)] + + antaresData$areas[converAreas,(paste("priceConvergenceSystem")) := i.areasConver, + on=.(mcYear, timeId)] + + invisible(antaresData) +} diff --git a/man/addConvergencePriceSystem.Rd b/man/addConvergencePriceSystem.Rd new file mode 100644 index 0000000..eb3e66e --- /dev/null +++ b/man/addConvergencePriceSystem.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/addConvergencePriceSystem.R +\name{addConvergencePriceSystem} +\alias{addConvergencePriceSystem} +\title{addConvergencePriceSystem} +\usage{ +addConvergencePriceSystem(antaresData = NULL) +} +\arguments{ +\item{antaresData}{Object of class \code{antaresData} created with function +\code{\link[antaresRead]{readAntares}}. antaresData must contains areas and +links details data with linkCapacity.} +} +\description{ +This function computes priceConvergenceSystem, priceConvergenceSystem represent computes the biggest system +without congestion. +} diff --git a/tests/testthat/test-addConvergencePriceSystem.R b/tests/testthat/test-addConvergencePriceSystem.R new file mode 100644 index 0000000..32dafc4 --- /dev/null +++ b/tests/testthat/test-addConvergencePriceSystem.R @@ -0,0 +1,80 @@ +context("Function addConvergencePriceSystem") + +opts <- setSimulationPath(studyPath) + +test_that("addConvergencePriceSystem works with an antaresDataList. + antaresData must contains areas and links details data with linkCapacity.", { + myData <- readAntares(clusters = "all", showProgress = FALSE) + expect_error(addConvergencePriceSystem(myData)) + myData <- readAntares(areas = "all", showProgress = FALSE) + expect_error(addConvergencePriceSystem(myData)) + myData <- readAntares(links = "all", showProgress = FALSE) + expect_error(addConvergencePriceSystem(myData)) + + myData <- readAntares(areas = "all", + links = "all", + showProgress = FALSE) + expect_error(addConvergencePriceSystem(myData)) + myData <- suppressWarnings(readAntares(areas = "all", + links = "all", + showProgress = FALSE, + linkCapacity = TRUE)) + expect_error(addConvergencePriceSystem(myData)) + myData <- suppressWarnings(readAntares(areas = "all", + links = "all", + showProgress = FALSE, + linkCapacity = TRUE, + mcYears = "all")) + addConvergencePriceSystem(myData) +}) + +test_that("addConvergencePriceSystem add a column priceConvergenceSystem. + For each time, priceConvergenceSystem represent the system without congestion", { + 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")) + addConvergencePriceSystem(myDataRV) + + expect_true("priceConvergenceSystem" %in% names(myDataRV$areas)) + expect_true(is.character(class(myDataRV$areas$priceConvergenceSystem))) + + #when there is priceConvergenceSystem = "a b c" then we have the same prices + indexAll <- myDataRV$areas[priceConvergenceSystem=="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 <- 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[priceConvergenceSystem=="a b", which = TRUE] + myDataPrice <- myDataRV$areas[indexAB, + .(area, mcYear, timeId, `MRG. PRICE`)] + + diffPrice <- dcast(data = myDataPrice, + as.formula(myFormula), + value.var = "MRG. PRICE") + diffPrice[, ':=' (diffBA = abs(b - a), + diffCB = abs(c - b)) ] + #diff price not bigger than hurdle cost for A / B but not for C / B + expect_true(max(diffPrice$diffBA) <= maxDiffNormal) + expect_false(max(diffPrice$diffCB) <= maxDiffNormal) +}) From fafce192dc65770bd02167b87338968348eef82f Mon Sep 17 00:00:00 2001 From: zawam Date: Mon, 26 Nov 2018 09:35:33 +0100 Subject: [PATCH 20/26] typo --- R/addConvergencePriceSystem.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/addConvergencePriceSystem.R b/R/addConvergencePriceSystem.R index f4fcca0..7187e94 100644 --- a/R/addConvergencePriceSystem.R +++ b/R/addConvergencePriceSystem.R @@ -1,7 +1,7 @@ #' addConvergencePriceSystem #' -#' This function computes priceConvergenceSystem, priceConvergenceSystem represent computes the biggest system -#' without congestion. +#' This function computes priceConvergenceSystem, priceConvergenceSystem represent +#' the biggest system without congestion. #' #' @param antaresData Object of class \code{antaresData} created with function #' \code{\link[antaresRead]{readAntares}}. antaresData must contains areas and From f8705072eef200d84d62d37ec38f0bc694a84036 Mon Sep 17 00:00:00 2001 From: zawam Date: Mon, 26 Nov 2018 10:09:52 +0100 Subject: [PATCH 21/26] #21 add function addConvergencePriceArea --- NEWS | 1 + R/addConvergencePriceArea.R | 85 +++++++++++++++++ tests/testthat/test-addConvergencePriceArea.R | 93 +++++++++++++++++++ 3 files changed, 179 insertions(+) create mode 100644 R/addConvergencePriceArea.R create mode 100644 tests/testthat/test-addConvergencePriceArea.R diff --git a/NEWS b/NEWS index 33a8312..4f175d2 100644 --- 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 new file mode 100644 index 0000000..ac483e8 --- /dev/null +++ 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 new file mode 100644 index 0000000..85e37cc --- /dev/null +++ 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)])) + +}) From 9d46187cb87b721471c9b0a6c678546f2955b280 Mon Sep 17 00:00:00 2001 From: zawam Date: Mon, 26 Nov 2018 10:23:19 +0100 Subject: [PATCH 22/26] add examples --- R/addConvergencePriceArea.R | 15 +++++++++++++++ R/addConvergencePriceSystem.R | 15 +++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/R/addConvergencePriceArea.R b/R/addConvergencePriceArea.R index ac483e8..6ac6a8e 100644 --- a/R/addConvergencePriceArea.R +++ b/R/addConvergencePriceArea.R @@ -6,6 +6,21 @@ #' @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. +#' @examples +#' \dontrun{ +#' +#' myData <- readAntares(areas = "all", +#' links = "all", +#' showProgress = FALSE, +#' linkCapacity = TRUE, +#' mcYears = "all") +#' +#' myDataRV <- removeVirtualAreas(x = myData, +#' storageFlexibility = getAreas(c("psp", "hub")), +#' production = getAreas("off")) +#' +#' addConvergencePriceArea(myData) +#' } #' @export addConvergencePriceArea <- function(antaresData = NULL){ .check_x(antaresData) diff --git a/R/addConvergencePriceSystem.R b/R/addConvergencePriceSystem.R index 7187e94..2f4afda 100644 --- a/R/addConvergencePriceSystem.R +++ b/R/addConvergencePriceSystem.R @@ -6,6 +6,21 @@ #' @param antaresData Object of class \code{antaresData} created with function #' \code{\link[antaresRead]{readAntares}}. antaresData must contains areas and #' links details data with linkCapacity. +#' @examples +#' \dontrun{ +#' +#' myData <- readAntares(areas = "all", +#' links = "all", +#' showProgress = FALSE, +#' linkCapacity = TRUE, +#' mcYears = "all") +#' +#' myDataRV <- removeVirtualAreas(x = myData, +#' storageFlexibility = getAreas(c("psp", "hub")), +#' production = getAreas("off")) +#' +#' addConvergencePriceSystem(myData) +#' } #' @export addConvergencePriceSystem <- function(antaresData = NULL){ .check_x(antaresData) From 30cf7a33351d40d0442ed848b3104d755085ecea Mon Sep 17 00:00:00 2001 From: zawam Date: Tue, 27 Nov 2018 12:16:19 +0100 Subject: [PATCH 23/26] update doc --- R/zzz.R | 20 ++++++++++++++++++- man/addConvergencePriceArea.Rd | 33 ++++++++++++++++++++++++++++++++ man/addConvergencePriceSystem.Rd | 20 +++++++++++++++++-- 3 files changed, 70 insertions(+), 3 deletions(-) create mode 100644 man/addConvergencePriceArea.Rd diff --git a/R/zzz.R b/R/zzz.R index d9f66fd..686bbc0 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -128,6 +128,7 @@ globalVariables( #.check_if_h5_is_in_tmp <- antaresRead:::.check_if_h5_is_in_tmp .isSimOpts <- antaresRead:::.isSimOpts .get_by_area <- antaresRead:::.get_by_area +.get_by_link <- antaresRead:::.get_by_link pkgEnv <- antaresRead:::pkgEnv @@ -232,6 +233,7 @@ pkgEnv$processDispo <- data.frame( )) + .check_if_h5_is_in_tmp<-function(h5filePath=NULL, path=NULL, stop=FALSE, printMessage=TRUE){ resH5NotInTmp<-!grepl("Temp", h5filePath, ignore.case = TRUE) & !grepl("tmp", h5filePath, ignore.case = TRUE) @@ -257,7 +259,6 @@ pkgEnv$processDispo <- data.frame( return(FALSE) } - .skipFunctionH5<-function(h5file = NULL){ testthat::skip_if(is.null(h5file), "h5file is null") if(!is.null(h5file)){ @@ -270,4 +271,21 @@ pkgEnv$processDispo <- data.frame( # but there are checks to verify that h5 file is in tmp folder #to comment in the futur testthat::skip_on_cran() + #TODO DEL + testthat::skip("h5") +} + +.cleanDataCluster <- function(clDes = NULL){ + for(columnC in names(clDes)){ + if(class(clDes[[columnC]]) %in% c("double", "numeric", "integer")){ + clDes[is.na(get(columnC)), (columnC) := 0] + } + } + nameMustRun <- "must.run" + if(nameMustRun %in% names(clDes)){ + clDes[is.na(get("must.run")), ("must.run") := FALSE] + }else{ + clDes[, (nameMustRun) := FALSE] + } + return(clDes) } diff --git a/man/addConvergencePriceArea.Rd b/man/addConvergencePriceArea.Rd new file mode 100644 index 0000000..cb07c5b --- /dev/null +++ b/man/addConvergencePriceArea.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/addConvergencePriceArea.R +\name{addConvergencePriceArea} +\alias{addConvergencePriceArea} +\title{addConvergencePriceArea} +\usage{ +addConvergencePriceArea(antaresData = NULL) +} +\arguments{ +\item{antaresData}{Object of class \code{antaresData} created with function +\code{\link[antaresRead]{readAntares}}. antaresData must contains areas and +links details hourly data with linkCapacity.} +} +\description{ +This function computes priceConvergenceArea, priceConvergenceArea represent +the biggest system without congestion for one area. +} +\examples{ +\dontrun{ + + myData <- readAntares(areas = "all", + links = "all", + showProgress = FALSE, + linkCapacity = TRUE, + mcYears = "all") + + myDataRV <- removeVirtualAreas(x = myData, + storageFlexibility = getAreas(c("psp", "hub")), + production = getAreas("off")) + + addConvergencePriceArea(myData) +} +} diff --git a/man/addConvergencePriceSystem.Rd b/man/addConvergencePriceSystem.Rd index eb3e66e..315a964 100644 --- a/man/addConvergencePriceSystem.Rd +++ b/man/addConvergencePriceSystem.Rd @@ -12,6 +12,22 @@ addConvergencePriceSystem(antaresData = NULL) links details data with linkCapacity.} } \description{ -This function computes priceConvergenceSystem, priceConvergenceSystem represent computes the biggest system -without congestion. +This function computes priceConvergenceSystem, priceConvergenceSystem represent +the biggest system without congestion. +} +\examples{ +\dontrun{ + + myData <- readAntares(areas = "all", + links = "all", + showProgress = FALSE, + linkCapacity = TRUE, + mcYears = "all") + + myDataRV <- removeVirtualAreas(x = myData, + storageFlexibility = getAreas(c("psp", "hub")), + production = getAreas("off")) + + addConvergencePriceSystem(myData) +} } From 62814bf54607d51570100b9dd49816fae02edbcc Mon Sep 17 00:00:00 2001 From: zawam Date: Tue, 27 Nov 2018 14:51:12 +0100 Subject: [PATCH 24/26] correction for R CMD Check --- DESCRIPTION | 2 +- NAMESPACE | 6 ++++++ R/addConvergencePriceArea.R | 9 +++++++++ R/addConvergencePriceSystem.R | 8 ++++++++ R/neighbours.R | 3 +++ 5 files changed, 27 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3cf2fbd..be88ae4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ BugReports: https://github.com/rte-antares-rpackage/antaresProcessing/issues License: GPL (>= 2) | file LICENSE LazyData: TRUE Depends: antaresRead (>= 1.1.5) -Imports: data.table, methods, stats +Imports: data.table, methods, stats, stringi Suggests: rhdf5 (>= 2.24.0), parallel, testthat, knitr, rmarkdown, covr RoxygenNote: 6.1.0 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index cc4879e..c454f99 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,20 +1,25 @@ # Generated by roxygen2: do not edit by hand export(.setAliasH5) +export(addConvergencePriceArea) +export(addConvergencePriceSystem) export(addDownwardMargin) export(addExportAndImport) export(addLoadFactorLink) export(addMonotones) +export(addNeighbours) export(addNetLoad) export(addProcessingH5) export(addUpwardMargin) export(compare) export(correctBalance) export(externalDependency) +export(getAllNeighbours) export(getValues) export(loadFactor) export(mergeAllAntaresData) export(modulation) +export(neighbours) export(netLoadRamp) export(surplus) export(surplusClusters) @@ -28,3 +33,4 @@ importFrom(stats,as.formula) importFrom(stats,median) importFrom(stats,quantile) importFrom(stats,sd) +importFrom(stringi,stri_detect_fixed) diff --git a/R/addConvergencePriceArea.R b/R/addConvergencePriceArea.R index 6ac6a8e..8e98251 100644 --- a/R/addConvergencePriceArea.R +++ b/R/addConvergencePriceArea.R @@ -21,6 +21,7 @@ #' #' addConvergencePriceArea(myData) #' } +#' @importFrom stringi stri_detect_fixed #' @export addConvergencePriceArea <- function(antaresData = NULL){ .check_x(antaresData) @@ -37,6 +38,14 @@ addConvergencePriceArea <- function(antaresData = NULL){ if(is.null(antaresData$areas$priceConvergenceSystem)){ addConvergencePriceSystem(antaresData) } + #pb with R check, init variable + priceConvergenceAreaN <- NULL + priceConvergenceAreaN1 <- NULL + priceConvergenceSystem <- NULL + priceConvergenceArea <- NULL + neighboursN <- NULL + neighboursN1 <- NULL + #priceConvergenceArea = area antaresData$areas[, priceConvergenceAreaN := as.character(area), by=.(area, mcYear, timeId)] diff --git a/R/addConvergencePriceSystem.R b/R/addConvergencePriceSystem.R index 2f4afda..d5f54cd 100644 --- a/R/addConvergencePriceSystem.R +++ b/R/addConvergencePriceSystem.R @@ -35,6 +35,14 @@ addConvergencePriceSystem <- function(antaresData = NULL){ if(is.null(antaresData$links$congestion)){ antaresData <- addLoadFactorLink(antaresData) } + #R CMD CHECK, init some variables + congestion <- NULL + priceConvergenceArea <- NULL + areasConver <- NULL + allAreasTgList <- NULL + i.areasConver <- NULL + + antaresData$links[, ':=' (from = strsplit(link, split = " - " )[[1]][1], to = strsplit(link, split = " - " )[[1]][2]), by = .(link)] diff --git a/R/neighbours.R b/R/neighbours.R index 20cc794..cf37e4a 100644 --- a/R/neighbours.R +++ b/R/neighbours.R @@ -61,6 +61,9 @@ addNeighbours <- function(antaresData = NULL){ addNeighbours(antaresData$areas) return(invisible(antaresData)) } + #R CMD Check, null variable + i.neighbours <- NULL + resAttr <- attributes(antaresData) virtualAreas <- resAttr$virtualNodes$storageFlexibility From a0758079b4fda2d2cb4be4b0eebc6c82be1b4455 Mon Sep 17 00:00:00 2001 From: zawam Date: Wed, 28 Nov 2018 14:38:17 +0100 Subject: [PATCH 25/26] add some useful functions --- R/zzz.R | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 148 insertions(+), 3 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 686bbc0..666b979 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -122,11 +122,12 @@ globalVariables( .idCols <- antaresRead:::.idCols .addClassAndAttributes <- antaresRead:::.addClassAndAttributes .groupByDistrict <- antaresRead:::.groupByDistrict -.check_x <- antaresRead:::.check_x -.h5Antares_edit_variable <- antaresRead:::.h5Antares_edit_variable +#TODO add after antaresRead 2.2.2 +#.check_x <- antaresRead:::.check_x +#.h5Antares_edit_variable <- antaresRead:::.h5Antares_edit_variable #.skipFunctionH5 <- antaresRead:::.skipFunctionH5 #.check_if_h5_is_in_tmp <- antaresRead:::.check_if_h5_is_in_tmp -.isSimOpts <- antaresRead:::.isSimOpts +#.isSimOpts <- antaresRead:::.isSimOpts .get_by_area <- antaresRead:::.get_by_area .get_by_link <- antaresRead:::.get_by_link @@ -289,3 +290,147 @@ pkgEnv$processDispo <- data.frame( } return(clDes) } + +#TODO DEL after antaresRead 2.2.2 +#' Test antaresData +#' +#' @param x if x is antaresData class +#' +#' @noRd +.isAntaresData <- function(x){ + "antaresData" %in% class(x) +} + +#TODO DEL after antaresRead 2.2.2 +.check_x <- function(x = NULL){ + if ("list" %in% class(x)){ + for (elementI in x){ + .check_x(elementI) + } + }else{ + if (!(.isSimOpts(x) | .isAntaresData(x))){ + stop(paste0(substitute(x), + " should be an object of class 'antaresData' (or 'simOptions') created with 'readAntares()' (or 'setSimulationPath()')")) + }else{ + return(TRUE) + } + } +} + +#TODO DEL after antaresRead 2.2.2 +#' edit h5 file for TEST +#' currently for all data except clusters +#' +#' @param pathH5 path H5 file +#' @param instanceData character name of one instance +#' @param classData character name of class instance +#' @param timeId timeId to change +#' @param antVar antares Variable to change +#' @param newValue the newValue +#' +#' @noRd +.h5Antares_edit_variable <- function(pathH5 = NULL, + instanceData = NULL, + classData = NULL, + timeId = 1, + antVar = NULL, + newValue = NULL, + mcYear = NULL, + allTimeId = FALSE, + timeStep = "hourly"){ + + if (is.null(instanceData) | is.null(classData)){ + stop("instanceData and classData must be set together") + } + + if (classData=="areas"){ + classDataS <- "area" + }else if(classData=="links"){ + classDataS <- "link" + }else{ + classDataS <- "district" + } + + if (is.null(mcYear)){ + typeOfData <- "/mcAll" + }else{ + typeOfData <- "/mcInd" + } + timeStepType <- paste0("/",paste(timeStep, classData, sep = "/")) + typeOfDataTime <- paste0(timeStepType, typeOfData) + nameStructure <- paste0(typeOfDataTime, "/structure") + + H5locAntaresh5 <- rhdf5::H5Fopen(name = pathH5) + resStruc <- rhdf5::h5ls(H5locAntaresh5) + dimData <- resStruc[ resStruc$group == typeOfDataTime & resStruc$name == "data", ]$dim + hourlyDataStructure <- rhdf5::h5read(H5locAntaresh5, name = nameStructure) + + indexCateroryInstance <- grep(instanceData, hourlyDataStructure[[classDataS]])[1] + + indexAntVar <- grep(antVar, hourlyDataStructure$variable)[1] + if(is.na(indexAntVar)){ + indexAntVar <- grep(antVar, hourlyDataStructure$reCalcVar)[1] + if(is.na(indexAntVar)){ + stop("error index") + }else{ + indexAntVar <- indexAntVar + length(hourlyDataStructure$variable) + } + } + if(allTimeId){ + maxTimeId <- as.integer(strsplit(dimData, "x")[[1]][1]) + indexTimeId <- 1:maxTimeId + }else{ + indexTimeId <- timeId + } + + if (is.null(mcYear)){ + indexMcYear <- 1 + }else{ + indexMcYear <- grep(mcYear, hourlyDataStructure$mcYear)[1] + } + + listIndex <- list(indexTimeId, indexAntVar, indexCateroryInstance, indexMcYear) + #debug print(listIndex) + + hourlyData <- rhdf5::h5read( + H5locAntaresh5, + name = paste0(typeOfDataTime, "/data"), + index = listIndex) + + hourlyData[,,,] <- newValue + + rhdf5::h5writeDataset.array( + obj = hourlyData, + h5loc = H5locAntaresh5, + name = paste0(typeOfDataTime, "/data"), + index = listIndex + ) + + rhdf5::H5Fclose(h5file = H5locAntaresh5) + rhdf5::h5closeAll() +} + + +#' Test opst +#' +#' @param test if x is simOptions class +#' +#' @noRd +.isSimOpts <- function(x){ + if ("simOptions" %in% class(x)){ + if (!is.null(x$h5path)){ + if (!file.exists(x$h5path)){ + warning(paste0("h5file does not exists for this study :", + x$studyName)) + return(FALSE) + }else{ + return(TRUE) + } + }else{ + #opts but no h5 (TXT) + return(TRUE) + } + }else{ + return(FALSE) + } +} From 5db4769460ae1d14c4ea7ffbcd9a7b927184b841 Mon Sep 17 00:00:00 2001 From: zawam Date: Wed, 28 Nov 2018 14:55:33 +0100 Subject: [PATCH 26/26] update branch antaresRead --- .travis.yml | 2 +- appveyor.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 21b019d..2d690e0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -22,7 +22,7 @@ r: r_github_packages: - - rte-antares-rpackage/antaresRead@develop + - rte-antares-rpackage/antaresRead@master # - hadley/devtools#1263 #before - Bioconductor-mirror/zlibbioc # - Bioconductor-mirror/rhdf5 diff --git a/appveyor.yml b/appveyor.yml index ec5e63c..7e06aff 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -29,7 +29,7 @@ build_script: # - ./travis-tool.sh install_github Bioconductor-mirror/rhdf5 #after - travis-tool.sh install_bioc_deps - - ./travis-tool.sh install_github rte-antares-rpackage/antaresRead@develop + - ./travis-tool.sh install_github rte-antares-rpackage/antaresRead@master test_script: - travis-tool.sh run_tests