In bcgov/forestDroughtTool: Predict Forest Drought Hazard In British Columbia

knitr::opts_chunk$set(echo = FALSE)

library(tidyverse)
library(here)
library(forestDroughtTool)
library(magrittr)

# Load climate data (compiled from previous step)
load("climData.RData")

# Functions
# Load some functions
source("C:/Users/hgriesba/Documents/git/bcgov/forestDroughtTool/R/asmrCalc.R")
source("C:/Users/hgriesba/Documents/git/bcgov/forestDroughtTool/R/yearSelect.R")

X<-
  climData %>% 
  pluck("cleanedData") %>% 
  as_tibble() %>% 
  dplyr::filter(stn %in% c("beaverdell","marysville")) %>% 
  mutate(stn=factor(stn)) %>% 
  mutate(stn=fct_recode(stn,IDFdm1="marysville",
                        IDFdm2="beaverdell"))

load(here::here("data-raw","WxData_newBECvariants","futureData.RData"))

asmrRun1<-function(stnID,bgc,yearRange) {

  # set seed to control random year 
  set.seed(5)  

    # Generate random years
  asmrData<-
    climData %>% 
    pluck("cleanedData") %>% 
    .[.$stn%in%stnID,] %>% # for some reason dplyr::filter isn't working
    filter(stn %in% stnID) %>% 
    rename(ppt="ppt_filled",
           tmx="tmx_filled",
           tmn="tmn_filled") %>% 
    mutate(date=paste(year,month,day,sep="-")) %>% 
    asmrCalc()


  yearData<-
    asmrData %>% 
    yearSelect(excl=c(1970,2020),win=yearRange,yrs=10)



  asmrSummary<- 
   asmrData %>% 
    filter(year %in% yearData) %>% # filter for years
    group_by(month) %>% 
    summarise_at(vars(ends_with(".ASMR")),mean) %>%
        ungroup() %>%

        rbind(c(13,colMeans(.)[-1])) %>%
        mutate(month=cut(month,breaks=13,labels=c(month.abb,"Annual"))) %>% 
    mutate(Station=str_to_title(stnID),BGC=bgc) %>% 
    mutate_at(vars(ends_with(".ASMR")),round,3) %>% 
    dplyr::select(Station,BGC,everything()) 



    # generate future AET/PET ratios
 future.X<-
    climData %>% 
    pluck("cleanedData") %>% 
    .[.$stn%in%stnID,] %>% # for some reason dplyr::filter isn't working
    filter(stn %in% stnID) %>% 
    rename(ppt="ppt_filled",
           tmx="tmx_filled",
           tmn="tmn_filled") %>% 
    right_join(filter(future.Data,BGC==bgc),by="month") %>% 
    mutate(ppt=PPT_future*ppt,
           tmx=Tmax_future+tmx,
           tmn=Tmin_future+tmn) %>% 
   mutate(date=paste(year,month,day,sep="-")) %>% 
   dplyr::select(stn,BGC,year,month,day,date,ppt,tmx,tmn,scenario)

   futureASMR<-rbind(data.frame(Scenario="rcp45_2025",asmrCalc(filter(future.X,scenario=="2025_rcp45_dif"))),
    data.frame(Scenario="rcp45_2055",asmrCalc(filter(future.X,scenario=="2055_rcp45_dif"))),
    data.frame(Scenario="rcp85_2025",asmrCalc(filter(future.X,scenario=="2025_rcp85_dif"))),
    data.frame(Scenario="rcp85_2055",asmrCalc(filter(future.X,scenario=="2055_rcp85_dif")))) %>% 

   # create summaries
       filter(year %in% yearData) %>% # filter for years
    group_by(Scenario,month) %>% 
    summarise_at(vars(ends_with(".ASMR")),mean) %>%
        ungroup() %>%
        mutate(Station=str_to_title(stnID),BGC=bgc) %>% 
    mutate_at(vars(ends_with(".ASMR")),round,3) %>% 
     mutate(month=as.integer(month)) %>% 
    dplyr::select(Station,BGC,everything()) 


  futureSummary<- 
     futureASMR %>% 
       mutate(month=as.integer(month)) %>% 
      ungroup() %>% 
     group_by(Scenario) %>% 
     summarise_at(vars(ends_with(".ASMR")),mean) %>% 
        mutate(Station=str_to_title(stnID),BGC=bgc,month=13) %>%
           dplyr::select(Station,BGC,month,everything()) %>% 
       rbind(futureASMR) %>% 
          arrange(Scenario,month) %>% 
         mutate(month=cut(month,breaks=13,labels=c(month.abb,"Annual"))) %>% 
    mutate_at(vars(ends_with(".ASMR")),round,3) %>% 
   mutate(Period=str_split_fixed(Scenario,patter="_",n=2)[,2]) %>% 
     mutate(Scenario=str_split_fixed(Scenario,patter="_",n=2)[,1]) %>% 
    dplyr::select(-Station) %>% 
    dplyr::select(BGC,Period,Scenario,Month=month,everything())



  return(list(years=yearData,asmr=asmrSummary,future=futureSummary))




}

IDFdm1

stnID="marysville"
bgc="IDFdm1"

x<-asmrRun1(stnID,bgc,yearRange=c(1961,1990))

For this BGC unit, I used r stnID station, and randomly selected the following years: r x$years. Here is the monthly and annual AET/PET ratio for those 10 years:

x$asmr %>% 
  knitr::kable()

Here are the future values for 2025 and 2055 periods, using the rcp 4.5 scenario:

x %>% 
  pluck("future") %>% 
  filter(Scenario=="rcp45") %>% 
  dplyr::select(-Scenario) %>% 
  knitr::kable()

IDFdm2

stnID="beaverdell"
bgc="IDFdm2"

x<-asmrRun1(stnID,bgc,yearRange=c(1991,2020))

For this BGC unit, I used r stnID station, and randomly selected the following years: r x$years. Here is the monthly and annual AET/PET ratio for those 10 years:

x$asmr %>% 
  knitr::kable()

Here are the future values for 2025 and 2055 periods, using the rcp 4.5 scenario:

x %>% 
  pluck("future") %>% 
  filter(Scenario=="rcp45") %>% 
  dplyr::select(-Scenario) %>% 
  knitr::kable()

bcgov/forestDroughtTool documentation built on March 20, 2021, 4:15 p.m.