R/harvest.volume.r
In nuaquilue/QLDM: Quebec Landscape Dynamic Model
Defines functions
harvest.volume
Documented in
harvest.volume
#' Volume-based clear and partial cuts
#'
#' Selects cells for clear and partial cuts on an volume-based
#'
#' @param land A \code{landscape} data frame with forest stand records in rows
#' @param params A list of default parameters generated by the function \code{default.params()} or
#' a customized list of model parameters
#' @param cc.vol A data frame with the number of cells to clear cut per mgmt unit returned by the function \code{timber.volume()}
#' @param pc.vol A data frame with the number of cells to partial cut per mgmt unit returned by the function \code{timber.partial.volume()}
#' @param km2.pixel Area in km^2^ of grid cells
#'
#' @return A list of four items:
#' \itemize{
#' \item{\code{cc.cells}: A vector with the \code{cell.id} of the clear cut cells}
#' \item{\code{pc.cells}: A vector with the \code{cell.id} of the partial cut cells}
#' \item{\code{track.cut}: A data frame with managed areas by different prescriptions}
#' \item{\code{spp.track}: A data frame with the area and volume clear-cut and partial cut per species}
#' }
#'
#' @export
#'
#' @examples
#' data(landscape)
#' params = default.params()
#' cc.vol = timber.volume(landscape, params)
#' pc.vol = timber.partial.volume(landscape, params, pc.step=5)
#' harvest = harvest.volume(landscape, params, cc.vol, pc.vol, km2.pixel=4)
#'
harvest.volume <- function(land, params, cc.vol, pc.vol, km2.pixel){
cat(" Volume-based selection of clearcut and partial cut cells", "\n" )
land2 <- land[!is.na(land$mgmt.unit) & !land$spp=="NonFor",]
land2$vol <- stand.volume(land2)*km2.pixel*100
land2 <- land2[order(-land2$vol),]
## For those locations that can be harvested (included), differentiate those that have been burnt or killed
## by an outbreak, and then count the young (cannot be salvaged) vs the mature (can be salvaged)
s.inc <- filter(land2, !is.na(mgmt.unit) & is.na(exclus)) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.mat <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & age>age.matu) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.burnt <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tsfire==0) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.mat.burnt <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tsfire==0 & age>age.matu) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.kill <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tssbw %in%c(0,5)) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.mat.kill <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tssbw %in%c(0,5) & age>age.matu) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
## Also, look for zones at defforestation risk, both included and excluded
reg.fail.ex <- filter(land2, !is.na(mgmt.unit) & spp %in% c("EPN", "SAB", "OTH.RES.N"),
tsfire==0, age<=50, !is.na(exclus)) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
reg.fail.inc <- filter(land2, !is.na(mgmt.unit) & spp %in% c("EPN", "SAB", "OTH.RES.N"),
tsfire==0, age<=50, is.na(exclus)) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
## Even- or uneve-aged stands
land2 <- mutate(land2, rndm=runif(nrow(land2)))
even <- land2$spp %in% c("EPN", "PET", "SAB", "OTH.RES.N", "OTH.RES.S", "OTH.FEU.N") & is.na(land2$exclus) & land2$rndm<=0.95
even[land2$spp %in% c("BOJ", "ERS", "OTH.FEU.S")& is.na(land2$exclus) & land2$rndm<=0.05] <- 1
even[land2$tsfire==0] <- 1
land.coniferes <- land2[even==1,]
land.feuillu.tol <- land2[even==0,]
land.ea <- rbind(land.coniferes, land.feuillu.tol)
s.ea <- group_by(land.ea, mgmt.unit) %>% summarise(x=length(mgmt.unit))
## Subset the mature even-aged cells from those that are harvestable
land.rec <- filter(land.ea, age>=age.matu)
# initialisation des variables
cc.cells.salv.tot <- cc.cells.unaff.tot <- cc.cells <- numeric(0)
### possibilité
poss.init <- cc.vol
for(unit in poss.init$mgmt.unit){
harv.level.u <- poss.init$x[poss.init$mgmt.unit == unit]
land.ea.u <- land.ea[land.ea$mgmt.unit==unit,]
s.ea.u <- length(land.ea.u$cell.id)
# Subset of harvestable (mature even-aged) cells
land.ea.mat.u <- land.ea.u[land.ea.u$age >= land.ea.u$age.matu,]
subland.salv.mature.burn <- land.ea.u[(land.ea.u$age >= (land.ea.u$age.matu-params$diff.prematurite)) & land.ea.u$tsfire==0, ]
subland.salv.mature.sbw <- land.ea.u[(land.ea.u$age >= (land.ea.u$age.matu-params$diff.prematurite)) & land.ea.u$tssbw %in% c(0,5), ]
subland.salv.mature <- rbind(subland.salv.mature.burn,subland.salv.mature.sbw)
# sélection de cellules récupérables en tenant compte
# des contraintes a priori (maximum salvage rate, etc.)
cell.salv.available <- sample(subland.salv.mature$cell.id, round(params$salvage.rate.event*nrow(subland.salv.mature)), replace=FALSE)
#############################################
# Randomly select cells among the even-aged mature cells present in non-protected areas
# Prioritize clear cuts in disturbed areas (salvage logging)
# VOLUME: CELLS SELECTED FROM THE HIGHEST TO LOWEST VOLUMES, UNTIL CONDITION MET
x <- sum(subland.salv.mature[subland.salv.mature$cell.id %in%cell.salv.available,]$vol )
cc.cells.salv <- numeric(0)
xx <-0
while (x > 0 & length(cell.salv.available)>0 & xx < harv.level.u) {
paquet <- ifelse((x > 550000) & (harv.level.u-xx > 550000),5,1 ) # pour accélérer le calcul, paquets de 5 cellules
cc.cells.salv.x <- cell.salv.available[1:paquet] #sample(cell.salv.available,1)
cc.cells.salv <- c(cc.cells.salv,cc.cells.salv.x)
cell.salv.available <- cell.salv.available[-which(cell.salv.available%in%cc.cells.salv.x)]
x <- sum(subland.salv.mature[subland.salv.mature$cell.id %in%cell.salv.available,]$vol )
xx <- sum(land.ea[land.ea$cell.id %in%cc.cells.salv,]$vol )
}
# When salvaged cells were not enough to satisfy sustained yield level, then harvest some mature
# forests unaffected by disturbances (cc.cells.unaff).
subland.non.pertu <- land.ea.mat.u[land.ea.mat.u$tsfire!=0 & land.ea.mat.u$tssbw>5, ]
x <- sum(subland.non.pertu$vol )
cc.cells.unaff <- numeric(0)
# arrête la récolte lorsqu'on est rendu à < 40000m3 du but, il y aura parfois des dépassements
while(x > 0 & length(subland.non.pertu$cell.id)>0 & xx < (harv.level.u-40000)) {
paquet <- ifelse((x > 550000) & (harv.level.u-xx > 550000),5,1 )
cc.cells.unaff.x <- subland.non.pertu[1:paquet,]$cell.id #sample( subland.non.pertu$cell.id, 1)
cc.cells.unaff <- c(cc.cells.unaff,cc.cells.unaff.x)
subland.non.pertu <- subland.non.pertu[-which(subland.non.pertu$cell.id%in%cc.cells.unaff.x),]
x <- sum(subland.non.pertu$vol,na.rm=T )
xx <- sum(land.ea[land.ea$cell.id %in%c(cc.cells.salv,cc.cells.unaff),]$vol )
}
# Combine all types of harvested cells with those already harvested in other FMUs during the same period
cc.cells <- c(cc.cells, cc.cells.salv, cc.cells.unaff)
cc.cells.salv.tot <- c(cc.cells.salv.tot, cc.cells.salv)
cc.cells.unaff.tot <- c(cc.cells.unaff.tot, cc.cells.unaff)
}
################## partial cuts ############################
land.uea <- land2[land2$cell.id %in% land.ea$cell.id ,]
# volume par cellule. Moitié du volume accessible
land.uea$vol <- land.uea$vol/2
## The maturity age for partial cuts is half the maturity age for a clear cut
land.uea$age.matu.pc <- round(land.uea$age.matu,-1)/2
## Subset of harvestable (i.e. mature uneven-aged, ot recently partial cut) cells
land.rec.pc <- filter(land.uea, age>=(age.matu-15) & tspcut >=age.matu.pc ) # & TSDist >=(age.matu-15) not longer exists this variable
## Get the number of cells to be managed under a partial-cut regime
s.uea <- group_by(land.uea, mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.mat <- group_by(land.rec.pc, mgmt.unit) %>% summarise(x=length(mgmt.unit))
harv.level.pc <- pc.vol
pc.cells <- 0
for(unit in pc.vol$mgmt.unit){ #unit=9351
poss.cp.ua <- harv.level.pc$x[harv.level.pc$mgmt.unit==unit]
cell.dispo.ua <- land.rec.pc[land.rec.pc$mgmt.unit==unit, ]
x <- sum(cell.dispo.ua$vol )
pc.cells.ua <- numeric(0)
xx <- 0
# arrête la récolte lorsqu'on est rendu à < 20000m3 du but, il y aura parfois des dépassements
while(x > 0 & length(cell.dispo.ua$cell.id)>0 & xx < (poss.cp.ua-20000) ) {
paquet <- ifelse((x > 260000) & (poss.cp.ua-xx > 260000),5,1 )
pc.cells.ua.x <- cell.dispo.ua[1:paquet,]$cell.id #sample( subland.non.pertu$cell.id, 1)
pc.cells.ua <- c(pc.cells.ua,pc.cells.ua.x)
cell.dispo.ua <- cell.dispo.ua[-which(cell.dispo.ua$cell.id%in%pc.cells.ua.x),]
x <- sum(cell.dispo.ua$vol,na.rm=T ) # volume restant
xx <- sum(land.uea[land.uea$cell.id %in%c(pc.cells.ua),]$vol ) # volume récolté
}
## Add the cells partially cut in this UA:
pc.cells <- c(pc.cells, pc.cells.ua)
}
################################################# TRACKING #################################################
## Area salvaged and non-salvaged, clearcut
## areas are in cells, volumes are in m3
a.salv <- filter(land2, cell.id %in% cc.cells.salv.tot) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
a.unaff <- filter(land2, cell.id %in% cc.cells.unaff.tot) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
### Volume logged, clearcut
v.salv <- filter(land.ea, cell.id %in% cc.cells.salv.tot) %>% group_by(mgmt.unit) %>% summarise(x=sum(vol))
v.unaff <- filter(land.ea, cell.id %in% cc.cells.unaff.tot) %>% group_by(mgmt.unit) %>% summarise(x=sum(vol))
## Area clearcut per species per management unit (clearcut)
spp.ccut <- filter(land2, cell.id %in% c(cc.cells.salv.tot, cc.cells.unaff.tot)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=length(mgmt.unit))
## Volume clearcut per species per management unit (clearcut)
spp.ccut.vol <- filter(land2, cell.id %in% c(cc.cells.salv.tot, cc.cells.unaff.tot)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=sum(vol))
## Area partial cut per management unit
a.pcut <- filter(land2, cell.id %in% pc.cells) %>% group_by(mgmt.unit) %>%
summarise(x=length(mgmt.unit))
## Volume partial cut per management unit
v.pcut <- filter(land2, cell.id %in% pc.cells) %>% group_by(mgmt.unit) %>%
summarise(x=sum(vol))
## Area clearcut per species per management unit (clearcut)
spp.pcut <- filter(land2, cell.id %in% c(pc.cells)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=length(mgmt.unit))
## Volume clearcut per species per management unit (clearcut)
spp.pcut.vol <- filter(land2, cell.id %in% c(pc.cells)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=sum(vol))
## Merge all the info, FMU level
track <- left_join(s.inc, s.ea, by="mgmt.unit") %>% left_join(s.mat, by="mgmt.unit") %>%
left_join(s.inc.burnt, by="mgmt.unit") %>% left_join(s.inc.mat.burnt, by="mgmt.unit") %>%
left_join(s.inc.kill, by="mgmt.unit") %>% left_join(s.inc.mat.kill, by="mgmt.unit") %>%
left_join(reg.fail.ex, by="mgmt.unit") %>% left_join(reg.fail.inc, by="mgmt.unit") %>%
left_join(a.salv, by="mgmt.unit") %>% left_join(a.unaff, by="mgmt.unit") %>%
left_join(v.salv, by="mgmt.unit") %>% left_join(v.unaff, by="mgmt.unit") %>%
left_join(a.pcut, by="mgmt.unit") %>% left_join(v.pcut, by="mgmt.unit")
names(track)[2:ncol(track)] <- c("a.inc", "a.even.age", "a.mat.pc", "a.inc.burnt", "a.inc.mat.burnt",
"a.inc.kill", "a.inc.mat.kill", "a.reg.fail.ex", "a.reg.fail.in", "a.salvaged", "a.unaff","v.salv",
"v.unaff","a.pcut","v.pcut")
track[is.na(track)] <- 0
track[,c(2:12,15)] = track[,c(2:12,15)]*km2.pixel
#### merge, species level
spp.track <- left_join(spp.ccut, spp.ccut.vol, by=c("mgmt.unit", "spp")) %>%
left_join(spp.pcut, by=c("mgmt.unit", "spp")) %>%
left_join(spp.ccut.vol, by=c("mgmt.unit", "spp"))
names(spp.track)[3:ncol(spp.track)] <- c("area.ccut","vol.ccut", "area.pcut","vol.pcut")
spp.track[,c(3,5)] = spp.track[,c(3,5)]*km2.pixel
## Return the cell.id of the cut locations and the tracking info
return(list(cc.cells=cc.cells, pc.cells=pc.cells, track.cut=track, spp.track=spp.track))
}
nuaquilue/QLDM documentation built on Dec. 22, 2021, 3:18 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions harvest.volume
Documented in harvest.volume
#' Volume-based clear and partial cuts
#'
#' Selects cells for clear and partial cuts on an volume-based
#'
#' @param land A \code{landscape} data frame with forest stand records in rows
#' @param params A list of default parameters generated by the function \code{default.params()} or
#' a customized list of model parameters
#' @param cc.vol A data frame with the number of cells to clear cut per mgmt unit returned by the function \code{timber.volume()}
#' @param pc.vol A data frame with the number of cells to partial cut per mgmt unit returned by the function \code{timber.partial.volume()}
#' @param km2.pixel Area in km^2^ of grid cells
#'
#' @return A list of four items:
#' \itemize{
#' \item{\code{cc.cells}: A vector with the \code{cell.id} of the clear cut cells}
#' \item{\code{pc.cells}: A vector with the \code{cell.id} of the partial cut cells}
#' \item{\code{track.cut}: A data frame with managed areas by different prescriptions}
#' \item{\code{spp.track}: A data frame with the area and volume clear-cut and partial cut per species}
#' }
#'
#' @export
#'
#' @examples
#' data(landscape)
#' params = default.params()
#' cc.vol = timber.volume(landscape, params)
#' pc.vol = timber.partial.volume(landscape, params, pc.step=5)
#' harvest = harvest.volume(landscape, params, cc.vol, pc.vol, km2.pixel=4)
#'
harvest.volume <- function(land, params, cc.vol, pc.vol, km2.pixel){
cat(" Volume-based selection of clearcut and partial cut cells", "\n" )
land2 <- land[!is.na(land$mgmt.unit) & !land$spp=="NonFor",]
land2$vol <- stand.volume(land2)*km2.pixel*100
land2 <- land2[order(-land2$vol),]
## For those locations that can be harvested (included), differentiate those that have been burnt or killed
## by an outbreak, and then count the young (cannot be salvaged) vs the mature (can be salvaged)
s.inc <- filter(land2, !is.na(mgmt.unit) & is.na(exclus)) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.mat <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & age>age.matu) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.burnt <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tsfire==0) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.mat.burnt <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tsfire==0 & age>age.matu) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.kill <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tssbw %in%c(0,5)) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.inc.mat.kill <- filter(land2, !is.na(mgmt.unit) & is.na(exclus) & tssbw %in%c(0,5) & age>age.matu) %>%
group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
## Also, look for zones at defforestation risk, both included and excluded
reg.fail.ex <- filter(land2, !is.na(mgmt.unit) & spp %in% c("EPN", "SAB", "OTH.RES.N"),
tsfire==0, age<=50, !is.na(exclus)) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
reg.fail.inc <- filter(land2, !is.na(mgmt.unit) & spp %in% c("EPN", "SAB", "OTH.RES.N"),
tsfire==0, age<=50, is.na(exclus)) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
## Even- or uneve-aged stands
land2 <- mutate(land2, rndm=runif(nrow(land2)))
even <- land2$spp %in% c("EPN", "PET", "SAB", "OTH.RES.N", "OTH.RES.S", "OTH.FEU.N") & is.na(land2$exclus) & land2$rndm<=0.95
even[land2$spp %in% c("BOJ", "ERS", "OTH.FEU.S")& is.na(land2$exclus) & land2$rndm<=0.05] <- 1
even[land2$tsfire==0] <- 1
land.coniferes <- land2[even==1,]
land.feuillu.tol <- land2[even==0,]
land.ea <- rbind(land.coniferes, land.feuillu.tol)
s.ea <- group_by(land.ea, mgmt.unit) %>% summarise(x=length(mgmt.unit))
## Subset the mature even-aged cells from those that are harvestable
land.rec <- filter(land.ea, age>=age.matu)
# initialisation des variables
cc.cells.salv.tot <- cc.cells.unaff.tot <- cc.cells <- numeric(0)
### possibilité
poss.init <- cc.vol
for(unit in poss.init$mgmt.unit){
harv.level.u <- poss.init$x[poss.init$mgmt.unit == unit]
land.ea.u <- land.ea[land.ea$mgmt.unit==unit,]
s.ea.u <- length(land.ea.u$cell.id)
# Subset of harvestable (mature even-aged) cells
land.ea.mat.u <- land.ea.u[land.ea.u$age >= land.ea.u$age.matu,]
subland.salv.mature.burn <- land.ea.u[(land.ea.u$age >= (land.ea.u$age.matu-params$diff.prematurite)) & land.ea.u$tsfire==0, ]
subland.salv.mature.sbw <- land.ea.u[(land.ea.u$age >= (land.ea.u$age.matu-params$diff.prematurite)) & land.ea.u$tssbw %in% c(0,5), ]
subland.salv.mature <- rbind(subland.salv.mature.burn,subland.salv.mature.sbw)
# sélection de cellules récupérables en tenant compte
# des contraintes a priori (maximum salvage rate, etc.)
cell.salv.available <- sample(subland.salv.mature$cell.id, round(params$salvage.rate.event*nrow(subland.salv.mature)), replace=FALSE)
#############################################
# Randomly select cells among the even-aged mature cells present in non-protected areas
# Prioritize clear cuts in disturbed areas (salvage logging)
# VOLUME: CELLS SELECTED FROM THE HIGHEST TO LOWEST VOLUMES, UNTIL CONDITION MET
x <- sum(subland.salv.mature[subland.salv.mature$cell.id %in%cell.salv.available,]$vol )
cc.cells.salv <- numeric(0)
xx <-0
while (x > 0 & length(cell.salv.available)>0 & xx < harv.level.u) {
paquet <- ifelse((x > 550000) & (harv.level.u-xx > 550000),5,1 ) # pour accélérer le calcul, paquets de 5 cellules
cc.cells.salv.x <- cell.salv.available[1:paquet] #sample(cell.salv.available,1)
cc.cells.salv <- c(cc.cells.salv,cc.cells.salv.x)
cell.salv.available <- cell.salv.available[-which(cell.salv.available%in%cc.cells.salv.x)]
x <- sum(subland.salv.mature[subland.salv.mature$cell.id %in%cell.salv.available,]$vol )
xx <- sum(land.ea[land.ea$cell.id %in%cc.cells.salv,]$vol )
}
# When salvaged cells were not enough to satisfy sustained yield level, then harvest some mature
# forests unaffected by disturbances (cc.cells.unaff).
subland.non.pertu <- land.ea.mat.u[land.ea.mat.u$tsfire!=0 & land.ea.mat.u$tssbw>5, ]
x <- sum(subland.non.pertu$vol )
cc.cells.unaff <- numeric(0)
# arrête la récolte lorsqu'on est rendu à < 40000m3 du but, il y aura parfois des dépassements
while(x > 0 & length(subland.non.pertu$cell.id)>0 & xx < (harv.level.u-40000)) {
paquet <- ifelse((x > 550000) & (harv.level.u-xx > 550000),5,1 )
cc.cells.unaff.x <- subland.non.pertu[1:paquet,]$cell.id #sample( subland.non.pertu$cell.id, 1)
cc.cells.unaff <- c(cc.cells.unaff,cc.cells.unaff.x)
subland.non.pertu <- subland.non.pertu[-which(subland.non.pertu$cell.id%in%cc.cells.unaff.x),]
x <- sum(subland.non.pertu$vol,na.rm=T )
xx <- sum(land.ea[land.ea$cell.id %in%c(cc.cells.salv,cc.cells.unaff),]$vol )
}
# Combine all types of harvested cells with those already harvested in other FMUs during the same period
cc.cells <- c(cc.cells, cc.cells.salv, cc.cells.unaff)
cc.cells.salv.tot <- c(cc.cells.salv.tot, cc.cells.salv)
cc.cells.unaff.tot <- c(cc.cells.unaff.tot, cc.cells.unaff)
}
################## partial cuts ############################
land.uea <- land2[land2$cell.id %in% land.ea$cell.id ,]
# volume par cellule. Moitié du volume accessible
land.uea$vol <- land.uea$vol/2
## The maturity age for partial cuts is half the maturity age for a clear cut
land.uea$age.matu.pc <- round(land.uea$age.matu,-1)/2
## Subset of harvestable (i.e. mature uneven-aged, ot recently partial cut) cells
land.rec.pc <- filter(land.uea, age>=(age.matu-15) & tspcut >=age.matu.pc ) # & TSDist >=(age.matu-15) not longer exists this variable
## Get the number of cells to be managed under a partial-cut regime
s.uea <- group_by(land.uea, mgmt.unit) %>% summarise(x=length(mgmt.unit))
s.mat <- group_by(land.rec.pc, mgmt.unit) %>% summarise(x=length(mgmt.unit))
harv.level.pc <- pc.vol
pc.cells <- 0
for(unit in pc.vol$mgmt.unit){ #unit=9351
poss.cp.ua <- harv.level.pc$x[harv.level.pc$mgmt.unit==unit]
cell.dispo.ua <- land.rec.pc[land.rec.pc$mgmt.unit==unit, ]
x <- sum(cell.dispo.ua$vol )
pc.cells.ua <- numeric(0)
xx <- 0
# arrête la récolte lorsqu'on est rendu à < 20000m3 du but, il y aura parfois des dépassements
while(x > 0 & length(cell.dispo.ua$cell.id)>0 & xx < (poss.cp.ua-20000) ) {
paquet <- ifelse((x > 260000) & (poss.cp.ua-xx > 260000),5,1 )
pc.cells.ua.x <- cell.dispo.ua[1:paquet,]$cell.id #sample( subland.non.pertu$cell.id, 1)
pc.cells.ua <- c(pc.cells.ua,pc.cells.ua.x)
cell.dispo.ua <- cell.dispo.ua[-which(cell.dispo.ua$cell.id%in%pc.cells.ua.x),]
x <- sum(cell.dispo.ua$vol,na.rm=T ) # volume restant
xx <- sum(land.uea[land.uea$cell.id %in%c(pc.cells.ua),]$vol ) # volume récolté
}
## Add the cells partially cut in this UA:
pc.cells <- c(pc.cells, pc.cells.ua)
}
################################################# TRACKING #################################################
## Area salvaged and non-salvaged, clearcut
## areas are in cells, volumes are in m3
a.salv <- filter(land2, cell.id %in% cc.cells.salv.tot) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
a.unaff <- filter(land2, cell.id %in% cc.cells.unaff.tot) %>% group_by(mgmt.unit) %>% summarise(x=length(mgmt.unit))
### Volume logged, clearcut
v.salv <- filter(land.ea, cell.id %in% cc.cells.salv.tot) %>% group_by(mgmt.unit) %>% summarise(x=sum(vol))
v.unaff <- filter(land.ea, cell.id %in% cc.cells.unaff.tot) %>% group_by(mgmt.unit) %>% summarise(x=sum(vol))
## Area clearcut per species per management unit (clearcut)
spp.ccut <- filter(land2, cell.id %in% c(cc.cells.salv.tot, cc.cells.unaff.tot)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=length(mgmt.unit))
## Volume clearcut per species per management unit (clearcut)
spp.ccut.vol <- filter(land2, cell.id %in% c(cc.cells.salv.tot, cc.cells.unaff.tot)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=sum(vol))
## Area partial cut per management unit
a.pcut <- filter(land2, cell.id %in% pc.cells) %>% group_by(mgmt.unit) %>%
summarise(x=length(mgmt.unit))
## Volume partial cut per management unit
v.pcut <- filter(land2, cell.id %in% pc.cells) %>% group_by(mgmt.unit) %>%
summarise(x=sum(vol))
## Area clearcut per species per management unit (clearcut)
spp.pcut <- filter(land2, cell.id %in% c(pc.cells)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=length(mgmt.unit))
## Volume clearcut per species per management unit (clearcut)
spp.pcut.vol <- filter(land2, cell.id %in% c(pc.cells)) %>%
group_by(mgmt.unit, spp) %>% summarise(x=sum(vol))
## Merge all the info, FMU level
track <- left_join(s.inc, s.ea, by="mgmt.unit") %>% left_join(s.mat, by="mgmt.unit") %>%
left_join(s.inc.burnt, by="mgmt.unit") %>% left_join(s.inc.mat.burnt, by="mgmt.unit") %>%
left_join(s.inc.kill, by="mgmt.unit") %>% left_join(s.inc.mat.kill, by="mgmt.unit") %>%
left_join(reg.fail.ex, by="mgmt.unit") %>% left_join(reg.fail.inc, by="mgmt.unit") %>%
left_join(a.salv, by="mgmt.unit") %>% left_join(a.unaff, by="mgmt.unit") %>%
left_join(v.salv, by="mgmt.unit") %>% left_join(v.unaff, by="mgmt.unit") %>%
left_join(a.pcut, by="mgmt.unit") %>% left_join(v.pcut, by="mgmt.unit")
names(track)[2:ncol(track)] <- c("a.inc", "a.even.age", "a.mat.pc", "a.inc.burnt", "a.inc.mat.burnt",
"a.inc.kill", "a.inc.mat.kill", "a.reg.fail.ex", "a.reg.fail.in", "a.salvaged", "a.unaff","v.salv",
"v.unaff","a.pcut","v.pcut")
track[is.na(track)] <- 0
track[,c(2:12,15)] = track[,c(2:12,15)]*km2.pixel
#### merge, species level
spp.track <- left_join(spp.ccut, spp.ccut.vol, by=c("mgmt.unit", "spp")) %>%
left_join(spp.pcut, by=c("mgmt.unit", "spp")) %>%
left_join(spp.ccut.vol, by=c("mgmt.unit", "spp"))
names(spp.track)[3:ncol(spp.track)] <- c("area.ccut","vol.ccut", "area.pcut","vol.pcut")
spp.track[,c(3,5)] = spp.track[,c(3,5)]*km2.pixel
## Return the cell.id of the cut locations and the tracking info
return(list(cc.cells=cc.cells, pc.cells=pc.cells, track.cut=track, spp.track=spp.track))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.