Nothing
R/standingTrees.R
In sampSurf: Sampling Surface Simulation for Areal Sampling Methods
Defines functions
.statsStandingTrees
#---------------------------------------------------------------------------
#
# This file holds the S4 definition for the constructors of standingTrees
# generic and methods. This is used for a collection or population of
# "standingTrees"
#
# Constructors include signatures for...
# 1. numeric, matrix: number of trees to generate within an sp bbox
# matrix--uses method (5) after calling sampleTrees for the data frame
# 2. numeric, missing: sampling from within a bounded area as defined
# by the xlim & ylim args--object is the number of trees to be
# generated--uses method (1) after turning limits into a matrix
# 3. numeric, bufferedTract: generate trees with centers lying inside
# the buffer of a bufferedTract object--calls method (1) with
# the buffer as matrix
# 4. list, missing: passing a list of already created "downLog"
# objects--good for an existing population--creates the object directly
# 5. data.frame, missing: allows one to pass a data frame of trees that
# have been generated by the sampleTrees function--turns the data frame
# into a list and calls method (4) directly
#
# From the above, we can see that all methods lead to method (4), the list
# method; i.e., 2-->1-->5-->4 & 3-->1-->5-->4. Therefore, any real additions
# on what is finally generated should be to method 4, which will affect all
# the other constructors.
#
# Note: In 3. I have put an explicit check in to make sure units desired for
# trees are the same a those for the bufferedTract; unfortunately, this
# is not possible for 1. or 2., so the user is on their own.
#
# Also included at the end is the function .statsDownLogs() for calculating
# basic statistics on the tree collection.
#
# Returns...
# a valid "standingTrees" object.
#
# **Please note that this was written a year after the downLogs components
# and is patterned exactly after those constructors. It might not have been
# the best way to do things in hindsight, but it is now the most pragmatic
# good or bad.
#
#Author... Date: 26-Oct-2011
# Jeffrey H. Gove
# USDA Forest Service
# Northern Research Station
# 271 Mast Road
# Durham, NH 03824
# jhgove@unh.edu
# phone: 603-868-7667 fax: 603-868-7604
#---------------------------------------------------------------------------
# generic definition...
#
#if (!isGeneric("standingTrees"))
setGeneric('standingTrees',
function(object, container, ...) standardGeneric('standingTrees'),
signature = c('object', 'container')
)
#================================================================================
# 1. method for function for synthetic simulation of trees; this takes the number
# of trees to generate and a bbox matrix from wihtin which the tree centers are
# drawn...
#
setMethod('standingTrees',
signature(object = 'numeric', container='matrix'),
function(object, #number of trees to generate
container, #within these bounds--a bbox matrix
units = 'metric',
dbhs = c(8, 40), #cm for object construction!
topDiams = c(0.4, 0.9), #proportion multiplier
heights = c(5,15),
solidTypes = c(1,10),
species = .StemEnv$species,
...
)
{
#------------------------------------------------------------------------------
#
# first some checks...
#
if(object < 1 || length(object)>1 || !is.numeric(object))
stop('"object" (number of trees) must be a positive numeric scalar!')
# make sure we have a valid "bbox" type matrix...
stopifnot(bboxCheck(container))
numTrees = object #a little easier to understand
sampleRect = container #again
#
# draw the population of trees using the general tree sampling function...
#
strees = sampleTrees(numTrees, dbhs=dbhs, topDiams=topDiams,
heights = heights,
solidTypes = solidTypes, species=species,
sampleRect = sampleRect,
...
)
dlo = standingTrees(strees, units=units, ...) #call the data.frame method
return(dlo)
} #standingTrees method for synthetic
) #setMethod
#================================================================================
# 2. method for function for synthetic simulation of trees within a set of
# xlim & ylim coordinate--just turn these into a matrix and call the
# matrix container routine...
#
setMethod('standingTrees',
signature(object = 'numeric', container='missing'),
function(object, #number of trees to generate
xlim = c(0,100), #within these bounds
ylim = c(0,50),
units = 'metric',
...
)
{
#------------------------------------------------------------------------------
#
numTrees = object
# create bbox rectangle as a matrix from limits...
sampleRect = matrix(c(xlim, ylim),
nrow = 2, byrow = TRUE,
dimnames = list(c('x','y'),c('min','max'))
)
sts = standingTrees(numTrees, sampleRect, units=units, ...)
return(sts)
} #standingTrees method for synthetic with x,y limit vectors bbox
) #setMethod
#================================================================================
# 3. method for function for synthetic simulation of trees from within a
# bufferedTract internal bbox--just call the matrix container method using
# the buffer for drawing the tree centers...
#
setMethod('standingTrees',
signature(object = 'numeric', container='bufferedTract'),
function(object, #number of trees to generate
container, #within these bounds
units = 'metric',
...
)
{
#------------------------------------------------------------------------------
#
numTrees = object
#
# quick check to make sure all trees are same units as bufferedTract...
#
for(i in seq_len(numTrees))
if(units != container@units)
stop('standingTrees: Units for trees and container do not match!')
sts = standingTrees(numTrees, container@bufferRect, units=units, ...)
return(sts)
} #standingTrees method for synthetic with bufferedtract bbox
) #setMethod
#================================================================================
# 4. method for function for a previously made collection of standingTree objects,
# stored within a list; note that the constructor will check all the individual
# trees to make sure they are in fact each valid standingTree objects; in addition,
# the diameters should already have been correctly converted to units of length
# within these original objects...
#
setMethod('standingTrees',
signature(object = 'list', container='missing'),
function(object,
description = '',
...
)
{
#------------------------------------------------------------------------------
#
trees = object
numTrees = length(trees)
if(numTrees < 1)
stop('"object" must be at least one tree in the list')
names(trees) = paste('tree',1:numTrees,sep='.')
#
# group all polygons into one SpatialPolygons to get the overall bbox...
#
sp = vector('list', numTrees)
for(i in seq_len(numTrees))
sp[[i]] = trees[[i]]@spDBH@polygons$pgsDBH
sps = SpatialPolygons(sp)
bbox = bbox(sps)
stats = .statsStandingTrees(trees)
#
# create the object directly, let the constructor check the rest...
#
sto = new('standingTrees', trees=trees, bbox=bbox, units=trees[[1]]@units,
stats=stats, description=description)
return(sto)
} #standingTrees method for list
) #setMethod
#================================================================================
# 5. method for function for a previously made collection of trees generated from
# the sampleTrees() function, which returns a data frame object...
#
setMethod('standingTrees',
signature(object = 'data.frame', container='missing'),
function(object,
units = 'metric',
...
)
{
#------------------------------------------------------------------------------
# assuming a data frame in the form returned by sampleTrees() here, a simple
# check for this follows...
#
n.stn = length(.StemEnv$sampleTreesNames)
if(!length(na.omit(match(names(object), .StemEnv$sampleTreesNames))) == n.stn)
stop('Names of data frame with trees must match those returned from "sampleTrees"!')
trees = object
numTrees = nrow(trees)
#
# standingTree constructor will convert from in/cm to feet/meters...
#
stl = vector('list', numTrees)
for(i in seq_len(numTrees))
stl[[i]] = standingTree(dbh = trees[i,'dbh'], #in cm or inches!
topDiam = trees[i,'topDiam'], #ibid
height = trees[i, 'height'],
solidType = trees[i, 'solidType'],
centerOffset = c(x=trees[i, 'x'], y=trees[i, 'y']),
species = trees[i, 'species'],
units = units,
... #not individualized, applies to all trees
)
sts = standingTrees(stl, units=units, ...) #call the list method
return(sts)
} #standingTrees method for data.frame
) #setMethod
#================================================================================
.statsStandingTrees = function(trees)
{
#------------------------------------------------------------------------------
# calculates summary statistics on the trees in the list...
#------------------------------------------------------------------------------
attrNames = c('volume', 'height', 'surfaceArea', 'basalArea', 'biomass','carbon')
numTrees = length(trees)
nvars = length(attrNames)
treeAttr = matrix(NA, nrow=numTrees, ncol=nvars) #tree attributes
colnames(treeAttr) = attrNames
for(i in seq_len(numTrees)) {
treeAttr[i,1] = trees[[i]]@treeVol
treeAttr[i,2] = trees[[i]]@height
treeAttr[i,3] = trees[[i]]@surfaceArea
treeAttr[i,4] = trees[[i]]@ba
treeAttr[i,5] = trees[[i]]@biomass
treeAttr[i,6] = trees[[i]]@carbon
}
#
# carbon and biomass can be all NAs and will throw warnings of no non-NA values when
# calculated some stats (like min) below; so keep it quiet...
#
suppressWarnings({
stats = data.frame(matrix(NA, nrow=6, ncol=nvars)) #stats as rows, vars as columns
colnames(stats) = attrNames
rownames(stats) = c('mean','total','sd','var', 'min','max')
#stats[1,] = apply(treeAttr, 2, mean, na.rm=TRUE)
stats[1,] = colMeans(treeAttr, na.rm=TRUE)
stats[2,] = colSums(treeAttr, na.rm=TRUE)
stats[3,] = apply(treeAttr, 2, sd, na.rm=TRUE)
stats[4,] = apply(treeAttr, 2, var, na.rm=TRUE)
stats[5,] = apply(treeAttr, 2, min, na.rm=TRUE)
stats[6,] = apply(treeAttr, 2, max, na.rm=TRUE)
}) #suppressWarnings
#
# and clean these up if necessary...
#
if(all(is.na(treeAttr[,'biomass'])))
stats[,'biomass'] = NA
if(all(is.na(treeAttr[,'carbon'])))
stats[,'carbon'] = NA
return(stats)
} #statsStandingTrees
#showMethods('standingTrees')
Try the sampSurf package in your browser
Any scripts or data that you put into this service are public.
sampSurf documentation built on March 5, 2021, 5:06 p.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 .statsStandingTrees
#---------------------------------------------------------------------------
#
# This file holds the S4 definition for the constructors of standingTrees
# generic and methods. This is used for a collection or population of
# "standingTrees"
#
# Constructors include signatures for...
# 1. numeric, matrix: number of trees to generate within an sp bbox
# matrix--uses method (5) after calling sampleTrees for the data frame
# 2. numeric, missing: sampling from within a bounded area as defined
# by the xlim & ylim args--object is the number of trees to be
# generated--uses method (1) after turning limits into a matrix
# 3. numeric, bufferedTract: generate trees with centers lying inside
# the buffer of a bufferedTract object--calls method (1) with
# the buffer as matrix
# 4. list, missing: passing a list of already created "downLog"
# objects--good for an existing population--creates the object directly
# 5. data.frame, missing: allows one to pass a data frame of trees that
# have been generated by the sampleTrees function--turns the data frame
# into a list and calls method (4) directly
#
# From the above, we can see that all methods lead to method (4), the list
# method; i.e., 2-->1-->5-->4 & 3-->1-->5-->4. Therefore, any real additions
# on what is finally generated should be to method 4, which will affect all
# the other constructors.
#
# Note: In 3. I have put an explicit check in to make sure units desired for
# trees are the same a those for the bufferedTract; unfortunately, this
# is not possible for 1. or 2., so the user is on their own.
#
# Also included at the end is the function .statsDownLogs() for calculating
# basic statistics on the tree collection.
#
# Returns...
# a valid "standingTrees" object.
#
# **Please note that this was written a year after the downLogs components
# and is patterned exactly after those constructors. It might not have been
# the best way to do things in hindsight, but it is now the most pragmatic
# good or bad.
#
#Author... Date: 26-Oct-2011
# Jeffrey H. Gove
# USDA Forest Service
# Northern Research Station
# 271 Mast Road
# Durham, NH 03824
# jhgove@unh.edu
# phone: 603-868-7667 fax: 603-868-7604
#---------------------------------------------------------------------------
# generic definition...
#
#if (!isGeneric("standingTrees"))
setGeneric('standingTrees',
function(object, container, ...) standardGeneric('standingTrees'),
signature = c('object', 'container')
)
#================================================================================
# 1. method for function for synthetic simulation of trees; this takes the number
# of trees to generate and a bbox matrix from wihtin which the tree centers are
# drawn...
#
setMethod('standingTrees',
signature(object = 'numeric', container='matrix'),
function(object, #number of trees to generate
container, #within these bounds--a bbox matrix
units = 'metric',
dbhs = c(8, 40), #cm for object construction!
topDiams = c(0.4, 0.9), #proportion multiplier
heights = c(5,15),
solidTypes = c(1,10),
species = .StemEnv$species,
...
)
{
#------------------------------------------------------------------------------
#
# first some checks...
#
if(object < 1 || length(object)>1 || !is.numeric(object))
stop('"object" (number of trees) must be a positive numeric scalar!')
# make sure we have a valid "bbox" type matrix...
stopifnot(bboxCheck(container))
numTrees = object #a little easier to understand
sampleRect = container #again
#
# draw the population of trees using the general tree sampling function...
#
strees = sampleTrees(numTrees, dbhs=dbhs, topDiams=topDiams,
heights = heights,
solidTypes = solidTypes, species=species,
sampleRect = sampleRect,
...
)
dlo = standingTrees(strees, units=units, ...) #call the data.frame method
return(dlo)
} #standingTrees method for synthetic
) #setMethod
#================================================================================
# 2. method for function for synthetic simulation of trees within a set of
# xlim & ylim coordinate--just turn these into a matrix and call the
# matrix container routine...
#
setMethod('standingTrees',
signature(object = 'numeric', container='missing'),
function(object, #number of trees to generate
xlim = c(0,100), #within these bounds
ylim = c(0,50),
units = 'metric',
...
)
{
#------------------------------------------------------------------------------
#
numTrees = object
# create bbox rectangle as a matrix from limits...
sampleRect = matrix(c(xlim, ylim),
nrow = 2, byrow = TRUE,
dimnames = list(c('x','y'),c('min','max'))
)
sts = standingTrees(numTrees, sampleRect, units=units, ...)
return(sts)
} #standingTrees method for synthetic with x,y limit vectors bbox
) #setMethod
#================================================================================
# 3. method for function for synthetic simulation of trees from within a
# bufferedTract internal bbox--just call the matrix container method using
# the buffer for drawing the tree centers...
#
setMethod('standingTrees',
signature(object = 'numeric', container='bufferedTract'),
function(object, #number of trees to generate
container, #within these bounds
units = 'metric',
...
)
{
#------------------------------------------------------------------------------
#
numTrees = object
#
# quick check to make sure all trees are same units as bufferedTract...
#
for(i in seq_len(numTrees))
if(units != container@units)
stop('standingTrees: Units for trees and container do not match!')
sts = standingTrees(numTrees, container@bufferRect, units=units, ...)
return(sts)
} #standingTrees method for synthetic with bufferedtract bbox
) #setMethod
#================================================================================
# 4. method for function for a previously made collection of standingTree objects,
# stored within a list; note that the constructor will check all the individual
# trees to make sure they are in fact each valid standingTree objects; in addition,
# the diameters should already have been correctly converted to units of length
# within these original objects...
#
setMethod('standingTrees',
signature(object = 'list', container='missing'),
function(object,
description = '',
...
)
{
#------------------------------------------------------------------------------
#
trees = object
numTrees = length(trees)
if(numTrees < 1)
stop('"object" must be at least one tree in the list')
names(trees) = paste('tree',1:numTrees,sep='.')
#
# group all polygons into one SpatialPolygons to get the overall bbox...
#
sp = vector('list', numTrees)
for(i in seq_len(numTrees))
sp[[i]] = trees[[i]]@spDBH@polygons$pgsDBH
sps = SpatialPolygons(sp)
bbox = bbox(sps)
stats = .statsStandingTrees(trees)
#
# create the object directly, let the constructor check the rest...
#
sto = new('standingTrees', trees=trees, bbox=bbox, units=trees[[1]]@units,
stats=stats, description=description)
return(sto)
} #standingTrees method for list
) #setMethod
#================================================================================
# 5. method for function for a previously made collection of trees generated from
# the sampleTrees() function, which returns a data frame object...
#
setMethod('standingTrees',
signature(object = 'data.frame', container='missing'),
function(object,
units = 'metric',
...
)
{
#------------------------------------------------------------------------------
# assuming a data frame in the form returned by sampleTrees() here, a simple
# check for this follows...
#
n.stn = length(.StemEnv$sampleTreesNames)
if(!length(na.omit(match(names(object), .StemEnv$sampleTreesNames))) == n.stn)
stop('Names of data frame with trees must match those returned from "sampleTrees"!')
trees = object
numTrees = nrow(trees)
#
# standingTree constructor will convert from in/cm to feet/meters...
#
stl = vector('list', numTrees)
for(i in seq_len(numTrees))
stl[[i]] = standingTree(dbh = trees[i,'dbh'], #in cm or inches!
topDiam = trees[i,'topDiam'], #ibid
height = trees[i, 'height'],
solidType = trees[i, 'solidType'],
centerOffset = c(x=trees[i, 'x'], y=trees[i, 'y']),
species = trees[i, 'species'],
units = units,
... #not individualized, applies to all trees
)
sts = standingTrees(stl, units=units, ...) #call the list method
return(sts)
} #standingTrees method for data.frame
) #setMethod
#================================================================================
.statsStandingTrees = function(trees)
{
#------------------------------------------------------------------------------
# calculates summary statistics on the trees in the list...
#------------------------------------------------------------------------------
attrNames = c('volume', 'height', 'surfaceArea', 'basalArea', 'biomass','carbon')
numTrees = length(trees)
nvars = length(attrNames)
treeAttr = matrix(NA, nrow=numTrees, ncol=nvars) #tree attributes
colnames(treeAttr) = attrNames
for(i in seq_len(numTrees)) {
treeAttr[i,1] = trees[[i]]@treeVol
treeAttr[i,2] = trees[[i]]@height
treeAttr[i,3] = trees[[i]]@surfaceArea
treeAttr[i,4] = trees[[i]]@ba
treeAttr[i,5] = trees[[i]]@biomass
treeAttr[i,6] = trees[[i]]@carbon
}
#
# carbon and biomass can be all NAs and will throw warnings of no non-NA values when
# calculated some stats (like min) below; so keep it quiet...
#
suppressWarnings({
stats = data.frame(matrix(NA, nrow=6, ncol=nvars)) #stats as rows, vars as columns
colnames(stats) = attrNames
rownames(stats) = c('mean','total','sd','var', 'min','max')
#stats[1,] = apply(treeAttr, 2, mean, na.rm=TRUE)
stats[1,] = colMeans(treeAttr, na.rm=TRUE)
stats[2,] = colSums(treeAttr, na.rm=TRUE)
stats[3,] = apply(treeAttr, 2, sd, na.rm=TRUE)
stats[4,] = apply(treeAttr, 2, var, na.rm=TRUE)
stats[5,] = apply(treeAttr, 2, min, na.rm=TRUE)
stats[6,] = apply(treeAttr, 2, max, na.rm=TRUE)
}) #suppressWarnings
#
# and clean these up if necessary...
#
if(all(is.na(treeAttr[,'biomass'])))
stats[,'biomass'] = NA
if(all(is.na(treeAttr[,'carbon'])))
stats[,'carbon'] = NA
return(stats)
} #statsStandingTrees
#showMethods('standingTrees')
Try the sampSurf package in your browser
Any scripts or data that you put into this service are public.
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.