From 733e32110c7bba9d80b0281c952aa7580d21628c Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 17 Aug 2023 17:49:33 +0200 Subject: [PATCH] For Review: add more than 2 levels in commercial rank, and select trees in this ascending order --- R/SpeciesCriteria.R | 12 +++++++----- R/commercialcriteriajoin.R | 20 ++++++++++---------- R/futurereserve.R | 2 +- R/harvestable.R | 10 +++++----- R/selected.R | 19 ++++++++++++++----- man/SpeciesCriteria.Rd | 12 +++++++----- man/selected.Rd | 8 +++++--- tests/testthat/test-commercialcriteriajoin.R | 12 ++++++------ tests/testthat/test-futurereserve.R | 6 +++--- tests/testthat/test-harvestable.R | 16 ++++++++-------- tests/testthat/test-selected.R | 6 +++--- 11 files changed, 69 insertions(+), 54 deletions(-) diff --git a/R/SpeciesCriteria.R b/R/SpeciesCriteria.R index 2f09d4a7..38c65035 100644 --- a/R/SpeciesCriteria.R +++ b/R/SpeciesCriteria.R @@ -8,12 +8,14 @@ #' \describe{ #' \item{CommercialName}{Vernacular/economic name (character)} #' \item{Genus}{Genus associated to the vernacular name (character)} -#' \item{Species}{Species (without genus part) associated to the vernacular name (character)} -#' \item{CommercialLevel}{Economic interest level ("1" principal economic species, -#' "2" species logged in a objective of diversification, "0" species -#' whose genus is covered by a commercial name, but which are not logged) (factor)} +#' \item{Species}{Species (without genus part) associated to the vernacular +#' name (character)} +#' \item{CommercialLevel}{Economic interest level (1: principal economic species, +#' 2 or more: species logged in a objective of diversification, 0: species +#' whose genus is covered by a commercial name, but which are not logged) (numeric)} #' \item{MinFD}{Minimum Felling Diameter, in centimeter (numeric)} -#' \item{UpMinFD}{Enhanced Minimum Felling Diameter (over-rich stand case), in centimeter (numeric)} +#' \item{UpMinFD}{Enhanced Minimum Felling Diameter (over-rich stand case), in +#' centimeter (numeric)} #' \item{MaxFD}{Maximum Felling Diameter, in centimeter (numeric)} #' \item{Aggregative}{Aggregative character of the species (logical)} #' ... diff --git a/R/commercialcriteriajoin.R b/R/commercialcriteriajoin.R index 388d1636..816729f3 100644 --- a/R/commercialcriteriajoin.R +++ b/R/commercialcriteriajoin.R @@ -84,8 +84,8 @@ commercialcriteriajoin <- function( mutate(CommercialName = ifelse(is.na(CommercialName.species), CommercialName.genus, CommercialName.species)) %>% dplyr::select(-CommercialName.species, -CommercialName.genus) %>% - mutate(CommercialLevel.species = as.character(CommercialLevel.species)) %>% - mutate(CommercialLevel.genus = as.character(CommercialLevel.genus)) %>% + # mutate(CommercialLevel.species = as.character(CommercialLevel.species)) %>% # remove for reviewer + # mutate(CommercialLevel.genus = as.character(CommercialLevel.genus)) %>% # remove for reviewer mutate(CommercialLevel = ifelse(is.na(CommercialLevel.species), CommercialLevel.genus, CommercialLevel.species)) %>% mutate(MinFD = ifelse(is.na(MinFD.species), MinFD.genus, MinFD.species)) %>% @@ -97,19 +97,19 @@ commercialcriteriajoin <- function( dplyr::select(-CommercialLevel.species, -CommercialLevel.genus, -MinFD.species, -MinFD.genus, -UpMinFD.species, -UpMinFD.genus, -MaxFD.species, -MaxFD.genus, -Aggregative.species, -Aggregative.genus) %>% - mutate(CommercialLevel = as.character(CommercialLevel)) %>% + # mutate(CommercialLevel = as.character(CommercialLevel)) %>% # remove for reviewer # Exceptions management (CommercialLevel == "0" in speciescriteria) - mutate(CommercialName = ifelse(CommercialLevel == "0", NA, CommercialName)) %>% - mutate(MinFD = ifelse(CommercialLevel == "0", NA, MinFD)) %>% - mutate(UpMinFD = ifelse(CommercialLevel == "0", NA, UpMinFD)) %>% - mutate(MaxFD = ifelse(CommercialLevel == "0", NA, MaxFD)) %>% - mutate(Aggregative = ifelse(CommercialLevel == "0", NA, Aggregative)) + mutate(CommercialName = ifelse(CommercialLevel == 0, NA, CommercialName)) %>% # in numeric for reviewer + mutate(MinFD = ifelse(CommercialLevel == 0, NA, MinFD)) %>% + mutate(UpMinFD = ifelse(CommercialLevel == 0, NA, UpMinFD)) %>% + mutate(MaxFD = ifelse(CommercialLevel == 0, NA, MaxFD)) %>% + mutate(Aggregative = ifelse(CommercialLevel == 0, NA, Aggregative)) inventory <- inventory %>% - mutate(CommercialLevel = ifelse(is.na(CommercialLevel), "0", CommercialLevel)) %>% - mutate(CommercialLevel = factor(as.character(CommercialLevel))) + mutate(CommercialLevel = ifelse(is.na(CommercialLevel), 0, CommercialLevel)) # %>% + # mutate(CommercialLevel = factor(as.character(CommercialLevel))) # remove for reviewer if(nrow(inventory) != nrow(inventory0)) stop("The number of rows between the input inventory and the output inventory diff --git a/R/futurereserve.R b/R/futurereserve.R index 89409b5d..d7178cfc 100644 --- a/R/futurereserve.R +++ b/R/futurereserve.R @@ -111,7 +111,7 @@ futurereserve <- function( #Future: select essence and diameters inventory <- inventory %>% - mutate(LoggingStatus = ifelse(CommercialLevel == "1" & Selected != "1" & HarvestableZone == TRUE & + mutate(LoggingStatus = ifelse(CommercialLevel == 1 & Selected != "1" & HarvestableZone == TRUE & ((Up == "0" & (DBH >= advancedloggingparameters$FutureTreesMinDiameter & DBH < MinFD)) | (Up == "1" & diff --git a/R/harvestable.R b/R/harvestable.R index 261b1afc..12e3e4ab 100644 --- a/R/harvestable.R +++ b/R/harvestable.R @@ -162,7 +162,7 @@ harvestable <- function( # Calculation of spatial information (distance and slope) SpatInventory <- inventory %>% - dplyr::filter(CommercialLevel!= "0") %>% # only take commercial sp, the calculation time is long enough + dplyr::filter(CommercialLevel!= 0) %>% # only take commercial sp, the calculation time is long enough dplyr::filter(DBH >= MinFD & DBH <= MaxFD) # already selected commercial DBHs coordinates(SpatInventory) <- ~ Xutm + Yutm # transform the inventory into a spatial object by informing the coordinates @@ -263,9 +263,9 @@ harvestable <- function( # Essences selection HarverstableConditions <- # = 1 boolean vector if (diversification || (!diversification && specieslax)) { - inventory$CommercialLevel =="1"| inventory$CommercialLevel == "2" # now or maybe after we will diversify + inventory$CommercialLevel >0 # now or maybe after we will diversify } else if (!diversification && !specieslax) { - inventory$CommercialLevel == "1" # We will never diversify + inventory$CommercialLevel == 1 # We will never diversify } @@ -286,14 +286,14 @@ harvestable <- function( inventory <- inventory %>% mutate(LoggingStatus = ifelse(HarverstableConditions, #Under the above criteria, designate the harvestable species "harvestable", "non-harvestable")) %>% - mutate(LoggingStatus = ifelse(CommercialLevel == "0", #The non-commercial species are non-harvestable. + mutate(LoggingStatus = ifelse(CommercialLevel == 0, #The non-commercial species are non-harvestable. "non-harvestable", LoggingStatus)) %>% mutate(LoggingStatus = ifelse( !diversification & specieslax & #designate the secondarily harvestable species, because diversification only if necessary LoggingStatus == "harvestable" & - CommercialLevel == "2", + CommercialLevel >1, "harvestable2nd", LoggingStatus)) diff --git a/R/selected.R b/R/selected.R index 3091b59d..aa54c655 100644 --- a/R/selected.R +++ b/R/selected.R @@ -84,8 +84,10 @@ #' @examples #' data(Paracou6_2016) #' data(DTMParacou) +#' data(PlotMask) #' data(HarvestableAreaOutputsCable) #' data(MainTrails) +#' data(ForestZoneVolumeParametersTable) #' #' inventory <- addtreedim(cleaninventory(Paracou6_2016, PlotMask), #' volumeparameters = ForestZoneVolumeParametersTable) @@ -93,7 +95,7 @@ #' inventory <- commercialcriteriajoin(inventory, SpeciesCriteria) #' #' harvestableOutputs <- harvestable(inventory, topography = DTMParacou, -#' diversification = TRUE, specieslax = FALSE, +#' diversification = F, specieslax = T, #' plotslope = HarvestableAreaOutputsCable$PlotSlope, #' maintrails = MainTrails, #' harvestablepolygons = HarvestableAreaOutputsCable$HarvestablePolygons, @@ -104,8 +106,8 @@ #' HVinit <- harvestableOutputs$HVinit #' #' selecInventory <- selected(inventory, topography = DTMParacou, -#' scenario = "manual", fuel = "2", diversification = TRUE, -#' VO = 125, HVinit = HVinit, specieslax = FALSE, objectivelax = TRUE, +#' scenario = "manual", fuel = "2", diversification = T, +#' VO = 20, HVinit = HVinit, specieslax = T, objectivelax = T, #' advancedloggingparameters = loggingparameters())$inventory #' selected <- function( @@ -213,6 +215,7 @@ selected <- function( inventory <- inventory %>% mutate(Condition = ifelse(LoggingStatus == "harvestable2nd"|LoggingStatus == "harvestable",TRUE, FALSE)) %>% group_by(Condition) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) %>% mutate(VolumeCumSum = cumsum(TreeHarvestableVolume)) %>% ungroup() %>% @@ -250,6 +253,7 @@ selected <- function( inventory <- inventory %>% mutate(Condition = ifelse(LoggingStatus == "harvestable",TRUE, FALSE)) %>% group_by(Condition) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) %>% mutate(VolumeCumSum = cumsum(TreeHarvestableVolume)) %>% ungroup() %>% @@ -283,7 +287,7 @@ selected <- function( inventory <- inventory %>% mutate(LoggingStatus = ifelse(LoggingStatus == "harvestable" & - CommercialLevel == "1" & (DBH >= UpMinFD & DBH <= MaxFD), #designate the bigger individuals, when the plot is species-rich. + CommercialLevel == 1 & (DBH >= UpMinFD & DBH <= MaxFD), #designate the bigger individuals, when the plot is species-rich. "harvestableUp", LoggingStatus)) if (!diversification) { @@ -309,6 +313,7 @@ selected <- function( inventory <- inventory %>% mutate(Condition = ifelse(LoggingStatus == "harvestableUp", TRUE, FALSE)) %>% group_by(Condition) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) %>% mutate(VolumeCumSum = cumsum(TreeHarvestableVolume)) %>% ungroup() %>% @@ -331,6 +336,7 @@ selected <- function( inventory <- inventory %>% mutate(Condition = ifelse(LoggingStatus == "harvestableUp"|LoggingStatus == "harvestable",TRUE,FALSE)) %>% group_by(Condition) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) %>% mutate(VolumeCumSum = cumsum(TreeHarvestableVolume)) %>% ungroup() %>% @@ -353,7 +359,7 @@ selected <- function( # Increase the MinFD of the other economic species inventory <- inventory %>% - mutate(LoggingStatus = ifelse(LoggingStatus == "harvestable" & CommercialLevel == "2" & + mutate(LoggingStatus = ifelse(LoggingStatus == "harvestable" & CommercialLevel >1 & (DBH >= UpMinFD & DBH <= MaxFD), #designate preferred individuals of 2nd economic rank species too, when the plot is species-rich. "harvestableUp", LoggingStatus)) @@ -377,6 +383,7 @@ selected <- function( inventory <- inventory %>% mutate(Condition = ifelse(LoggingStatus == "harvestableUp"|LoggingStatus == "harvestable",TRUE,FALSE)) %>% group_by(Condition) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) %>% mutate(VolumeCumSum = cumsum(TreeHarvestableVolume)) %>% ungroup() %>% @@ -413,6 +420,7 @@ selected <- function( inventory <- inventory %>% mutate(Condition = ifelse(LoggingStatus == "harvestable", TRUE, FALSE)) %>% group_by(Condition) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) %>% mutate(VolumeCumSum = cumsum(TreeHarvestableVolume)) %>% ungroup() %>% @@ -435,6 +443,7 @@ selected <- function( (TreeHarvestableVolume > min & TreeHarvestableVolume <= MissingVolume), TRUE, FALSE)) %>% group_by(Crumbs) %>% + arrange(CommercialLevel) %>% # add for reviewer arrange(desc(TreeHarvestableVolume)) if(any(inventory$Crumbs)){ diff --git a/man/SpeciesCriteria.Rd b/man/SpeciesCriteria.Rd index 38dc941b..e9dca5f5 100644 --- a/man/SpeciesCriteria.Rd +++ b/man/SpeciesCriteria.Rd @@ -9,12 +9,14 @@ A tibble with 96 rows and 8 variables: \describe{ \item{CommercialName}{Vernacular/economic name (character)} \item{Genus}{Genus associated to the vernacular name (character)} -\item{Species}{Species (without genus part) associated to the vernacular name (character)} -\item{CommercialLevel}{Economic interest level ("1" principal economic species, -"2" species logged in a objective of diversification, "0" species -whose genus is covered by a commercial name, but which are not logged) (factor)} +\item{Species}{Species (without genus part) associated to the vernacular +name (character)} +\item{CommercialLevel}{Economic interest level (1: principal economic species, +2 or more: species logged in a objective of diversification, 0: species +whose genus is covered by a commercial name, but which are not logged) (numeric)} \item{MinFD}{Minimum Felling Diameter, in centimeter (numeric)} -\item{UpMinFD}{Enhanced Minimum Felling Diameter (over-rich stand case), in centimeter (numeric)} +\item{UpMinFD}{Enhanced Minimum Felling Diameter (over-rich stand case), in +centimeter (numeric)} \item{MaxFD}{Maximum Felling Diameter, in centimeter (numeric)} \item{Aggregative}{Aggregative character of the species (logical)} ... diff --git a/man/selected.Rd b/man/selected.Rd index 81d328db..f2652bb3 100644 --- a/man/selected.Rd +++ b/man/selected.Rd @@ -95,8 +95,10 @@ an unreached objective volume, or be abandoned ('objectivelax') \examples{ data(Paracou6_2016) data(DTMParacou) +data(PlotMask) data(HarvestableAreaOutputsCable) data(MainTrails) +data(ForestZoneVolumeParametersTable) inventory <- addtreedim(cleaninventory(Paracou6_2016, PlotMask), volumeparameters = ForestZoneVolumeParametersTable) @@ -104,7 +106,7 @@ volumeparameters = ForestZoneVolumeParametersTable) inventory <- commercialcriteriajoin(inventory, SpeciesCriteria) harvestableOutputs <- harvestable(inventory, topography = DTMParacou, -diversification = TRUE, specieslax = FALSE, +diversification = F, specieslax = T, plotslope = HarvestableAreaOutputsCable$PlotSlope, maintrails = MainTrails, harvestablepolygons = HarvestableAreaOutputsCable$HarvestablePolygons, @@ -115,8 +117,8 @@ inventory <- harvestableOutputs$inventory HVinit <- harvestableOutputs$HVinit selecInventory <- selected(inventory, topography = DTMParacou, -scenario = "manual", fuel = "2", diversification = TRUE, -VO = 125, HVinit = HVinit, specieslax = FALSE, objectivelax = TRUE, +scenario = "manual", fuel = "2", diversification = T, +VO = 20, HVinit = HVinit, specieslax = T, objectivelax = T, advancedloggingparameters = loggingparameters())$inventory } diff --git a/tests/testthat/test-commercialcriteriajoin.R b/tests/testthat/test-commercialcriteriajoin.R index 150f94ef..cc96d720 100644 --- a/tests/testthat/test-commercialcriteriajoin.R +++ b/tests/testthat/test-commercialcriteriajoin.R @@ -40,11 +40,11 @@ test_that("commercialcriteriajoin", { function(element) expect_type(element, "double")) expect_type(testinventory$CommercialName, "character") - expect_s3_class(testinventory$CommercialLevel, "factor") + expect_type(testinventory$CommercialLevel, "double") # Check that commercial sp have logging info, and non-commercial have not: TestCommercial <- testinventory %>% - filter(CommercialLevel == "0") + filter(CommercialLevel == 0) TestList <- list( # list the variables to check TestCommercial$CommercialName, @@ -56,7 +56,7 @@ test_that("commercialcriteriajoin", { function(element) expect_true(all(is.na(element)))) TestCommercial <- testinventory %>% - filter(CommercialLevel != "0") + filter(CommercialLevel != 0) TestList <- list( # list the variables to check TestCommercial$CommercialName, @@ -91,8 +91,8 @@ test_that("commercialcriteriajoin", { # check colonnes présentes et classe: -# CommercialName(character), CommercialLevel(factor), MinFD(numeric), UpMinFD(numeric), MaxFD(numeric) -# Quand CommercialLevel diff de "0" : CommercialName, MinFD, UpMinFD, MaxFD dif de NA +# CommercialName(character), CommercialLevel(numeric), MinFD(numeric), UpMinFD(numeric), MaxFD(numeric) +# Quand CommercialLevel diff de 0 : CommercialName, MinFD, UpMinFD, MaxFD dif de NA # Check species attribution exceptions -# Quand CommercialLevel == "0" : CommercialName, MinFD, UpMinFD, MaxFD == NA +# Quand CommercialLevel == 0 : CommercialName, MinFD, UpMinFD, MaxFD == NA diff --git a/tests/testthat/test-futurereserve.R b/tests/testthat/test-futurereserve.R index 26964775..d444e35a 100644 --- a/tests/testthat/test-futurereserve.R +++ b/tests/testthat/test-futurereserve.R @@ -29,12 +29,12 @@ test_that("futurereserve", { advancedloggingparameters = loggingparameters() - # Future = CommercialLevel == "1" + # Future = CommercialLevel == 1 FutureTrees <- testinventory %>% filter(LoggingStatus == "future") - expect_true(all(FutureTrees$CommercialLevel == "1" + expect_true(all(FutureTrees$CommercialLevel == 1 & ( (FutureTrees$Up == "0" & (FutureTrees$DBH >= advancedloggingparameters$FutureTreesMinDiameter & FutureTrees$DBH < FutureTrees$MinFD)) @@ -45,7 +45,7 @@ test_that("futurereserve", { ReserveTrees <- testinventory %>% filter(LoggingStatus =="reserve") - expect_true(all(ReserveTrees$CommercialLevel == "1" + expect_true(all(ReserveTrees$CommercialLevel == 1 & ( (ReserveTrees$Up == "0" & (ReserveTrees$DBH >= advancedloggingparameters$FutureTreesMinDiameter & ReserveTrees$DBH < ReserveTrees$MinFD)) diff --git a/tests/testthat/test-harvestable.R b/tests/testthat/test-harvestable.R index 327f8265..b6d1ebe9 100644 --- a/tests/testthat/test-harvestable.R +++ b/tests/testthat/test-harvestable.R @@ -55,32 +55,32 @@ test_that("harvestable", { expect_false(any(is.na(testinventory1$LoggingStatus))) expect_false(any(is.na(testinventory2$LoggingStatus))) - # CommercialLevel == "0" are LoggingStatus =="non-harvestable" + # CommercialLevel == 0 are LoggingStatus =="non-harvestable" TestCommercial <- testinventory1 %>% - dplyr::filter(CommercialLevel == "0") + dplyr::filter(CommercialLevel == 0) expect_true(all(TestCommercial$LoggingStatus =="non-harvestable")) TestCommercial <- testinventory2 %>% - dplyr::filter(CommercialLevel == "0") + dplyr::filter(CommercialLevel == 0) expect_true(all(TestCommercial$LoggingStatus =="non-harvestable")) # "harvestable": DBH >= MinFD & DBH <= MaxFD - # "harvestable": CommercialLevel == "1" ou "2" if diversification=T, or diversification=F & specieslax=T + # "harvestable": CommercialLevel == 1 ou 2 if diversification=T, or diversification=F & specieslax=T testinventory1a <- testinventory1 %>% - dplyr::filter(CommercialLevel == "2") + dplyr::filter(CommercialLevel == 2) testinventory2a <- testinventory2 %>% - dplyr::filter(CommercialLevel == "2") + dplyr::filter(CommercialLevel == 2) expect_true(any(testinventory1a$LoggingStatus =="harvestable")) expect_true(any(testinventory2a$LoggingStatus =="harvestable2nd")) - # "harvestable": CommercialLevel == "1" diversification=F & specieslax=F + # "harvestable": CommercialLevel == 1 diversification=F & specieslax=F testinventory3a <- testinventory3 %>% - dplyr::filter(CommercialLevel != "1") + dplyr::filter(CommercialLevel != 1) expect_true(all(testinventory3a$LoggingStatus == "non-harvestable")) diff --git a/tests/testthat/test-selected.R b/tests/testthat/test-selected.R index da50df27..7031282f 100644 --- a/tests/testthat/test-selected.R +++ b/tests/testthat/test-selected.R @@ -182,7 +182,7 @@ test_that("selected", { VO = VO, HVinit = HVinit))$inventory TestUp <- testinventory %>% - dplyr::filter(CommercialLevel == "1") %>% + dplyr::filter(CommercialLevel == 1) %>% dplyr::filter(DBH >= UpMinFD & DBH <= MaxFD) %>% dplyr::filter(LoggingStatus != "non-harvestable") %>% dplyr::filter(ProbedHollow == "0") @@ -192,13 +192,13 @@ test_that("selected", { dplyr::filter(LoggingStatus == "harvestableUp") if(nrow(TestUp)>0){ - expect_true(all(TestUp$LoggingStatus == "harvestableUp")) # There are harvestableUp among the CommercialLevel = "1" + expect_true(all(TestUp$LoggingStatus == "harvestableUp")) # There are harvestableUp among the CommercialLevel = 1 expect_true(all(TestDBHUp$DBH >= TestDBHUp$UpMinFD)) # DBH >= UpMinFD expect_true(all(TestDBHUp$Up =="1")) # Up = "1" } ## if (!diversification) - expect_false(any(TestDBHUp$CommercialLevel == "2")) # no CommercialLevel = "2" among the harvestableUp + expect_false(any(TestDBHUp$CommercialLevel == 2)) # no CommercialLevel = 2 among the harvestableUp ### if (HVupCommercial1 == VO) ### if (HVupCommercial1 > VO) ### if (HVupCommercial1 < VO)