gowachin / matreex

LESSEM internal package for simulation of forest dynamic depending on climatic variables
https://gowachin.github.io/matreex/
Other
3 stars 0 forks source link

Add delay to default dataset #10

Closed gowachin closed 1 year ago

gowachin commented 1 year ago

Default delay of 0 is not very realist so we need to add values from real dataset regression models.

Reunion : 01/03/2023

Project : values are added to the default fit dataset and used when none is provided to make_IPM(). Maybe an additionnal pkg option to replace this with 0 when we don't want to use any delay at all (to keep tests and vignette working in a first time)

Code to produce the values is done by @kunstler, add it to data-raw for latter documentation purpose.

gowachin commented 1 year ago

Missing species from Georges :

kunstler commented 1 year ago

good there is not a lot of species missing !

Le 1 mars 2023 à 16:41, Maxime Jaunatre @.***> a écrit :

Missing species from Georges :

Betula Juniperus_thurifera Prunus_padus Quercus_faginea Quercus_pyrenaica — Reply to this email directly, view it on GitHub https://github.com/gowachin/matreex/issues/10#issuecomment-1450362894, or unsubscribe https://github.com/notifications/unsubscribe-auth/ABCL4ZERJMKEB2SRFV3CESDWZ5U2LANCNFSM6AAAAAAVMD3SSM. You are receiving this because you were assigned.

jbarrere3 commented 1 year ago

age_vs_growth And there is the analysis. Looks like it's working pretty good when there is no competition no ?

kunstler commented 1 year ago

Yes look great. (Just the x axis is not the growth rate but the size at t+1) just do x - 100 for your doc justifying theextrapolation (not for trhe issue ...)

jbarrere3 commented 1 year ago

age_vs_growth Done ! When fitting a simple linear model, the predicted age for missing species is:

Juniperus thurifera 42.27278 Prunus padus 27.11595 Quercus faginea 36.57367 Quercus pyrenaica 31.90307

gowachin commented 1 year ago

I edited the csv by hand, could be great to have a single script to produce the file data-raw/species_lag_estimates.csv. I'm still missing the Betula species so it's values is the mean of all species in the csv.

I edited the pkg and I think the full pipeline should run all fine now. The latest version is on the dev branch and is available as written in README. All the modifications of the pkg that may break the pipeline are written in the NEWS.md file, except this last edit.

By default the make_IPM() function will use the value stored in the fit_sgr object and the delay argument override this setting.

gowachin commented 1 year ago

Potential issue : Uneven harvest module is not working with the new delay. The return value for the harvest is NA which is not expected.

EDIT : this was caused by the modification of targetBA per ha. Temporary fix is to set SurfEch = 1.

NA was caused by upper BA limit but it still doesn't work.

Default harvest should be fine.

The reproducible example is the harvesting vignette :

image

gowachin commented 1 year ago

targetBA was already set per ha, and this caused the previous issue, not the lag. Everything is fine !

kunstler commented 1 year ago

If you want a function to compute lag from French NFI data (this can probably be link to laselva to get the data?)

# Function to compute time lag from French NFI

compute_lag_French_NFI <- function(path = "/Users/gkunstler/Dropbox/DECLIC/NFI_DATA/France_New/FrenchNFI/data"){
  library(data.table)
  library(dplyr)
  trees  <- fread(file.path(path, "FrenchNFI","ARBRE.csv")) 
  plots  <- fread(file.path(path, "FrenchNFI","PLACETTE.csv") )
  species  <- fread(file.path(path, "FrenchNFI_species.csv" ))
  species$latinName <- stringr::word(species$latinName, 1,2, sep=" ")

  trees <- trees[trees$ESPAR != "", ]
  trees <- left_join(trees, plots, by = "IDP")
  trees <- left_join(trees, select(species, code, latinName),
                     by = c("ESPAR" = "code"))
  trees$diam <- trees$C13/pi*100
  # REMOVE tree with age too large as probably measurement error 
  trees<- trees %>% filter(AGE13 < 800 | AGE < 400)
  #Select species
  select_species <-  names(table(trees$latinName[!is.na(trees$AGE)]))[table(trees$latinName[!is.na(trees$AGE)])> 20]
  trees <- trees[trees$latinName %in% select_species, ]
  trees$latinName <- as.character(trees$latinName)
  # Data for prediction
  df_pred <- trees %>% group_by(latinName) %>% summarise(N_age = sum(!is.na(AGE)),
                                                         N_age13 = sum(!is.na(AGE13))) %>%
    ungroup() %>% mutate(diam = 9)
  fit <- lm(AGE13 ~diam*latinName, trees)
  fitbase <- lm(AGE ~diam*latinName, trees)
  age_130 <- predict(fit, newdata = df_pred, interval = "confidence")
  age_base <- predict(fitbase, newdata = df_pred, interval = "confidence") # age at 50 cm in 2005
  df_pred$age_130_m <- age_130[, "fit"]
  df_pred$age_130_lwr <- age_130[, "lwr"]
  df_pred$age_130_upr <- age_130[, "upr"]
  df_pred$age_base_m <- age_base[, "fit"]
  df_pred$age_base_lwr <- age_base[, "lwr"]
  df_pred$age_base_upr <- age_base[, "upr"]
  df_pred$age_diff <- df_pred$age_base_m  - df_pred$age_130_m 
  df_pred$age_130_m_b <- df_pred$age_130_m + 
    mean(df_pred$age_base_m - df_pred$age_130_m)
  df_pred$age_130_lwr_b <- df_pred$age_130_lwr +  
    mean(df_pred$age_base_m - df_pred$age_130_m)
  df_pred$age_130_upr_b <- df_pred$age_130_upr + 
    mean(df_pred$age_base_m - df_pred$age_130_m)
  write.csv(df_pred[, c("latinName", "age_130_m_b", "age_130_lwr_b", "age_130_upr_b")], file = "species_lag_estimates.csv", row.names = FALSE)

}
gowachin commented 1 year ago

A vignette to explain computation will be done with #12

Merged on v0.3.0