################ Additional Data Tools ################
#' Soil climate component rating (Z)
#'
#' The soil climate component rating looks at the micro climates of the organic soils.
#' Organic soils are commonly colder than those of associated mineral soils.
#' Because of these differences in soil thermal properties and because organic
#' soils usually occupy low positions in the landscape, a temperature deduction
#' is considered for organic soils.
#' @param egdd Effective growing degree days.
#' @return Return the soil climate component rating
#' @export
soilClimateComponentRating <- function(egdd){
if(is.na(egdd)){
pointDeduct <- 0
} else {
if(egdd > 1600){
pointDeduct <- 0
} else if (egdd > 1200){
pointDeduct <- (-0.05 * egdd) + 85
} else {
pointDeduct <- 25
}
}
return(100 - pointDeduct)
}
#' Surface water supplying ability component rating
#'
#' The surface water supplying ability component rating returns the rating for
#' the surface component.
#' @param ppe Precipitation minus potential evapotranspiration
#' @param surfaceBD Surface bulk density
#' @return Surface water supplying ability component rating
#' @export
organicSurfaceWaterSupplyingAbilityComponentRating <- function(ppe,surfaceBD){
# 1. Water supplying ability
# 1a. Surface water supplying ability
if(is.na(surfaceBD) || is.na(ppe)){
surfaceWSADFPointDeduct <- 0
} else {
surfaceWSA <- surfaceWSADF()
bounds <- surfaceWSA[1,]
if(surfaceBD < bounds[3]){
tempcol <- 2
} else if(surfaceBD < bounds[4]){
tempcol <- 3
} else if(surfaceBD < bounds[5]){
tempcol <- 4
} else if(surfaceBD < bounds[6]){
tempcol <- 5
} else if(surfaceBD < bounds[7]){
tempcol <- 6
} else {
tempcol <- 7
}
tempcol <- surfaceWSA[,tempcol]
bounds <- surfaceWSA[,1]
if(ppe < bounds[2]){
surfaceWSADFPointDeduct <- tempcol[2]
} else if(ppe < bounds[3]){
surfaceWSADFPointDeduct <- tempcol[3]
} else if(ppe < bounds[4]){
surfaceWSADFPointDeduct <- tempcol[4]
} else if(ppe < bounds[5]){
surfaceWSADFPointDeduct <- tempcol[5]
} else if(ppe < bounds[6]){
surfaceWSADFPointDeduct <- tempcol[6]
} else if(ppe < bounds[7]){
surfaceWSADFPointDeduct <- tempcol[7]
} else if(ppe < bounds[8]){
surfaceWSADFPointDeduct <- tempcol[8]
} else {
surfaceWSADFPointDeduct <- tempcol[9]
}
}
# 2. Return the deduction points for the surface bulk density component rating
return(100 - surfaceWSADFPointDeduct)
}
#' Subsurface water supplying ability component rating
#'
#' The subsurface water supplying ability component rating returns the rating for
#' the subsurface component.
#' @param subsurfaceBD Subsurface bulk density
#' @param depthToWaterTable Depth to water table in cm
#' @return Subsurface water supplying ability component rating
#' @export
organicSubsurfaceWaterSupplyingAbilityComponentRating <- function(subsurfaceBD,depthToWaterTable){
# 1. Water supplying ability
# 1b. Subsurface water supplying ability based on depth to water table (cm)
if(is.na(depthToWaterTable) || is.na(subsurfaceBD)){
subsurfaceWSADFPointDeduct <- 0
} else {
subsurfaceWSA <- subsurfaceWSADF()
bounds <- subsurfaceWSA[1,]
if(subsurfaceBD < bounds[3]){
tempcol <- 2
} else if(subsurfaceBD < bounds[4]){
tempcol <- 3
} else if(subsurfaceBD < bounds[5]){
tempcol <- 4
} else if(subsurfaceBD < bounds[6]){
tempcol <- 5
} else if(subsurfaceBD < bounds[7]){
tempcol <- 6
} else if(subsurfaceBD < bounds[8]){
tempcol <- 7
} else if(subsurfaceBD < bounds[9]){
tempcol <- 8
} else {
tempcol <- 9
}
tempcol <- subsurfaceWSA[,tempcol]
bounds <- subsurfaceWSA[,1]
if(depthToWaterTable < bounds[3]){
subsurfaceWSADFPointDeduct <- tempcol[2]
} else if(depthToWaterTable < bounds[4]){
subsurfaceWSADFPointDeduct <- tempcol[3]
} else if(depthToWaterTable < bounds[5]){
subsurfaceWSADFPointDeduct <- tempcol[4]
} else if(depthToWaterTable < bounds[6]){
subsurfaceWSADFPointDeduct <- tempcol[5]
} else if(depthToWaterTable < bounds[7]){
subsurfaceWSADFPointDeduct <- tempcol[6]
} else {
subsurfaceWSADFPointDeduct <- tempcol[7]
}
}
# 2. Return the deduction points for the subsurface deduction
return(100 - subsurfaceWSADFPointDeduct)
}
#' Organic surface bulk density component rating
#'
#' The organic surface bulk density component rating returns the component
#' deduction for the surface factors of organic soils. The top 60cm of compacted
#' peat is considered for the base rating. Three factors are rated for their
#' contribution to seed establishment, crop growth and management.
#' @param surfaceBD Surface bulk density Mg/m^3
#' @param ppe Precipitation minus potential evapotranspiration
#' @param surfacepH Surface pH measured in saturated paste
#' @param surfaceSalinity Surface salinity measured in saturated paste (dS/m)
#' @return Point deduction for interim organic rating (surface factors).
#' @export
organicSurfaceBulkDensityComponentRating <- function(surfaceBD, ppe, surfacepH,surfaceSalinity){
# 1. Structure and consistence (B)
# This will change in future updates
if(is.na(surfaceBD) || is.na(ppe)){
BPointDeduct <- 0
} else {
OSCDF <- organicSCDF()
bounds <- OSCDF[1,]
if(surfaceBD < bounds[3]){
tempcol <- 2
} else if(surfaceBD < bounds[4]){
tempcol <- 3
} else if(surfaceBD < bounds[5]){
tempcol <- 4
} else if(surfaceBD < bounds[6]){
tempcol <- 5
} else if(surfaceBD < bounds[7]){
tempcol <- 6
} else if(surfaceBD < bounds[8]){
tempcol <- 7
} else if(surfaceBD < bounds[9]){
tempcol <- 8
} else {
tempcol <- 9
}
tempcol <- OSCDF[,tempcol]
bounds <- OSCDF[,1]
if(ppe < bounds[2]){
BPointDeduct <- tempcol[2]
} else if(ppe < bounds[3]){
BPointDeduct <- tempcol[3]
} else if(ppe < bounds[4]){
BPointDeduct <- tempcol[4]
} else if(ppe < bounds[5]){
BPointDeduct <- tempcol[5]
} else if(ppe < bounds[6]){
BPointDeduct <- tempcol[6]
} else if(ppe < bounds[7]){
BPointDeduct <- tempcol[7]
} else {
BPointDeduct <- tempcol[8]
}
}
# 2. Return the deduction points for the interim organic rating (surface factors)
# Ensure that the value will not be over 100 or less than 0
tempsum <- sum(BPointDeduct)
tempsum[tempsum < 0] <- 1
tempsum[tempsum > 100] <- 100
return(100 - tempsum)
}
#' Organic surface pH component rating
#'
#' The organic surface pH component rating returns the component
#' deduction for the surface factors of organic soils. The top 60cm of compacted
#' peat is considered for the base rating. Three factors are rated for their
#' contribution to seed establishment, crop growth and management.
#' @param surfaceBD Surface bulk density Mg/m^3
#' @param surfacepH Surface pH measured in saturated paste
#' @return Point deduction for interim organic rating (surface factors).
#' @export
organicSurfacepHComponentRating <- function(surfaceBD,surfacepH){
# 2.Reaction and nutrient status (V)
if(is.na(surfaceBD) || is.na(surfacepH)){
VPointDeduct <- 0
} else {
SORDF <- surfaceOrganicReactionDF()
bounds <- SORDF[1,]
if(surfaceBD < bounds[3]){
tempcol <- 2
} else if(surfaceBD < bounds[4]){
tempcol <- 3
} else if(surfaceBD < bounds[5]){
tempcol <- 4
} else {
tempcol <- 5
}
tempcol <- SORDF[,tempcol]
bounds <- SORDF[,1]
if(surfacepH > bounds[2]){
VPointDeduct <- tempcol[2]
} else if(surfacepH > bounds[3]){
VPointDeduct <- tempcol[3]
} else if(surfacepH > bounds[4]){
VPointDeduct <- tempcol[4]
} else if(surfacepH > bounds[5]){
VPointDeduct <- tempcol[5]
} else if(surfacepH > bounds[6]){
VPointDeduct <- tempcol[6]
} else if(surfacepH > bounds[7]){
VPointDeduct <- tempcol[7]
} else if(surfacepH > bounds[8]){
VPointDeduct <- tempcol[8]
} else if(surfacepH > bounds[9]){
VPointDeduct <- tempcol[9]
} else if(surfacepH > bounds[10]){
VPointDeduct <- tempcol[10]
} else {
VPointDeduct <- tempcol[11]
}
}
# 2. Return the deduction points for the interim organic rating (surface factors)
# Ensure that the value will not be over 100 or less than 0
tempsum <- sum(VPointDeduct)
tempsum[tempsum < 0] <- 1
tempsum[tempsum > 100] <- 100
return(100 - tempsum)
}
#' Organic surface salinity component rating
#'
#' The organic surface salinity component rating returns the component
#' deduction for the surface factors of organic soils. The top 60cm of compacted
#' peat is considered for the base rating. Three factors are rated for their
#' contribution to seed establishment, crop growth and management.
#' @param surfaceSalinity Surface salinity measured in saturated paste (dS/m)
#' @return Point deduction for interim organic rating (surface factors).
#' @export
organicSurfaceSalinityComponentRating <- function(surfaceSalinity){
# 3. Surface organic salinity (dS/m) (N)
# This will change in the future to include user defined and crop specific
# parameters.
if(is.na(surfaceSalinity)){
NPointDeduct <- 0
} else {
SOSDF <- surfaceOrganicSalinityDF()
bounds <- SOSDF[,1]
if(surfaceSalinity < bounds[1]){
NPointDeduct <- SOSDF[1,2]
} else if(surfaceSalinity < bounds[2]){
NPointDeduct <- SOSDF[2,2]
} else if(surfaceSalinity < bounds[3]){
NPointDeduct <- SOSDF[3,2]
} else {
NPointDeduct <- SOSDF[4,2]
}
}
# 2. Return the deduction points for the interim organic rating (surface factors)
# Ensure that the value will not be over 100 or less than 0
tempsum <- sum(NPointDeduct)
tempsum[tempsum < 0] <- 1
tempsum[tempsum > 100] <- 100
return(100 - tempsum)
}
#' Organic structure and consistence component rating (subsurface factors)
#'
#' The organic structure and consistence component rating returns the component
#' deduction for the structure and consistence. The maximum depth is considered at
#' 120cm. There are four factors that are recognized in this category, structure
#' (degree of decomposition) (B), depth of deposit and kind of substrate (G),
#' reaction (V) and salinity (N). Depth of deposit and kind of substrate are
#' currently not being used.
#' @param subsurfaceBD The subsurface bulk density Mg/m^3. Default is at 60cm depth.
#' @return Organic subsurface bulk density
#' @export
organicSubsurfaceStructureConsistenceComponentRating <- function(subsurfaceBD){
# 1. Structure and consistence (B)
if(is.na(subsurfaceBD)){
BPercentDeduct <- 0
} else {
if(subsurfaceBD < 0.07){
BPercentDeduct <- 20
} else if(subsurfaceBD < 0.1){
BPercentDeduct <- 10
} else if(subsurfaceBD < 0.13){
BPercentDeduct <- 0
} else if(subsurfaceBD < 0.20){
BPercentDeduct <- 5
} else if(subsurfaceBD < 0.22){
BPercentDeduct <- 10
} else {
BPercentDeduct <- 20
}
}
# 2. Return the percent deduction for basic organic rating (subsurface factors).
# Ensure that the value will not be over 100 or less than 0
tempsum <- sum(BPercentDeduct)
tempsum[tempsum < 0] <- 1
tempsum[tempsum > 100] <- 100
return(100 - tempsum)
}
#' Organic subsurface pH component rating (subsurface factors)
#'
#' The organic subsurface pH component rating returns the component
#' deduction for the subsurface pH. The maximum depth is considered at
#' 120cm. There are four factors that are recognized in this category, structure
#' (degree of decomposition) (B), depth of deposit and kind of substrate (G),
#' reaction (V) and salinity (N). Depth of deposit and kind of substrate are
#' currently not being used.
#' @param subsurfacepH The subsurface pH measured in saturated paste (dS/m). Default is at 60cm depth.
#' @return Organic subsurface pH
#' @export
organicSubsurfacepHComponentRating <- function(subsurfacepH){
# 3. Reaction and nutrient status (V)
if(is.na(subsurfacepH)){
VPercentDeduct <- 0
} else {
if(subsurfacepH > 5){
VPercentDeduct <- 10
} else if(subsurfacepH > 4){
VPercentDeduct <- 20
} else {
VPercentDeduct <- 30
}
}
# 2. Return the percent deduction for basic organic rating (subsurface factors).
# Ensure that the value will not be over 100 or less than 0
tempsum <- sum(VPercentDeduct)
tempsum[tempsum < 0] <- 1
tempsum[tempsum > 100] <- 100
return(100 - tempsum)
}
#' Organic subsurface salinity component rating (subsurface factors)
#'
#' The organic subsurface salinity component rating returns the component
#' deduction for the subsurface salinity. The maximum depth is considered at
#' 120cm. There are four factors that are recognized in this category, structure
#' (degree of decomposition) (B), depth of deposit and kind of substrate (G),
#' reaction (V) and salinity (N). Depth of deposit and kind of substrate are
#' currently not being used.
#' @param subsurfaceSalinity The subsurface salinity measured in saturated paste (dS/m). Default is at 60cm depth.
#' @return Organic subsurface salinity
#' @export
organicSubsurfaceSalinityComponentRating <- function(subsurfaceSalinity){
# 4. Salinity (N)
if(is.na(subsurfaceSalinity)){
NPercentDeduct <- 0
} else {
if(subsurfaceSalinity < 4){
NPercentDeduct <- 0
} else if(subsurfaceSalinity < 8){
NPercentDeduct <- 10
} else {
NPercentDeduct <- 20
}
}
# 2. Return the percent deduction for basic organic rating (subsurface factors).
# Ensure that the value will not be over 100 or less than 0
tempsum <- sum(NPercentDeduct)
tempsum[tempsum < 0] <- 1
tempsum[tempsum > 100] <- 100
return(100 - tempsum)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.