tests/testthat/test_suitability_sowmonth.R

In alstat/ALUES: Agricultural Land Use Evaluation System

library(testthat)
library(ALUES)

# Water
x1 <- LaoCaiWater
y1 <- RICEIWWater

suit_ <- suitability(x1, y1, interval = "unbias", sow_month = 3)
test_that("Sowing Month:", expect_equal(suit_$`Factors Evaluated`, c("Mar", "Apr", "May", "Jun")))

suit_ <- suitability(x1, y1, interval = "unbias", sow_month = 11)
test_that("Sowing Month:", expect_equal(suit_$`Factors Evaluated`, c("Nov", "Dec", "Jan", "Feb")))

# Temperature
x1 <- LaoCaiTemp
y1 <- BARLEYTemp

suit_ <- suitability(x1, y1, interval = "unbias", sow_month = 6)
test_that("Sowing Month:", expect_equal(suit_$`Factors Evaluated`, c("Jul", "Aug", "Sep")))

suit_ <- suitability(x1, y1, interval = "unbias", sow_month = 11)
test_that("Sowing Month:", expect_equal(suit_$`Factors Evaluated`, c("Dec", "Jan", "Feb")))

# library(testthat)
# Water

library(ALUES)

# NA PRESENCE
suit_ <- suitability(LaoCaiLT, ALFALFASoil, interval="unbias")
test_that("Parameter name present:", expect_equal(suit_$`Factors Evaluated`[1], "SoilTe"))
test_that("Parameter scores NA all:",
          expect_equal(sum(is.na(suit_$`Suitability Score`["SoilTe"])),
          nrow(suit_$`Suitability Score`["SoilTe"])))
test_that("Parameter classes NA all:",
          expect_equal(sum(is.na(suit_$`Suitability Class`["SoilTe"])),
                       nrow(suit_$`Suitability Class`["SoilTe"])))
test_that("Parameter Minimum NA:",
          expect_true(is.na(suit_$`Factors' Minimum Values`["SoilTe"])))
test_that("Parameter Maximum NA:",
          expect_true(is.na(suit_$`Factors' Maximum Values`["SoilTe"])))

# WARNINGS
test_that("Expecting Warning", expect_warning(suitability(LaoCaiLT, ALFALFASoil)))

# ------------------------------
# CASE A
# ------------------------------
# Right Face Triangular MF

LaoCaiLT2 <- LaoCaiLT[5:6,]
suit_ <- suitability(LaoCaiLT2, SOYASoil, interval="unbias")
right_tri <- function (r) {
  x <- LaoCaiLT2[r,"CFragm"]; Min <- 0
  reqScore <- as.numeric(SOYASoil[1,2:7])
  clnScore <- rev(reqScore[complete.cases(reqScore)])
  Max <- clnScore[length(clnScore)] + ((diff(clnScore[1:2]) + diff(clnScore[2:3])) / 2)
  score <- (Max - x) / (Max - Min)

  l1 = 0; l2 = (Max - clnScore[3]) / (Max - Min); l3 = (Max - clnScore[2]) / (Max - Min); l4 = (Max - clnScore[1]) / (Max - Min); l5 = 1;
  if ((score >= l1) && (score < l2)) {
    class_ <- "N"
  } else if ((score >= l2) && (score < l3)) {
    class_ <- "S3"
  } else if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "NA"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Score`["CFragm"][1,], right_tri(1)[["score"]]))
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Class`["CFragm"][1,], right_tri(1)[["class"]]))
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Score`["CFragm"][2,], right_tri(2)[["score"]]))
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Class`["CFragm"][2,], right_tri(2)[["class"]]))


LaoCaiLT3 <- LaoCaiLT[5:6,]
LaoCaiLT3[1,2] <- 80
suit_ <- suitability(LaoCaiLT3, SOYASoil, interval="unbias")
right_tri <- function (r) {
  x <- LaoCaiLT3[r,"CFragm"]; Min <- 0
  reqScore <- as.numeric(SOYASoil[1,2:7])
  clnScore <- rev(reqScore[complete.cases(reqScore)])
  Max <- clnScore[length(clnScore)] + ((diff(clnScore[1:2]) + diff(clnScore[2:3])) / 2)

  score <- (Max - x) / (Max - Min)

  l1 = 0; l2 = (Max - clnScore[3]) / (Max - Min); l3 = (Max - clnScore[2]) / (Max - Min); l4 = (Max - clnScore[1]) / (Max - Min); l5 = 1;
  if ((score < Min) || (score > Max)) {
    class_ <- "N"; score <- 0
  }

  if ((score >= l1) && (score < l2)) {
    class_ <- "N"
  } else if ((score >= l2) && (score < l3)) {
    class_ <- "S3"
  } else if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "NA"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Score`["CFragm"][1,], right_tri(1)[["score"]]))
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Class`["CFragm"][1,], right_tri(1)[["class"]]))
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Score`["CFragm"][2,], right_tri(2)[["score"]]))
test_that("Case A: Triangular", expect_equal(suit_$`Suitability Class`["CFragm"][2,], right_tri(2)[["class"]]))

# Right Face Trapezoidal MF
LaoCaiLT3 <- LaoCaiLT[5:6,]
LaoCaiLT3[1,2] <- 80
suit_ <- suitability(LaoCaiLT3, SOYASoil, mf="trapezoidal", interval="unbias")
right_tra <- function (r) {
  x <- LaoCaiLT3[r,"CFragm"]; Min <- 0
  reqScore <- as.numeric(SOYASoil[1,2:7])
  clnScore <- rev(reqScore[complete.cases(reqScore)])
  Max <- clnScore[length(clnScore)] + ((diff(clnScore[1:2]) + diff(clnScore[2:3])) / 2)
  if ((x >= Min) && (x < clnScore[1])) {
    score <- 1; class_ <- "S1"
  } else if ((x < Min) || (x > Max)) {
    score <- 0; class_ <- "N"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Score`["CFragm"][1,], right_tra(1)[["score"]]))
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Class`["CFragm"][1,], right_tra(1)[["class"]]))
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Score`["CFragm"][2,], right_tra(2)[["score"]]))
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Class`["CFragm"][2,], right_tra(2)[["class"]]))

LaoCaiLT3 <- LaoCaiLT[5:6,]
LaoCaiLT3[1,2] <- 80
LaoCaiLT3[2,2] <- 25
suit_ <- suitability(LaoCaiLT3, SOYASoil, mf="trapezoidal", interval="unbias")
right_tra <- function (r) {
  x <- LaoCaiLT3[r,"CFragm"]; Min <- 0
  reqScore <- as.numeric(SOYASoil[1,2:7])
  clnScore <- rev(reqScore[complete.cases(reqScore)])
  Max <- clnScore[length(clnScore)] + ((diff(clnScore[1:2]) + diff(clnScore[2:3])) / 2)
  if ((x >= Min) && (x < clnScore[1])) {
    score <- 1; class_ <- "S1"
  } else if ((x < Min) || (x > Max)) {
    score <- 0; class_ <- "N"
  } else if ((x > clnScore[1]) && (x <= Max)) {
    score <- (Max - x) / (Max - clnScore[1])
    l1 = 0; l2 = (Max - clnScore[3]) / (Max - clnScore[1]); l3 = (Max - clnScore[2]) / (Max - clnScore[1]); l4 = (Max - clnScore[1]) / (Max - clnScore[1]); l5 = 1;
    if ((score >= l1) && (score < l2)) {
      class_ <- "N"
    } else if ((score >= l2) && (score < l3)) {
      class_ <- "S3"
    } else if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Score`["CFragm"][1,], right_tra(1)[["score"]]))
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Class`["CFragm"][1,], right_tra(1)[["class"]]))
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Score`["CFragm"][2,], right_tra(2)[["score"]]))
test_that("Case A: Trapezoidal", expect_equal(suit_$`Suitability Class`["CFragm"][2,], right_tra(2)[["class"]]))

# Right Face Gaussian MF
suit_ <- suitability(LaoCaiLT3, SOYASoil[1:3,], mf="gaussian", interval="unbias")
right_gau<- function (r) {
  x <- LaoCaiLT3[r,"CFragm"]; sigma <- 1
  reqScore <- as.numeric(SOYASoil[1,2:7])
  clnScore <- rev(reqScore[complete.cases(reqScore)])
  Min <- 0
  score <- exp((-1 / 2) * `^`(((x - Min) / sigma), 2))

  l1 <- 0; l2 <- exp((-1 / 2) * `^`(((clnScore[3] - Min) / sigma), 2))
  l3 <- exp((-1 / 2) * `^`(((clnScore[2] - Min) / sigma), 2))
  l4 <- exp((-1 / 2) * `^`(((clnScore[1] - Min) / sigma), 2))
  l5 <- 1
  if ((score >= l1) && (score < l2)) {
    class_ <- "N"
  } else if ((score >= l2) && (score < l3)) {
    class_ <- "S3"
  } else if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "NA"
  }

  return(list("score" = score, "class" = class_))
}
test_that("Case A: Gaussian", expect_equal(suit_$`Suitability Score`["CFragm"][1,], right_gau(1)[["score"]]))
test_that("Case A: Gaussian", expect_equal(suit_$`Suitability Class`["CFragm"][1,], right_gau(1)[["class"]]))
test_that("Case A: Gaussian", expect_equal(suit_$`Suitability Score`["CFragm"][2,], right_gau(2)[["score"]]))
test_that("Case A: Gaussian", expect_equal(suit_$`Suitability Class`["CFragm"][2,], right_gau(2)[["class"]]))

# ------------------------------
# CASE B
# ------------------------------
# Left Face Triangular MF
suit_ <- suitability(LaoCaiLT3, SOYASoil[8:nrow(SOYASoil),], interval = "unbias")
left_tri <- function(r) {
  x <- LaoCaiLT3[r,"OC"]
  reqScore <- as.numeric(SOYASoil[8,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- clnScore[length(clnScore)] + ((diff(clnScore[1:2]) + diff(clnScore[2:3])) / 2)
  Min <- 0
  score <- (x - Min) / (Max - Min)

  l1 = 0; l2 = (clnScore[1] - Min) / (Max - Min); l3 = (clnScore[2] - Min) / (Max - Min); l4 = (clnScore[3] - Min) / (Max - Min); l5 = 1;
  if ((score < Min) || (score > Max)) {
    class_ <- "N"; score <- 0
  }

  if ((score >= l1) && (score < l2)) {
    class_ <- "N"
  } else if ((score >= l2) && (score < l3)) {
    class_ <- "S3"
  } else if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "NA"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case B: Triangular", expect_equal(suit_$`Suitability Score`[1,"OC"], left_tri(1)[["score"]]))
test_that("Case B: Triangular", expect_equal(suit_$`Suitability Class`[1,"OC"], left_tri(1)[["class"]]))
test_that("Case B: Triangular", expect_equal(suit_$`Suitability Score`[2,"OC"], left_tri(2)[["score"]]))
test_that("Case B: Triangular", expect_equal(suit_$`Suitability Class`[2,"OC"], left_tri(2)[["class"]]))

# ------------------------------
# CASE C
# ------------------------------
# Full Triangular
suit_ <- suitability(MarinduqueLT[1:6,], SAFFLOWERSoil[6, ], interval = "unbias")
full_tri <- function () {
  x <- MarinduqueLT[6,"pHH2O"]; Min <- 0
  reqScore <- as.numeric(SAFFLOWERSoil[6,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- clnScore[length(clnScore)] + ((diff(clnScore[1:2]) + diff(clnScore[2:3])) / 2)
  if (x > Max) {
    return(0)
  }
}
test_that("Case C: Triangular", expect_equal(suit_$`Suitability Score`["pHH2O"][6,], full_tri()))

MarinduqueLTNew <- tail(MarinduqueLT)
MarinduqueLTNew[1, "pHH2O"] <- 7.6
MarinduqueLTNew[2, "pHH2O"] <- 5.6
suit_ <- suitability(MarinduqueLTNew, SAFFLOWERSoil, interval = "unbias")
full_tri <- function (r) {
  x <- MarinduqueLTNew[r,"pHH2O"]; Min <- 0
  reqScore <- as.numeric(SAFFLOWERSoil[6,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- clnScore[6] + ((diff(clnScore[1:2]) + diff(clnScore[2:3]) + diff(clnScore[3:4]) + diff(clnScore[4:5]) + diff(clnScore[5:6])) / 5)
  Mid <- mean(clnScore[3:4])
  Min <- 0

  if (x > Max) {
    score <- 0; class_ <- "N"
  } else if ((x > Mid) && (x <= Max)) {
    score <- (Max - x) / (Max - Mid)
    l1 = 0; l2 = (Max - clnScore[6]) / (Max - Mid); l3 = (Max - clnScore[5]) / (Max - Mid); l4 = (Max - clnScore[4]) / (Max - Mid); l5 = 1;
    if ((score >= l1) && (score < l2)) {
      class_ <- "N"
    } else if ((score >= l2) && (score < l3)) {
      class_ <- "S3"
    } else if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  } else if (x <= Mid) {
    score <- (x - Min) / (Mid - Min)
    l1 = 0; l2 = (clnScore[1] - Min) / (Mid - Min); l3 = (clnScore[2] - Min) / (Mid - Min); l4 = (clnScore[3] - Min) / (Mid - Min); l5 = 1;
    if ((score >= l1) && (score < l2)) {
      class_ <- "N"
    } else if ((score >= l2) && (score < l3)) {
      class_ <- "S3"
    } else if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  }

  return(list("score" = score, "class" = class_))
}
test_that("Case C: Triangular", expect_equal(suit_$`Suitability Score`["pHH2O"][1,], full_tri(1)[["score"]]))
test_that("Case C: Triangular", expect_equal(suit_$`Suitability Class`["pHH2O"][1,], full_tri(1)[["class"]]))
test_that("Case C: Triangular", expect_equal(suit_$`Suitability Score`["pHH2O"][2,], full_tri(2)[["score"]]))
test_that("Case C: Triangular", expect_equal(suit_$`Suitability Class`["pHH2O"][2,], full_tri(2)[["class"]]))

# # Full Trapezoidal
suit_ <- suitability(MarinduqueLTNew, SAFFLOWERSoil, mf="trapezoidal", interval = "unbias")
full_tra <- function (r) {
  x <- MarinduqueLTNew[r,"pHH2O"]; Min <- 0
  reqScore <- as.numeric(SAFFLOWERSoil[6,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[6] + ((diff(reqScore[1:2]) + diff(reqScore[2:3]) + diff(reqScore[3:4]) + diff(reqScore[4:5]) + diff(reqScore[5:6])) / 5)
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if ((x > Max) && (x < Min)) {
    score <- 0; class_ <- "N"
  } else if (x > reqScore[4]) {
    score <- (Max - x) / (Max - reqScore[4])
    l1 = 0; l2 = (Max - clnScore[6]) / (Max - clnScore[4]); l3 = (Max - clnScore[5]) / (Max - clnScore[6]); l4 = 1; l5 = 1;
  } else if ((x > Min) && (x <= reqScore[3])) {
    score <- (x - Min) / (reqScore[3] - Min)
    l1 = 0; l2 = (clnScore[1] - Min) / (clnScore[3] - Min); l3 = (clnScore[2] - Min) / (clnScore[3] - Min); l4 = 1; l5 = 1;
  }

  if ((score >= l1) && (score < l2)) {
    class_ <- "N"
  } else if ((score >= l2) && (score < l3)) {
    class_ <- "S3"
  } else if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "NA"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case C: Trapezoidal", expect_equal(suit_$`Suitability Score`["pHH2O"][1,], full_tra(1)[["score"]]))
test_that("Case C: Trapezoidal", expect_equal(suit_$`Suitability Class`["pHH2O"][1,], full_tra(1)[["class"]]))
test_that("Case C: Trapezoidal", expect_equal(suit_$`Suitability Score`["pHH2O"][2,], full_tra(2)[["score"]]))
test_that("Case C: Trapezoidal", expect_equal(suit_$`Suitability Class`["pHH2O"][2,], full_tra(2)[["class"]]))

# Full Gaussian
suit_ <- suitability(MarinduqueLTNew, SAFFLOWERSoil[6,], mf="gaussian", interval = "unbias")
full_gau <- function (r) {
  x <- MarinduqueLTNew[r,"pHH2O"]; Min <- 0; sigma <- 1
  reqScore <- as.numeric(SAFFLOWERSoil[6,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[6] + ((diff(reqScore[1:2]) + diff(reqScore[2:3]) + diff(reqScore[3:4]) + diff(reqScore[4:5]) + diff(reqScore[5:6])) / 5)
  Mid <- mean(reqScore[3:4])
  Min <- 0
  score <- exp((-1 / 2) * (((x - Mid) / sigma)^2))

  if ((x > Min) && (x <= Mid)) {
    l1 <- 0; l2 <- exp((-1 / 2) * `^`(((clnScore[1] - Mid) / sigma), 2))
    l3 <- exp((-1 / 2) * `^`(((clnScore[2] - Mid) / sigma), 2))
    l4 <- exp((-1 / 2) * `^`(((clnScore[3] - Mid) / sigma), 2))
    l5 <- 1
  } else if ((x > Mid) && (x <= Max)) {
    l1 <- 0; l2 <- exp((-1 / 2) * `^`(((clnScore[6] - Mid) / sigma), 2))
    l3 <- exp((-1 / 2) * `^`(((clnScore[5] - Mid) / sigma), 2))
    l4 <- exp((-1 / 2) * `^`(((clnScore[4] - Mid) / sigma), 2))
    l5 <- 1
  }

  if ((score >= l1) && (score < l2)) {
    class_ <- "N"
  } else if ((score >= l2) && (score < l3)) {
    class_ <- "S3"
  } else if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "NA"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Score`["pHH2O"][1,], full_gau(1)[["score"]]))
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Class`["pHH2O"][1,], full_gau(1)[["class"]]))
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Score`["pHH2O"][2,], full_gau(2)[["score"]]))
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Class`["pHH2O"][2,], full_gau(2)[["class"]]))


# Full Gaussian
MarinduqueLTNew[1, "pHH2O"] <- 7.3
MarinduqueLTNew[2, "pHH2O"] <- 6.8
suit_ <- suitability(MarinduqueLTNew, SAFFLOWERSoil[6,], mf="gaussian", interval = "unbias")
full_gau <- function (r) {
  x <- MarinduqueLTNew[r,"pHH2O"]; Min <- 0; sigma <- 1
  reqScore <- as.numeric(SAFFLOWERSoil[6,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[6] + ((diff(reqScore[1:2]) + diff(reqScore[2:3]) + diff(reqScore[3:4]) + diff(reqScore[4:5]) + diff(reqScore[5:6])) / 5)
  Mid <- mean(reqScore[3:4])
  Min <- 0
  score <- exp((-1 / 2) * (((x - Mid) / sigma)^2))

  return(score)
}
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Score`["pHH2O"][1,], full_gau(1)))
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Class`["pHH2O"][1,], "S2"))
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Score`["pHH2O"][2,], full_gau(2)))
test_that("Case C: Gaussian", expect_equal(suit_$`Suitability Class`["pHH2O"][2,], "S1"))

# # ------------------------------
# # CASE D
# # ------------------------------
# Triangular
MarinduqueLTNew <- MarinduqueLT[7:8,]
suit_ <- suitability(MarinduqueLTNew, BAMBOOSoil, interval = "unbias")
full_tri <- function (r) {
  x <- MarinduqueLTNew[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]

  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0; class_ <- "N"
  } else if (x > Mid) {
    score <- (Max - x) / (Max - Mid)
    l3 = (Max - clnScore[5]) / (Max - Mid); l4 = (Max - clnScore[4]) / (Max - Mid); l5 = 1;
    if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  } else if (x <= Mid) {
    score <- (x - Min) / (Mid - Min)
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tri(1)[["score"]]))
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_tri(1)[["class"]]))
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tri(2)[["score"]]))
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_tri(2)[["class"]]))

MarinduqueLTNew2 <- MarinduqueLT[7:8,]
MarinduqueLTNew2[1, 6] <- 5
suit_ <- suitability(MarinduqueLTNew2, ALUES::BAMBOOSoil, interval = "unbias")
full_tri <- function (r) {
  x <- MarinduqueLTNew2[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(ALUES::BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]

  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if (x > Mid) {
    score <- (Max - x) / (Max - Mid)
    l3 = (Max - clnScore[5]) / (Max - Mid); l4 = (Max - clnScore[4]) / (Max - Mid); l5 = 1;
    if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  } else if (x <= Mid) {
    score <- (x - Min) / (Mid - Min)
    l1 = 0; l2 = (clnScore[1] - Min) / (Mid - Min); l3 = (clnScore[2] - Min) / (Mid - Min); l4 = (clnScore[3] - Min) / (Mid - Min); l5 = 1;
    if ((score >= l1) && (score < l2)) {
      class_ <- "N"
    } else if ((score >= l2) && (score < l3)) {
      class_ <- "S3"
    } else if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  }

  return(list("score" = score, "class" = class_))
}
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tri(1)[["score"]]))
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_tri(1)[["class"]]))
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tri(2)[["score"]]))
test_that("Case D: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_tri(2)[["class"]]))

# Trapezoidal
suit_ <- suitability(MarinduqueLTNew, BAMBOOSoil, mf="trapezoidal", interval = "unbias")
full_tra <- function (r) {
  x <- MarinduqueLTNew[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0; class_ <- "N"
  } else if (x > reqScore[4]) {
    score <- (Max - x) / (Max - reqScore[4])
  } else if (x <= reqScore[3]) {
    score <- (x - Min) / (reqScore[3] - Min)
  } else if ((x > reqScore[3]) && (x <= reqScore[4])) {
    score <- 1; class_ <- "S1"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tra(1)[["score"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_tra(1)[["class"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tra(2)[["score"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_tra(2)[["class"]]))

suit_ <- suitability(MarinduqueLTNew2, ALUES::BAMBOOSoil, mf="trapezoidal", interval = "unbias")
full_tra <- function (r) {
  x <- MarinduqueLTNew2[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(ALUES::BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if (x > reqScore[4]) {
    score <- (Max - x) / (Max - reqScore[4])
  } else if (x <= reqScore[3]) {
    score <- (x - Min) / (reqScore[3] - Min)
    l1 = 0; l2 = (clnScore[1] - Min) / (clnScore[3] - Min); l3 = (clnScore[2] - Min) / (clnScore[3] - Min); l4 = 1; l5 = 1;

    if ((score >= l1) && (score < l2)) {
      class_ <- "N"
    } else if ((score >= l2) && (score < l3)) {
      class_ <- "S3"
    } else if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  } else if ((x > reqScore[3]) && (x <= reqScore[4])) {
    score <- 1; class_ <- "S1"
  }

  return(list("score" = score, "class" = class_))
}
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tra(1)[["score"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_tra(1)[["class"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tra(2)[["score"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_tra(2)[["class"]]))

MarinduqueLTNew2 <- MarinduqueLT[7:8,]
MarinduqueLTNew2[1, 6] <- 5

MarinduqueLTNew3 <- MarinduqueLTNew2
MarinduqueLTNew3[1, 6] <- 8.3
suit_ <- suitability(MarinduqueLTNew3, ALUES::BAMBOOSoil, mf="trapezoidal", interval = "unbias")
full_tra <- function (r) {
  x <- MarinduqueLTNew3[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(ALUES::BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if ((x > reqScore[4]) && (x <= Max)) {
    score <- (Max - x) / (Max - reqScore[4])
    l3 = (Max - clnScore[5]) / (Max - clnScore[4]); l4 = 1; l5 = 1;
    if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if (score >= l4) {
      class_ <- "S1"
    } else {
      class_ <- "N"
    }
  } else if (x <= reqScore[3]) {
    score <- (x - Min) / (reqScore[3] - Min)
    l1 = 0; l2 = (clnScore[1] - Min) / (clnScore[3] - Min); l3 = (clnScore[2] - Min) / (clnScore[3] - Min); l4 = 1; l5 = 1;
    if ((score >= l1) && (score < l2)) {
      class_ <- "N"
    } else if ((score >= l2) && (score < l3)) {
      class_ <- "S3"
    } else if ((score >= l3) && (score < l4)) {
      class_ <- "S2"
    } else if ((score >= l4) && (score <= l5)) {
      class_ <- "S1"
    } else {
      class_ <- "NA"
    }
  } else if ((x > reqScore[3]) && (x <= reqScore[4])) {
    score <- 1; class_ <- "S1"
  }

  return(list("score" = score, "class" = class_))
}
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tra(1)[["score"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_tra(1)[["class"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tra(2)[["score"]]))
test_that("Case D: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_tra(2)[["class"]]))

# Gaussian
MarinduqueLTNew <- MarinduqueLT[7:8,]
suit_ <- suitability(MarinduqueLTNew, BAMBOOSoil, mf="gaussian", interval = "unbias")
full_gau <- function (r) {
  x <- MarinduqueLTNew[r,"SoilTe"]; Min <- 0; sigma <- 1
  reqScore <- as.numeric(BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  score <- exp((-1 / 2) * (((x - Mid) / sigma)^2))

  if ((x > Min) && (x <= Mid)) {
    l1 <- 0; l2 <- exp((-1 / 2) * `^`(((clnScore[1] - Mid) / sigma), 2))
    l3 <- exp((-1 / 2) * `^`(((clnScore[2] - Mid) / sigma), 2))
    l4 <- exp((-1 / 2) * `^`(((clnScore[3] - Mid) / sigma), 2))
    l5 <- 1
  } else if ((x > Mid)) {
    l3 <- exp((-1 / 2) * `^`(((clnScore[5] - Mid) / sigma), 2))
    l4 <- exp((-1 / 2) * `^`(((clnScore[4] - Mid) / sigma), 2))
    l5 <- 1
  }

  if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "N"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_gau(1)[["score"]]))
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_gau(1)[["class"]]))
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_gau(2)[["score"]]))
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_gau(2)[["class"]]))

suit_ <- suitability(MarinduqueLTNew2, ALUES::BAMBOOSoil, mf="gaussian", interval = "unbias")
print("ooetijeotjo")
print(suit)
full_gau <- function (r) {
  x <- MarinduqueLTNew2[r,"SoilTe"]; Min <- 0; sigma <- 1
  reqScore <- as.numeric(ALUES::BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[5]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  score <- exp((-1 / 2) * (((x - Mid) / sigma)^2))

  if ((x > Min) && (x <= Mid)) {
    l1 <- 0; l2 <- exp((-1 / 2) * `^`(((clnScore[1] - Mid) / sigma), 2))
    l3 <- exp((-1 / 2) * `^`(((clnScore[2] - Mid) / sigma), 2))
    l4 <- exp((-1 / 2) * `^`(((clnScore[3] - Mid) / sigma), 2))
    l5 <- 1
  } else if ((x > Mid)) {
    l3 <- exp((-1 / 2) * `^`(((clnScore[5] - Mid) / sigma), 2))
    l4 <- exp((-1 / 2) * `^`(((clnScore[4] - Mid) / sigma), 2))
    l5 <- 1
  }

  if ((score >= l3) && (score < l4)) {
    class_ <- "S2"
  } else if ((score >= l4) && (score <= l5)) {
    class_ <- "S1"
  } else {
    class_ <- "N"
  }
  return(list("score" = score, "class" = class_))
}
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_gau(1)[["score"]]))
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], full_gau(1)[["class"]]))
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_gau(2)[["score"]]))
test_that("Case D: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], full_gau(2)[["class"]]))

# ------------------------------
# CASE E
# ------------------------------
# Triangular
MarinduqueLTNew <- MarinduqueLT[7:8,]
BAMBOOSoil[3, 6] <- NA
BAMBOOSoil[3, 5] <- 9.0
BAMBOOSoilNew <- BAMBOOSoil
suit_ <- suitability(MarinduqueLTNew, BAMBOOSoilNew, interval="unbias")
r = 1
full_tri <- function (r) {
  x <- MarinduqueLTNew[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(BAMBOOSoilNew[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]

  Max <- reqScore[4]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if (x > Mid) {
    score <- (Max - x) / (Max - Mid)
  } else if (x <= Mid) {
    score <- (x - Min) / (Mid - Min)
  }
  return(score)
}

test_that("Case E: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], "N"))
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], "S1"))
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tri(1)))
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tri(2)))

# Triangular
MarinduqueLTNew2 <- MarinduqueLT[7:8,]
MarinduqueLTNew2[1, 6] <- 5
suit_ <- suitability(MarinduqueLTNew2, BAMBOOSoilNew, interval="unbias")
full_tri <- function (r) {
  x <- MarinduqueLTNew2[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(BAMBOOSoilNew[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]

  Max <- reqScore[4]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if (x > Mid) {
    score <- (Max - x) / (Max - Mid)
  } else if ((x > Min) && (x <= Mid)) {
    score <- (x - Min) / (Mid - Min)
  }

  return(score)
}
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tri(1)))
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], "S2"))
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tri(2)))
test_that("Case E: Triangular", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], "S1"))

# Trapezoidal
suit_ <- suitability(MarinduqueLTNew, BAMBOOSoilNew, mf="trapezoidal", interval="unbias")
full_tra <- function (r) {
  x <- MarinduqueLTNew[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[4]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if (x > reqScore[4]) {
    score <- (Max - x) / (Max - reqScore[4])
  } else if (x <= reqScore[3]) {
    score <- (x - Min) / (reqScore[3] - Min)
  } else if ((x > reqScore[3]) && (x <= reqScore[4])) {
    score <- 1
  }

  return(score)
}
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tra(1)))
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], "N"))
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tra(2)))
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], "S1"))

MarinduqueLTNew2 <- MarinduqueLT[7:8,]
MarinduqueLTNew2[1, 6] <- 5

suit_ <- suitability(MarinduqueLTNew2, BAMBOOSoilNew, mf="trapezoidal", interval="unbias")
full_tra <- function (r) {
  x <- MarinduqueLTNew2[r,"SoilTe"]; Min <- 0
  reqScore <- as.numeric(BAMBOOSoil[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[4]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  if (x > Max) {
    score <- 0
  } else if (x > reqScore[4]) {
    score <- (Max - x) / (Max - reqScore[4])
  } else if (x <= reqScore[3]) {
    score <- (x - Min) / (reqScore[3] - Min)
  } else if ((x > reqScore[3]) && (x <= reqScore[4])) {
    score <- 1; class_ = "S1"
  }


  return(score)
}
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_tra(1)))
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], "S2"))
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_tra(2)))
test_that("Case E: Trapezoidal", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], "S1"))

# Gaussian
suit_ <- suitability(MarinduqueLTNew, BAMBOOSoilNew, mf="gaussian", interval="unbias")
full_gau <- function (r) {
  x <- MarinduqueLTNew[r,"SoilTe"]; Min <- 0; sigma <- 1
  reqScore <- as.numeric(BAMBOOSoilNew[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[4]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  score <- exp((-1 / 2) * (((x - Mid) / sigma)^2))
  return(score)
}
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_gau(1)))
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], "N"))
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_gau(2)))
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], "S1"))

suit_ <- suitability(MarinduqueLTNew2, BAMBOOSoilNew, mf="gaussian", interval="unbias")
full_gau <- function (r) {
  x <- MarinduqueLTNew2[r,"SoilTe"]; Min <- 0; sigma <- 1
  reqScore <- as.numeric(BAMBOOSoilNew[3,2:7])
  clnScore <- reqScore[complete.cases(reqScore)]
  Max <- reqScore[4]
  Mid <- mean(reqScore[3:4])
  Min <- 0
  score <- exp((-1 / 2) * (((x - Mid) / sigma)^2))
  return(score)
}
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][1,], full_gau(1)))
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][1,], "S2"))
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Score`["SoilTe"][2,], full_gau(2)))
test_that("Case E: Gaussian", expect_equal(suit_$`Suitability Class`["SoilTe"][2,], "S1"))