#21 add neighbours()

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)
 

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 = " ")))
+}

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)
+})
+