tests/testthat/test-createGRiwrm.R

In inrae/airGRiwrm: 'airGR' Integrated Water Resource Management

test_that("extra columns work (#64)", {
  text = "id_amont	lambert2.x	lambert2.y	area	nom	id_aval	distance_aval	model
H8100021	537912.994	2455749.314	64420.94	La Seine à Vernon	NA	NA	RunModel_CemaNeigeGR4J
H7900010	578113	2437649	61642.28	La Seine à Poissy	H8100021	76.28	RunModel_CemaNeigeGR4J
H5920010	602213	2427449	43824.66	La Seine à Paris [Austerlitz après création lacs]	H7900010	82.26	RunModel_CemaNeigeGR4J"

  BS_reseau <- read.csv(text = text, sep = "\t")

  expect_s3_class(CreateGRiwrm(
    BS_reseau,
    cols = list(
      id = "id_amont",
      down = "id_aval",
      length = "distance_aval"
    ),
    keep_all = TRUE
  ),
  "GRiwrm")

})

# Setup a simple data.frame for GRiwrm
nodes <- loadSevernNodes()

test_that("Hydrological model nodes must have numeric area", {
  nodes$area[nodes$id == "54057"] <- NA
  expect_error(CreateGRiwrm(nodes),
               regexp = "hydrological")
})

test_that("Duplicated nodes",  {
  nodes <- rbind(nodes, nodes[4,])
  expect_error(CreateGRiwrm(nodes),
               regexp = "Duplicated nodes detected")
})

test_that("Ungauged nodes without gauged node at downstream should throw an error", {
  nodes$model[nodes$id == "54057"] <- "Ungauged"
  expect_error(CreateGRiwrm(nodes),
               regexp = "downstream the node")
})

test_that("Diversion node", {
  nodes <- rbind(nodes,
                 data.frame(id = "54029", down = "54002", length = 50, area = NA, model = "Diversion"))
  expect_s3_class(CreateGRiwrm(nodes), "GRiwrm")
  n99 <- nodes
  n99$area[n99$model == "Diversion"] <- 99
  expect_error(CreateGRiwrm(n99),
               regexp = "Diversion node must have its area")
  n_orphan <- nodes
  n_orphan$id[n_orphan$model == "Diversion"] <- "54999"
  expect_error(CreateGRiwrm(n_orphan),
               regexp = "Diversion node must have the same `id` of")
})

test_that("Allow several downstream ends", {
  nodes <- rbind(nodes,
                 data.frame(id = "54029", down = NA, length = NA, area = NA, model = "Diversion"))
  expect_s3_class(CreateGRiwrm(nodes), "GRiwrm")
})

test_that("Derivated ungauged node without downstream node should have derivated node as donor", {
  nodes <- loadSevernNodes()
  nodes <- nodes[nodes$id %in% c("54095", "54001", "54032"), ]
  nodes[nodes$id %in% c("54032", "54001"), c("down", "length")] <- NA
  nodes$model[nodes$id %in% c("54095", "54001")] <- "Ungauged"
  nodes <- rbind(nodes,
                 data.frame(id = "54001", down = "54032", length = 45, area = NA, model = "Diversion"))
  g <- CreateGRiwrm(nodes)
  expect_equal(g$donor, c("54032", "54032", NA, "54032"))
})

test_that("Reservoir between ungauged and gauged node should be in ungauged cluster", {
  # Reservoir between Ungauged and gauged nodes
  n_rsrvr$model[n_rsrvr$id == "54095"] <- "Ungauged"
  g <- CreateGRiwrm(n_rsrvr) # Network provided by helper_RunModel_Reservoir.R
  expect_equal(unique(g$donor), "54001")
})

test_that("Several Diversion on same node should raise error", {
  nodes <- n_rsrvr
  nodes <- rbind(nodes,
                 data.frame(id = rep("Dam", 2),
                            down = rep(as.character(NA), 2),
                            length = rep(as.numeric(NA), 2),
                            area = rep(as.numeric(NA), 2),
                            model = rep("Diversion", 2)))
  expect_error(CreateGRiwrm(nodes),
               regexp = "Diversion")
})

test_that("Upstream donor works", {
  nupd <- loadSevernNodes()
  nupd$donor[nupd$id == "54032"] <- "Wrong_node"
  expect_error(CreateGRiwrm(nupd),
               regexp = "The 'donor' id Wrong_node is not found in the 'id' column")
  nupd$donor[nupd$id == "54032"] <- "54001"
  nupd$model[nupd$id == "54032"] <- "Ungauged"
  g <- CreateGRiwrm(nupd)
  expect_equal(g$donor[g$id == "54032"], "54001")
  nupd$donor[nupd$id == "54002"] <- "54029"
  nupd$model[nupd$id == "54002"] <- "Ungauged"
  g <- CreateGRiwrm(nupd)
  expect_equal(g$donor[g$id == "54002"], "54029")
})

test_that("Donor node can't be Ungauged nor DirectInjection nor Reservoir", {
  n <- loadSevernNodes()
  n$model[n$id == "54001"] <- "Ungauged"
  n$donor[n$id == "54001"] <- "54032"
  n$model[n$id == "54032"] <- "Ungauged"
  expect_error(CreateGRiwrm(n),
               regexp = "must be an hydrological model")
  n$model[n$id == "54032"] <- NA
  expect_error(CreateGRiwrm(n),
               regexp = "must be an hydrological model")
  n$model[n$id == "54032"] <- "RunModel_Reservoir"
  expect_error(CreateGRiwrm(n),
               regexp = "must be an hydrological model")
  n$donor[n$id == "54001"] <- NA
  n$donor[n$id == "54032"] <- "54032"
  expect_message(CreateGRiwrm(n),
                 regexp = "'54001' automatically gets the node '54057' as parameter donor")
})