Skip to main content

Table 2 Three cffdrs example application codes: (a) standard FWI System with wintering DC adjustment, (b) raster-based hourly FFMC, and (c) fire behavior prediction based on results from the previous example application

From: cffdrs: an R package for the Canadian Forest Fire Danger Rating System

(a) Standard FWI System with wintering DC adjustment (b) Raster-based hourly FFMC (c) Fire behavior prediction based on results from (b)
#Load test data for wDC:
data ("test_wDC")
#Keep the first weather station, which
#is from Penticton, BC, Canada. The
#data contains two complete years’
#weather records between 2013 and
#2014.
dat <- test_wDC[test_wDC$id==1,]
#Calculate the fire season start
#and end dates:
fs <- fireSeason (dat)
#Calculate the FWI System
#variables for the first year with
#standard initial start values.
#First, we need to subset the
#input data by the start and end
#of the fire season in the first year:
dat$date <- as.Date (as.POSIXlt (paste (dat$yr,dat$mon,dat$day,sep="-")))
fs$date<- as.Date (as.POSIXlt (paste (fs$yr,fs$mon,fs$day,sep="-")))
curYr <- subset(dat,date>=fs$date[1]&date<=fs$date[2])
#Use of the fwi function is very
#straightforward:
curYr.fwi<-fwi (curYr)
#Calculate the FWI System
#variables for the second year
#with overwintering modified DC.
#This may take a few steps to
#accomplish. First, we need to
#subset the overwinter period from
#this two year weather #observations:
winT<-subset (dat,date>fs$date[2]&date<fs$date[3])
#Overwintering DC can then be
#calculated easily with wDC function:
init.DC<-wDC (curYr.fwi$DC[nrow (curYr.fwi)],sum (winT$prec))
#Second, extract the second fire
#season data:
secYr<-subset (dat,date>=fs$date[3]&date<=fs$date[4])
#The second year FWI System could
#be calculated with the overwintering
#DC as the following:
secYr.fwi<-fwi (secYr,c (85,6,init.DC))
#To show the difference, we also
#calculated the FWI System variables
#based on the default initial values:
secYr.fwi.default<-fwi (secYr)
#We then plotted the 3 outputs that
#are affected by the overwintering DC
#adjustment, i.e. DC, BUI, and FWI, to
#show the difference it makes:
x11 (width=12, height=4)
par (mfrow=c (1,3), mar=c (5,5,2,1))
plot(secYr.fwi.default$DC,secYr.fwi$DC,pch=19,col='grey50',ylim=c (0,850),xlab="",ylab="With wintering DC",cex.lab=2.0,cex.axis=1.5)
abline (0,1,lwd=1.5,lty=2)
text (100,800,"DC",cex=2)
plot (secYr.fwi.default$BUI,secYr.fwi$BUI,pch=19,col='grey50',xlab="Without wintering DC",ylab="",cex.lab=2.0,cex.axis=1.5)
abline (0,1,lwd=1.5,lty=2)
text (28,185,"BUI",cex=2)
plot (secYr.fwi.default$FWI,secYr.fwi$FWI,pch=19,col='grey50',xlab="",ylab="",cex.lab=2.0,cex.axis=1.5)
abline (0,1,lwd=1.5,lty=2)
text (8,59,"FWI",cex=2)
#Load the test data for the first
#hour, namely hour01 (See Fig. 4):
data(hour01) #or
hour01src <- system.file("extdata","test_rast_hour01.tif",package="cffdrs")
hour01 <- stack (hour01src)
#Assign names to the layers:
names (hour01)<-c ("temp","rh","ws","prec")
#We calculate the first hour’s
#FFMC with the default initial
#FFMC value of 85:
hffmc.hour01<-hffmcRaster (hour01)
#The FFMC for the second hour is
#then calculated based on
#the previous hour's FFMC. First,
#we load the test data for the
#second hour, namely hour02, to R:
data ("hour02")
hour02src <- system.file("extdata","test_rast_hour02.tif",package="cffdrs")
hour02 <- stack (hour02src)
#Assign variable names to the
#layers:
names (hour02)<-c ("temp","rh","ws","prec")
#The calculation of the second
#hour FFMC is slightly different:
hffmc.hour02<-hffmcRaster (hour02,ffmc_old=hffmc.hour01)
#Map both the inputs and outputs
#with a plot function from the
#raster package:
x11 (width=5, height=6.2)
plot (hour02)
#First, make a copy of the study area:
bui<-hour02$temp
#Assign the BUI value:
values (bui) <-50
#Rename the layer:
names(bui) <- "bui"
#Make it into the stack, which can
#be used as input in the #hffmcRaster function.
hour02<-stack (hour02,bui=bui)
#Now we can calculate all hourly
#FWI System variables and plot
#them:
hfwi.hour02<-hffmcRaster (hour02,ffmc_old=hffmc.hour01,hourlyFWI=TRUE)
x11 (width=5, height=6.2)
plot (hfwi.hour02)
#First, we calculate the hourly
#FFMC with hffmc function. We
#convert our raster inputs into a
#data.frame first:
hffmc.hour01<-as.data.frame (rasterToPoints (hour01))
#The fbp function requires the
#coordinates being labeled as
#"long" and "lat":
names (hffmc.hour01) [1:2]<-c ("long","lat")
#Hourly FFMC as inputs for fbp (note
#this is a 'multiple weather stations
#at one time step' situation):
hffmc.hour01$ffmc<-hffmc (hffmc.hour01,batch=FALSE)
#Alternatively, this could be done
#with hffmcRaster:
r<-hffmcRaster (hour01)
hffmc.hour01$ffmc<-rasterToPoints (r) [,3]
## Add fuel type and unique ID
hffmc.hour01$id<-1:nrow (hffmc.hour01)
hffmc.hour01$fuelType<-"C-2"
#The new variable that was added
#to hffmc.hour01 is named as
#'ffmc', which is required by the
#fbp function.
#Calculate the FBP System (primary
#outputs) with all other default
#factors:
FBP<-fbp (hffmc.hour01)
#We can then map a few key fire
#behavior measurements from the
#outputs: Head Fire Intensity
#(HFI), Equilibrium Head Fire Rate
#of Spread (ROS), and Total Fuel
#Consumption (TFC).
HFI<-rasterize (as.matrix(hffmc.hour01[,c ("long","lat")]),r,FBP$HFI)
ROS<-rasterize (as.matrix(hffmc.hour01[,c ("long","lat")]),r,FBP$ROS)
TFC<-rasterize (as.matrix(hffmc.hour01[,c ("long","lat")]),r,FBP$TFC)
#Plot them out:
x11 (width=10, height=5.3)
par (mfrow=c (1,3), mar=c (5,3.5,5,4))
brks <- seq (0, 1, by=0.1)
nb <- length (brks)-1
cols <- rev (heat.colors(nb))
plot (HFI,col=cols,main="Head Fire Intensity (HFI)",cex.main=1.8)
plot (ROS,col=cols,main="Rate of Spread (ROS)",cex.main=1.8)
plot (TFC,col=cols,main="Total Fuel Consumption (TFC)",cex.main=1.8)
# using fpbRaster function, it is
# much simplified:
ffmc<-hffmcRaster(hour01)
ws<-hour01$ws
fuel<-ffmc # create a fuel layer
fuel[]<-2 # for C-2 fuel type
r<-stack (ffmc,fuel,ws)
names(r)<-c ("ffmc","fueltype","ws")
FBP<-fbpRaster (r)
# Plot them:
x11 (width=10, height=5.3)
par(mfrow=c (1,3), mar=c (5,3.5,5,4))
brks <- seq (0, 1, by=0.1)
nb <- length (brks)-1
cols <- rev (heat.colors(nb))
plot (FBP$HFI,col=cols,main="Head Fire Intensity (HFI)",cex.main=1.8)
plot (FBP$ROS,col=cols,main="Rate of Spread (ROS)",cex.main=1.8)
plot (FBP$TFC,col=cols,main="Total Fuel Consumption (TFC)",cex.main=1.8)