test_that("airGR::CreateInputsModel should work", {
  ## loading catchment data
  data(L0123001)

  ## preparation of InputsModel object
  InputsModel <- airGR::CreateInputsModel(
    FUN_MOD = RunModel_GR4J,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    PotEvap = BasinObs$E
  )

  expect_equal(
    CreateInputsModel(
      RunModel_GR4J,
      DatesR = BasinObs$DatesR,
      Precip = BasinObs$P,
      PotEvap = BasinObs$E
    ),
    InputsModel
  )
  expect_equal(
    CreateInputsModel(
      "RunModel_GR4J",
      DatesR = BasinObs$DatesR,
      Precip = BasinObs$P,
      PotEvap = BasinObs$E
    ),
    InputsModel
  )
})


l <- setUpCemaNeigeData()

test_that("CemaNeige data should be in InputsModel", {
  InputsModels <- suppressWarnings(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    )
  )
  l$DatesR <- as.data.frame(l$DatesR)
  lapply(InputsModels, function(IM) {
    lapply(c("DatesR", "Precip", "PotEvap"), function(varName) {
      expect_equal(IM[[varName]], l[[varName]][, 1])
    })
    expect_named(IM$LayerPrecip, paste0("L", seq(1, 5)))
    expect_named(IM$LayerTempMean, paste0("L", seq(1, 5)))
    expect_named(IM$LayerFracSolidPrecip, paste0("L", seq(1, 5)))
  })
})

test_that("downstream sub-catchment area should be positive", {
  l$griwrm$area[3] <- 360
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "must be greater than the sum of the areas"
  )
})

test_that("handles mix of with and without CemaNeige nodes", {
  l$griwrm[l$griwrm$id == "Down", "model"] <- "RunModel_GR4J"
  l$TempMean <- l$TempMean[, 1:2]
  l$ZInputs <- l$ZInputs[1:2]
  l$TempMean <- l$TempMean[, 1:2]
  l$HypsoData <- l$HypsoData[, 1:2]
  InputsModels <- suppressWarnings(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    )
  )
  expect_false(inherits(InputsModels$Down, "CemaNeige"))
  expect_null(InputsModels$Down$LayerPrecip)
})

test_that("throws error on wrong column name", {
  colnames(l$Precip)[1] <- "Up0"
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "column names must be included in.*Up0"
  )
  colnames(l$Precip) <- NULL
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "must have column names"
  )
})

test_that("throw error on missing column in inputs", {
  l$Precip <- l$Precip[, -1]
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "Precip is missing"
  )
})

test_that("throw error on wrong number of rows in inputs", {
  l$Precip <- l$Precip[-1, ]
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "number of rows and the length of 'DatesR' must be equal"
  )
})


test_that("throws error when missing CemaNeige data", {
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap
    ),
    regexp = "'TempMean' is missing"
  )
})

test_that("throws error when missing Qinf on node Direct Injection node", {
  l$griwrm$model[1] <- NA
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap
    ),
    regexp = "'Qinf' column names must at least contain"
  )

  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      Qinf = l$Qobs[, -1]
    ),
    regexp = "'Qinf' column names must at least contain"
  )
})

test_that("must works with node not related to an hydrological model", {
  l$griwrm$model[1] <- NA
  IM <- suppressWarnings(CreateInputsModel(
    l$griwrm,
    DatesR = l$DatesR,
    Precip = l$Precip,
    PotEvap = l$PotEvap,
    Qinf = l$Qobs[, 1, drop = FALSE],
    TempMean = l$TempMean,
    ZInputs = l$ZInputs,
    HypsoData = l$HypsoData
  ))
  expect_equal(
    IM[[2]]$Qupstream[, "Up1"],
    l$Qobs[, "Up1"] * l$griwrm[1, "area"] * 1E3
  )
  expect_equal(colnames(IM[[2]]$Qupstream), c("Up1", "Up2"))
})

test_that("Qinf on hydrological nodes should throw a warning", {
  expect_warning(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      Qinf = l$Qobs,
      TempMean = l$TempMean,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "columns in 'Qinf' are ignored since they don't match with"
  )
  l$griwrm$model[1] <- NA
  expect_s3_class(
    suppressWarnings(
      CreateInputsModel(
        l$griwrm,
        DatesR = l$DatesR,
        Precip = l$Precip,
        PotEvap = l$PotEvap,
        Qinf = l$Qobs[, 1, drop = F],
        TempMean = l$TempMean,
        ZInputs = l$ZInputs,
        HypsoData = l$HypsoData
      )
    ),
    "GRiwrmInputsModel"
  )
})

# data set up
e <- setupRunModel(runInputsModel = FALSE)
# variables are copied from environment 'e' to the current environment
# https://stackoverflow.com/questions/9965577/r-copy-move-one-environment-to-another
for (x in ls(e)) {
  assign(x, get(x, e))
}

test_that("Ungauged node should inherits its FUN_MOD from the downstream gauged node", {
  nodes$model[nodes$id == "54032"] <- "Ungauged"
  griwrmV05 <- CreateGRiwrm(nodes)
  IM <- suppressWarnings(
    CreateInputsModel(griwrmV05, DatesR, Precip, PotEvap)
  )
  expect_equal(IM[["54032"]]$FUN_MOD, "RunModel_GR4J")
})

test_that("Network with Diversion works", {
  n_div <- rbind(
    data.frame(
      id = "54029",
      down = "54002",
      length = 20,
      model = "Diversion",
      area = NA
    ),
    nodes
  )
  g <- CreateGRiwrm(n_div)
  Qinf = matrix(-1, nrow = length(DatesR), ncol = 1)
  colnames(Qinf) = "54029"
  IM <- suppressWarnings(
    CreateInputsModel(g, DatesR, Precip, PotEvap, Qinf)
  )
  expect_equal(IM[["54032"]]$UpstreamNodes, c("54029", "54001"))
  expect_equal(
    IM[["54032"]]$UpstreamVarQ,
    c("54029" = "Qsim_m3", "54001" = "Qsim_m3")
  )
  expect_equal(IM[["54002"]]$UpstreamNodes, "54029")
  expect_equal(IM[["54002"]]$UpstreamIsModeled, c("54029" = TRUE))
  expect_equal(IM[["54002"]]$UpstreamVarQ, c("54029" = "Qdiv_m3"))
  expect_equivalent(IM$`54029`$Qmin, matrix(0, nrow = length(DatesR), ncol = 1))
})

test_that("Diversion node: checks about 'Qmin'", {
  n_div <- rbind(
    nodes,
    data.frame(
      id = "54029",
      down = "54002",
      length = 50,
      area = NA,
      model = "Diversion"
    )
  )
  g <- CreateGRiwrm(n_div)
  Qinf = matrix(-1, nrow = length(DatesR), ncol = 1)
  colnames(Qinf) = "54029"
  expect_warning(
    CreateInputsModel(g, DatesR, Precip, PotEvap, Qinf = Qinf),
    regexp = "Zero values"
  )
  Qmin <- -Qinf
  IM <- CreateInputsModel(g, DatesR, Precip, PotEvap, Qinf = Qinf, Qmin = Qmin)
  expect_equivalent(IM$`54029`$Qmin, Qmin)
  QminNA <- Qmin
  QminNA[1] <- NA
  expect_error(
    CreateInputsModel(g, DatesR, Precip, PotEvap, Qinf = Qinf, Qmin = QminNA),
    regexp = "NA"
  )
  QminBadCol <- Qmin
  colnames(QminBadCol) = "54002"
  expect_error(
    CreateInputsModel(
      g,
      DatesR,
      Precip,
      PotEvap,
      Qinf = Qinf,
      Qmin = QminBadCol
    ),
    regexp = "columns that does not match with IDs of Diversion nodes"
  )
})

test_that("Node with upstream nodes having area = NA should return correct BasinsAreas", {
  nodes <- loadSevernNodes()
  # Reduce the network
  nodes <- nodes[nodes$id %in% c("54095", "54001"), ]
  nodes$down[nodes$id == "54001"] <- NA
  nodes$length[nodes$id == "54001"] <- NA
  # Insert a dam downstream the location the gauging station 54095
  # The dam is a direct injection node
  nodes$down[nodes$id == "54095"] <- "Dam"
  nodes$length[nodes$id == "54095"] <- 0
  nodes <- rbind(
    nodes,
    data.frame(
      id = "Dam",
      down = "54001",
      length = 42,
      area = NA,
      model = "RunModel_Reservoir"
    )
  )
  g <- CreateGRiwrm(nodes)
  Qinf <- data.frame(
    Dam = rep(0, 11536)
  )
  e <- setupRunModel(griwrm = g, runInputsModel = FALSE, Qinf = Qinf)
  for (x in ls(e)) {
    assign(x, get(x, e))
  }
  InputsModel <-
    suppressWarnings(CreateInputsModel(g, DatesR, Precip, PotEvap, Qinf = Qinf))
  expect_equal(sum(InputsModel$`54001`$BasinAreas), g$area[g$id == "54001"])
})

test_that("Use of Qinf for Qrelease should raise a warning", {
  g <- CreateGRiwrm(n_rsrvr)
  e <- setupRunModel(griwrm = g, runInputsModel = FALSE)
  for (x in ls(e)) {
    assign(x, get(x, e))
  }
  expect_warning(CreateInputsModel(
    griwrm,
    DatesR,
    Precip,
    PotEvap,
    TempMean = TempMean,
    Qinf = Qinf_rsrvr
  ))
})

test_that("ZInputs, PrecipScale, Nlayers with no names should trigger an error", {
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      PrecipScale = c(TRUE, FALSE),
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "PrecipScale.*no names found"
  )
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      NLayers = c(5, 5),
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "NLayers.*no names found"
  )
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      ZInputs = 100,
      HypsoData = l$HypsoData
    ),
    regexp = "ZInputs.*no names found"
  )
  expect_error(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      PrecipScale = c(
        '54057' = TRUE,
        '54032' = TRUE,
        '54001' = FALSE,
        '54095' = FALSE,
        '54002' = TRUE,
        '54029' = TRUE
      ),
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    ),
    regexp = "All 'PrecipScale' names"
  )
})

test_that("PrecipScale should accept assignation by node #187", {
  PrecipScale <- c(
    'Up1' = TRUE,
    'Up2' = TRUE,
    'Down' = FALSE
  )
  InputsModel <- suppressWarnings(
    CreateInputsModel(
      l$griwrm,
      DatesR = l$DatesR,
      Precip = l$Precip,
      PotEvap = l$PotEvap,
      TempMean = l$TempMean,
      PrecipScale = PrecipScale,
      ZInputs = l$ZInputs,
      HypsoData = l$HypsoData
    )
  )
  expect_equal(InputsModel$Up1$LayerPrecip, InputsModel$Up2$LayerPrecip)
  # LayerPrecip should be different for Up1 and Down
  expect_false(all(
    rowMeans(as.data.frame(InputsModel$Down$LayerPrecip)) ==
      rowMeans(as.data.frame(InputsModel$Up1$LayerPrecip))
  ))
  # PrecipScale = TRUE => mean of the precipitation is kept to the original value
  expect_equal(
    rowMeans(as.data.frame(InputsModel$Up1$LayerPrecip)),
    l$Precip[, "Up1"]
  )
})