R/prepareTreeCompetitionTable.R
In miquelcaceres/IFNdyn: IFN forest dynamics and scenario analysis
Defines functions
prepareSpatialSpeciesCompetitionTable
prepareSpeciesCompetitionTable
prepareTreeCompetitionTable
Documented in
prepareSpatialSpeciesCompetitionTable
prepareSpeciesCompetitionTable
prepareTreeCompetitionTable
#' Prepares variables for model input
#'
#' Prepares tree and competition variables from IFN tree data for model input (used internally in model functions like \code{\link{IFNgrowth}}).
#'
#' @param x a data frame with column names.
#' @param BAL A flag to indicate that basal area of larger trees (between inventories) has to be calculated.
#' @param BALext A flag to indicate that basal area of larger extracted trees (between inventories) has to be calculated (requires column 'OIFFIN' in \code{x}).
#' @param sortByDBH A flag to sort rows within each plot by increasing diameter at breast height.
#' @param keep.vars A character vector with names of variables in \code{x} that should be copied to the output data frame.
#' @param provinceFromID A flag to indicate that province should be extracted from 'ID' assuming they are IFN plot codes.
#' @param verbose A flag to indicate console output during the process.
#'
#' @return Function \code{prepareTreeCompetitionTable} returns a data frame with as many rows as rows in the input \code{x} object
#' and columns:
#' \itemize{
#' \item{\code{Province}: Spanish province code (will be empty if \code{provinceFromID = FALSE}).}
#' \item{\code{ID}: Plot code.}
#' \item{\code{species}: Species code.}
#' \item{\code{d}: Tree diameter at breast height.}
#' \item{\code{inv.d}: Inverse of tree diameter at breast height.}
#' \item{\code{ln.d}: Logarithm of tree diameter at breast height.}
#' \item{\code{sq.d}: Square of tree diameter at breast height.}
#' \item{\code{sqrt.d}: Square-root of tree diameter at breast height.}
#' \item{\code{h}: Tree height (m).}
#' \item{\code{inv.h}: Inverse of tree height.}
#' \item{\code{ln.h}: Logarithm of tree height.}
#' \item{\code{h.d}: Height to diameter ratio.}
#' \item{\code{N}: Stand tree density.}
#' \item{\code{BAL}: Basal area of trees larger than the target tree.}
#' \item{\code{BAL.ln.d}: Basal area of larger trees divided by the logarithm of tree diameter.}
#' \item{\code{BAL.ext}: Basal area of trees extracted in a previous step.}
#' \item{\code{G}: Stand total basal area.}
#' \item{\code{ln.G}: Logarithm of total basal area.}
#' }
#' Additional columns may be returned if required using \code{keep.vars}. Function \code{prepareSpeciesCompetitionTable} returns a data frame with as many
#' rows as species in plots and columns:
#' \itemize{
#' \item{\code{Province}: Spanish province code (will be empty if \code{provinceFromID = FALSE}).}
#' \item{\code{ID}: Plot code.}
#' \item{\code{species}: Species code.}
#' \item{\code{G}: Stand total basal area.}
#' \item{\code{ln.G}: Logarithm of total basal area.}
#' \item{\code{ln.N}: Logarithm of stand total tree density.}
#' \item{\code{Nsp.N}: Proportion of trees of the target species.}
#' }
#'
#' @name prepareTreeCompetitionTable
#' @aliases prepareTreeCompetitionTable prepareSpeciesCompetitionTable
#'
#' @examples
#' # Load example tree data and coordinates
#' data(exampleTreeData)
#' data(examplePlotCoords)
#'
#' # Prepare input for growth/survival models
#' prepareTreeCompetitionTable(exampleTreeData)
#'
#' # Prepare input for ingrowth models
#' prepareSpeciesCompetitionTable(exampleTreeData)
#'
#' # Prepare input for ingrowth models including dispersal effects
#' nb = IFNknn(examplePlotCoords, k = 1)
#' Nmatrix = tapply(exampleTreeData$N, list(exampleTreeData$ID, exampleTreeData$Species),
#' sum, na.rm=T)
#' NspNmatrix = sweep(Nmatrix, 1, rowSums(Nmatrix, na.rm=T), "/")
#' NspNmatrix = rbind(NspNmatrix,c(0.5, NA, NA, NA))
#' rownames(NspNmatrix)[4] = "80003"
#' NspNmatrix = cbind(NspNmatrix, c(NA,NA,NA,0.5))
#' colnames(NspNmatrix)[5] = "25"
#' prepareSpatialSpeciesCompetitionTable(exampleTreeData, nb, NspNmatrix)
prepareTreeCompetitionTable<-function(x, BAL = TRUE, BALext = FALSE, sortByDBH = FALSE,
keep.vars = character(0), provinceFromID = FALSE,
verbose = FALSE) {
if(BALext) {
if(!("OIFFIN" %in% names(x))) stop("Field 'OIFFIN' is needed to calculate BALext")
}
prepareTreeCompetitionPlot<-function(y) {
ntree = nrow(y)
SecAreaN = y$N*pi*(y$DBH/200)^2 # Sectional area (in m2)
G = sum(SecAreaN)
# o = order(y$DBH, decreasing = T)
# BAL_v = rep(0, ntree)
# BAL_ext_v = rep(0, ntree)
# if(BAL) {
# BAL_v = cumsum(SecAreaN[o])[order(o)]
# }
# if(BALext) {
# SecAreaN[y$OIFFIN!=0] = 0
# BAL_ext_v = cumsum(SecAreaN[o])[order(o)]
# }
BAL_v = rep(0, ntree)
BAL_ext_v = rep(0, ntree)
if((ntree>0) && (BAL || BALext)) {
for(i in 1:ntree) {
if(BAL) {
sel = (y$DBH> y$DBH[i])
BAL_v[i] = sum(SecAreaN[sel])
}
if(BALext) {
sel = (y$DBH> y$DBH[i] & y$OIFFIN == 0) #Trees that were cut in IFN3
sel[is.na(sel)] = FALSE
BAL_ext_v[i] = sum(SecAreaN[sel])
}
}
}
df = data.frame("Province" = rep(NA, ntree),
"ID" = y$ID,
"Species" = y$Species,
"d" = y$DBH, "inv.d" = 1/y$DBH, "ln.d" = log(y$DBH+1), "sq.d"= (y$DBH)^2, "sqrt.d" = sqrt(y$DBH),
"h" = rep(NA, ntree), "inv.h" = rep(NA, ntree), "ln.h" = rep(NA, ntree), "h.d"= rep(NA,ntree),
"N" = rep(sum(y$N), ntree),
"BAL" = BAL_v, "BAL.ln.d" = BAL_v/log(y$DBH+1), "BAL.ext" = BAL_ext_v,
"G"=G, "ln.G" = log(G), stringsAsFactors = FALSE)
if("H" %in% names(y)) {
df$h = y$H
df$inv.h = 1/y$H
df$ln.h = log(y$H+1)
df$h.d = y$H/y$DBH
}
if(length(keep.vars)>0) df= data.frame(df, y[,keep.vars, drop=FALSE])
if(sortByDBH) df = df[order(df$d),]
return(df)
}
IDs = unique(x$ID)
sel1 = (x$ID==IDs[1])
df1 = prepareTreeCompetitionPlot(x[sel1, , drop=FALSE])
cn = names(df1)
df = data.frame(matrix(NA,ncol=length(cn), nrow=nrow(x)))
names(df) = cn
row.names(df) = row.names(x)
df$ID = as.character(df$ID)
df$Species = as.character(df$Species)
df[sel1,] = df1
if(length(IDs)>1) {
if(verbose) {
pb = txtProgressBar(1, length(IDs), style=3)
}
for(i in 2:length(IDs)) {
if(verbose) setTxtProgressBar(pb,i)
seli = (x$ID==IDs[i])
resi = prepareTreeCompetitionPlot(x[seli,,drop=FALSE])
df$ID[seli] =resi$ID
df$Species[seli] =resi$Species
df[seli,-c(1,2)] = resi[,-c(1,2)]
}
}
if(provinceFromID) {
df$Province = .getProvinceFromID(x$ID)
}
return(df)
}
#' @rdname prepareTreeCompetitionTable
prepareSpeciesCompetitionTable<-function(x, provinceFromID = FALSE, verbose = FALSE) {
prepareSpeciesCompetitionPlot<-function(y) {
SecArea = pi*(y$DBH/200)^2 # Sectional area (in m2)
sdDBH = sd(y$DBH)
G = sum(SecArea*y$N)
N = sum(y$N)
spp = unique(y$Species)
nspp = length(spp)
Nsp = rep(NA, nspp)
for(i in 1:nspp) Nsp[i] = sum(y$N[y$Species==spp[i]])
df = data.frame("Species" = spp,
"G" = G, "ln.G" = log(G), "ln.N" = log(N), "Nsp.N" = Nsp/N, "sd.DBH" = sdDBH)
df$Species = as.character(df$Species)
return(df)
}
idChar = as.character(x$ID)
x$Species = as.character(x$Species)
nspp = tapply(x$Species, idChar, function(y) length(unique(y)))
nrows = sum(nspp)
df = data.frame("Province" = character(nrows), "ID" = character(nrows), "Species" = character(nrows),
"G"=numeric(nrows), "ln.G"=numeric(nrows),
"ln.N"=numeric(nrows), "Nsp.N"=numeric(nrows), "sd.DBH"=numeric(nrows),stringsAsFactors = FALSE)
IDs = unique(idChar)
if(verbose && length(IDs)>1) {
pb = txtProgressBar(1, length(IDs), style=3)
}
cnt = 0
for(i in 1:length(IDs)) {
if(verbose && length(IDs)>1) setTxtProgressBar(pb,i)
dfi = prepareSpeciesCompetitionPlot(x[idChar==IDs[i],])
df$Province[(cnt+1):(cnt+nrow(dfi))] = NA
if(provinceFromID) {
df$Province[(cnt+1):(cnt+nrow(dfi))] = .getProvinceFromID(IDs[i])
}
df$ID[(cnt+1):(cnt+nrow(dfi))] = rep(IDs[i], nrow(dfi))
df$Species[(cnt+1):(cnt+nrow(dfi))] = as.character(dfi$Species)
df[(cnt+1):(cnt+nrow(dfi)),-c(1,2,3)] = dfi[,-1]
cnt = cnt + nrow(dfi)
}
return(df)
}
#' @rdname prepareTreeCompetitionTable
#' @param nb An object of class \code{listw} (see functions \code{\link{IFNknn}} and \code{\link{nb2listw}}).
#' @param NspNmatrix A numeric matrix with the density proportion of each species (columns) in each plot (rows).
prepareSpatialSpeciesCompetitionTable<-function(x, nb, NspNmatrix, sigma = c(0.5, 1, 2, 4),
provinceFromID = FALSE, verbose = FALSE) {
x = prepareSpeciesCompetitionTable(x, provinceFromID = provinceFromID, verbose = verbose)
IDs_x = unique(x$ID) #Target plots
IDs_matrix = rownames(NspNmatrix)
spp_m = unique(colnames(NspNmatrix)) #Target species
IDs_nb = attr(nb,"ID")
x_exp <- x
x_dis <- x %>% distinct(ID, .keep_all = TRUE)
if(verbose) {
pb = txtProgressBar(1, nrow(x_dis), style=3)
}
for(i in 1:nrow(x_dis)) {
if(verbose) setTxtProgressBar(pb,i)
id = x_dis$ID[i]
oldSpp = x$Species[x$ID==id]
#Find plot index in nb
inb = which(IDs_nb==id)
#Calculate kernel (including plots with no Nmatrix data)
nIDs = IDs_nb[nb$neighbours[[inb]]]
#Select
newSpp = spp_m[which(colSums(NspNmatrix[IDs_matrix %in% nIDs, , drop = FALSE], na.rm=T)>0)]
newSpp = newSpp[!(newSpp %in% oldSpp)]
if(length(newSpp)>0) {
nr <- data.frame(x_dis[i,], NewSpp = newSpp, row.names = NULL)
nr$Species = nr$NewSpp
nr$NewSpp = NULL
nr$Nsp.N = 0
x_exp <- bind_rows(x_exp, nr)
}
}
#Define variables
for(s in sigma) x_exp[[paste0("Nsp.N_s", s)]] = NA
if(verbose) {
pb = txtProgressBar(1, nrow(x_exp), style=3)
}
for(i in 1:nrow(x_exp)) {
if(verbose) setTxtProgressBar(pb,i)
id = x_exp$ID[i]
sp = x_exp$Species[i]
#Find plot index in nb
inb = which(IDs_nb==id)
#Distances
di = nb$distances[[inb]]
names(di) = IDs_nb[nb$neighbours[[inb]]]
di_def = di[names(di) %in% IDs_matrix]
#Extract NspNi vectors (not target plot)
# if(sp=="217") print(id)
if(sp %in% spp_m) {
NspNi_m = NspNmatrix[names(di_def),sp]
#Add target plot (distance 0)
di_def = c(0, di_def)
names(di_def)[1] = id
NspNi = c(x_exp$Nsp.N[i], NspNi_m)
for(s in sigma) {
#Calculate kernel (including plots with no Nmatrix data)
ki = exp(-(di_def/s)^2)
#Normalize full kernel
ki_def = ki/sum(ki)
#Calculate weighed value
x_exp[i, paste0("Nsp.N_s", s)] = max(x_exp$Nsp.N[i], sum(NspNi*ki_def,na.rm=T))
}
}
}
return(x_exp)
}
miquelcaceres/IFNdyn documentation built on Feb. 1, 2021, 10:55 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 prepareSpatialSpeciesCompetitionTable prepareSpeciesCompetitionTable prepareTreeCompetitionTable
Documented in prepareSpatialSpeciesCompetitionTable prepareSpeciesCompetitionTable prepareTreeCompetitionTable
#' Prepares variables for model input
#'
#' Prepares tree and competition variables from IFN tree data for model input (used internally in model functions like \code{\link{IFNgrowth}}).
#'
#' @param x a data frame with column names.
#' @param BAL A flag to indicate that basal area of larger trees (between inventories) has to be calculated.
#' @param BALext A flag to indicate that basal area of larger extracted trees (between inventories) has to be calculated (requires column 'OIFFIN' in \code{x}).
#' @param sortByDBH A flag to sort rows within each plot by increasing diameter at breast height.
#' @param keep.vars A character vector with names of variables in \code{x} that should be copied to the output data frame.
#' @param provinceFromID A flag to indicate that province should be extracted from 'ID' assuming they are IFN plot codes.
#' @param verbose A flag to indicate console output during the process.
#'
#' @return Function \code{prepareTreeCompetitionTable} returns a data frame with as many rows as rows in the input \code{x} object
#' and columns:
#' \itemize{
#' \item{\code{Province}: Spanish province code (will be empty if \code{provinceFromID = FALSE}).}
#' \item{\code{ID}: Plot code.}
#' \item{\code{species}: Species code.}
#' \item{\code{d}: Tree diameter at breast height.}
#' \item{\code{inv.d}: Inverse of tree diameter at breast height.}
#' \item{\code{ln.d}: Logarithm of tree diameter at breast height.}
#' \item{\code{sq.d}: Square of tree diameter at breast height.}
#' \item{\code{sqrt.d}: Square-root of tree diameter at breast height.}
#' \item{\code{h}: Tree height (m).}
#' \item{\code{inv.h}: Inverse of tree height.}
#' \item{\code{ln.h}: Logarithm of tree height.}
#' \item{\code{h.d}: Height to diameter ratio.}
#' \item{\code{N}: Stand tree density.}
#' \item{\code{BAL}: Basal area of trees larger than the target tree.}
#' \item{\code{BAL.ln.d}: Basal area of larger trees divided by the logarithm of tree diameter.}
#' \item{\code{BAL.ext}: Basal area of trees extracted in a previous step.}
#' \item{\code{G}: Stand total basal area.}
#' \item{\code{ln.G}: Logarithm of total basal area.}
#' }
#' Additional columns may be returned if required using \code{keep.vars}. Function \code{prepareSpeciesCompetitionTable} returns a data frame with as many
#' rows as species in plots and columns:
#' \itemize{
#' \item{\code{Province}: Spanish province code (will be empty if \code{provinceFromID = FALSE}).}
#' \item{\code{ID}: Plot code.}
#' \item{\code{species}: Species code.}
#' \item{\code{G}: Stand total basal area.}
#' \item{\code{ln.G}: Logarithm of total basal area.}
#' \item{\code{ln.N}: Logarithm of stand total tree density.}
#' \item{\code{Nsp.N}: Proportion of trees of the target species.}
#' }
#'
#' @name prepareTreeCompetitionTable
#' @aliases prepareTreeCompetitionTable prepareSpeciesCompetitionTable
#'
#' @examples
#' # Load example tree data and coordinates
#' data(exampleTreeData)
#' data(examplePlotCoords)
#'
#' # Prepare input for growth/survival models
#' prepareTreeCompetitionTable(exampleTreeData)
#'
#' # Prepare input for ingrowth models
#' prepareSpeciesCompetitionTable(exampleTreeData)
#'
#' # Prepare input for ingrowth models including dispersal effects
#' nb = IFNknn(examplePlotCoords, k = 1)
#' Nmatrix = tapply(exampleTreeData$N, list(exampleTreeData$ID, exampleTreeData$Species),
#' sum, na.rm=T)
#' NspNmatrix = sweep(Nmatrix, 1, rowSums(Nmatrix, na.rm=T), "/")
#' NspNmatrix = rbind(NspNmatrix,c(0.5, NA, NA, NA))
#' rownames(NspNmatrix)[4] = "80003"
#' NspNmatrix = cbind(NspNmatrix, c(NA,NA,NA,0.5))
#' colnames(NspNmatrix)[5] = "25"
#' prepareSpatialSpeciesCompetitionTable(exampleTreeData, nb, NspNmatrix)
prepareTreeCompetitionTable<-function(x, BAL = TRUE, BALext = FALSE, sortByDBH = FALSE,
keep.vars = character(0), provinceFromID = FALSE,
verbose = FALSE) {
if(BALext) {
if(!("OIFFIN" %in% names(x))) stop("Field 'OIFFIN' is needed to calculate BALext")
}
prepareTreeCompetitionPlot<-function(y) {
ntree = nrow(y)
SecAreaN = y$N*pi*(y$DBH/200)^2 # Sectional area (in m2)
G = sum(SecAreaN)
# o = order(y$DBH, decreasing = T)
# BAL_v = rep(0, ntree)
# BAL_ext_v = rep(0, ntree)
# if(BAL) {
# BAL_v = cumsum(SecAreaN[o])[order(o)]
# }
# if(BALext) {
# SecAreaN[y$OIFFIN!=0] = 0
# BAL_ext_v = cumsum(SecAreaN[o])[order(o)]
# }
BAL_v = rep(0, ntree)
BAL_ext_v = rep(0, ntree)
if((ntree>0) && (BAL || BALext)) {
for(i in 1:ntree) {
if(BAL) {
sel = (y$DBH> y$DBH[i])
BAL_v[i] = sum(SecAreaN[sel])
}
if(BALext) {
sel = (y$DBH> y$DBH[i] & y$OIFFIN == 0) #Trees that were cut in IFN3
sel[is.na(sel)] = FALSE
BAL_ext_v[i] = sum(SecAreaN[sel])
}
}
}
df = data.frame("Province" = rep(NA, ntree),
"ID" = y$ID,
"Species" = y$Species,
"d" = y$DBH, "inv.d" = 1/y$DBH, "ln.d" = log(y$DBH+1), "sq.d"= (y$DBH)^2, "sqrt.d" = sqrt(y$DBH),
"h" = rep(NA, ntree), "inv.h" = rep(NA, ntree), "ln.h" = rep(NA, ntree), "h.d"= rep(NA,ntree),
"N" = rep(sum(y$N), ntree),
"BAL" = BAL_v, "BAL.ln.d" = BAL_v/log(y$DBH+1), "BAL.ext" = BAL_ext_v,
"G"=G, "ln.G" = log(G), stringsAsFactors = FALSE)
if("H" %in% names(y)) {
df$h = y$H
df$inv.h = 1/y$H
df$ln.h = log(y$H+1)
df$h.d = y$H/y$DBH
}
if(length(keep.vars)>0) df= data.frame(df, y[,keep.vars, drop=FALSE])
if(sortByDBH) df = df[order(df$d),]
return(df)
}
IDs = unique(x$ID)
sel1 = (x$ID==IDs[1])
df1 = prepareTreeCompetitionPlot(x[sel1, , drop=FALSE])
cn = names(df1)
df = data.frame(matrix(NA,ncol=length(cn), nrow=nrow(x)))
names(df) = cn
row.names(df) = row.names(x)
df$ID = as.character(df$ID)
df$Species = as.character(df$Species)
df[sel1,] = df1
if(length(IDs)>1) {
if(verbose) {
pb = txtProgressBar(1, length(IDs), style=3)
}
for(i in 2:length(IDs)) {
if(verbose) setTxtProgressBar(pb,i)
seli = (x$ID==IDs[i])
resi = prepareTreeCompetitionPlot(x[seli,,drop=FALSE])
df$ID[seli] =resi$ID
df$Species[seli] =resi$Species
df[seli,-c(1,2)] = resi[,-c(1,2)]
}
}
if(provinceFromID) {
df$Province = .getProvinceFromID(x$ID)
}
return(df)
}
#' @rdname prepareTreeCompetitionTable
prepareSpeciesCompetitionTable<-function(x, provinceFromID = FALSE, verbose = FALSE) {
prepareSpeciesCompetitionPlot<-function(y) {
SecArea = pi*(y$DBH/200)^2 # Sectional area (in m2)
sdDBH = sd(y$DBH)
G = sum(SecArea*y$N)
N = sum(y$N)
spp = unique(y$Species)
nspp = length(spp)
Nsp = rep(NA, nspp)
for(i in 1:nspp) Nsp[i] = sum(y$N[y$Species==spp[i]])
df = data.frame("Species" = spp,
"G" = G, "ln.G" = log(G), "ln.N" = log(N), "Nsp.N" = Nsp/N, "sd.DBH" = sdDBH)
df$Species = as.character(df$Species)
return(df)
}
idChar = as.character(x$ID)
x$Species = as.character(x$Species)
nspp = tapply(x$Species, idChar, function(y) length(unique(y)))
nrows = sum(nspp)
df = data.frame("Province" = character(nrows), "ID" = character(nrows), "Species" = character(nrows),
"G"=numeric(nrows), "ln.G"=numeric(nrows),
"ln.N"=numeric(nrows), "Nsp.N"=numeric(nrows), "sd.DBH"=numeric(nrows),stringsAsFactors = FALSE)
IDs = unique(idChar)
if(verbose && length(IDs)>1) {
pb = txtProgressBar(1, length(IDs), style=3)
}
cnt = 0
for(i in 1:length(IDs)) {
if(verbose && length(IDs)>1) setTxtProgressBar(pb,i)
dfi = prepareSpeciesCompetitionPlot(x[idChar==IDs[i],])
df$Province[(cnt+1):(cnt+nrow(dfi))] = NA
if(provinceFromID) {
df$Province[(cnt+1):(cnt+nrow(dfi))] = .getProvinceFromID(IDs[i])
}
df$ID[(cnt+1):(cnt+nrow(dfi))] = rep(IDs[i], nrow(dfi))
df$Species[(cnt+1):(cnt+nrow(dfi))] = as.character(dfi$Species)
df[(cnt+1):(cnt+nrow(dfi)),-c(1,2,3)] = dfi[,-1]
cnt = cnt + nrow(dfi)
}
return(df)
}
#' @rdname prepareTreeCompetitionTable
#' @param nb An object of class \code{listw} (see functions \code{\link{IFNknn}} and \code{\link{nb2listw}}).
#' @param NspNmatrix A numeric matrix with the density proportion of each species (columns) in each plot (rows).
prepareSpatialSpeciesCompetitionTable<-function(x, nb, NspNmatrix, sigma = c(0.5, 1, 2, 4),
provinceFromID = FALSE, verbose = FALSE) {
x = prepareSpeciesCompetitionTable(x, provinceFromID = provinceFromID, verbose = verbose)
IDs_x = unique(x$ID) #Target plots
IDs_matrix = rownames(NspNmatrix)
spp_m = unique(colnames(NspNmatrix)) #Target species
IDs_nb = attr(nb,"ID")
x_exp <- x
x_dis <- x %>% distinct(ID, .keep_all = TRUE)
if(verbose) {
pb = txtProgressBar(1, nrow(x_dis), style=3)
}
for(i in 1:nrow(x_dis)) {
if(verbose) setTxtProgressBar(pb,i)
id = x_dis$ID[i]
oldSpp = x$Species[x$ID==id]
#Find plot index in nb
inb = which(IDs_nb==id)
#Calculate kernel (including plots with no Nmatrix data)
nIDs = IDs_nb[nb$neighbours[[inb]]]
#Select
newSpp = spp_m[which(colSums(NspNmatrix[IDs_matrix %in% nIDs, , drop = FALSE], na.rm=T)>0)]
newSpp = newSpp[!(newSpp %in% oldSpp)]
if(length(newSpp)>0) {
nr <- data.frame(x_dis[i,], NewSpp = newSpp, row.names = NULL)
nr$Species = nr$NewSpp
nr$NewSpp = NULL
nr$Nsp.N = 0
x_exp <- bind_rows(x_exp, nr)
}
}
#Define variables
for(s in sigma) x_exp[[paste0("Nsp.N_s", s)]] = NA
if(verbose) {
pb = txtProgressBar(1, nrow(x_exp), style=3)
}
for(i in 1:nrow(x_exp)) {
if(verbose) setTxtProgressBar(pb,i)
id = x_exp$ID[i]
sp = x_exp$Species[i]
#Find plot index in nb
inb = which(IDs_nb==id)
#Distances
di = nb$distances[[inb]]
names(di) = IDs_nb[nb$neighbours[[inb]]]
di_def = di[names(di) %in% IDs_matrix]
#Extract NspNi vectors (not target plot)
# if(sp=="217") print(id)
if(sp %in% spp_m) {
NspNi_m = NspNmatrix[names(di_def),sp]
#Add target plot (distance 0)
di_def = c(0, di_def)
names(di_def)[1] = id
NspNi = c(x_exp$Nsp.N[i], NspNi_m)
for(s in sigma) {
#Calculate kernel (including plots with no Nmatrix data)
ki = exp(-(di_def/s)^2)
#Normalize full kernel
ki_def = ki/sum(ki)
#Calculate weighed value
x_exp[i, paste0("Nsp.N_s", s)] = max(x_exp$Nsp.N[i], sum(NspNi*ki_def,na.rm=T))
}
}
}
return(x_exp)
}
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.