################ Additional Data Tools ################
#' Mineral Surface Soil Moisture Component Rating Available Water Holding Capacity
#'
#' The mineral surface soil moisture component returns the point deduction for the available water
#' holding capacity "AWHC".
#' @param ppe Precipitation minus potential evapotranspiration
#' @param surfaceSiltPercent Percentage of surface (depths 0-60cm) silt
#' @param surfaceClayPercent Percentage of surface (depths 0-60cm) clay
#' @return Deduction points for the moisture component rating deduction.
#' @export
mineralSurfaceSoilMoistureComponentRating <- function(ppe,surfaceSiltPercent,surfaceClayPercent){
# 1. Available water holding capacity
# 1a. Surface available water holding capacity
if(is.na(surfaceSiltPercent) || is.na(surfaceClayPercent) || is.na(ppe)){
surfaceAWHCDFPointDeduct <- 0
} else {
texture <- soilTexture(surfaceSiltPercent,surfaceClayPercent)
AWHCDF <- surfaceAWHCDF()
bounds <- AWHCDF[1,]
if(texture < bounds[3]){
tempcol <- 2
} else if(texture < bounds[4]){
tempcol <- 3
} else if(texture < bounds[5]){
tempcol <- 4
} else if(texture < bounds[6]){
tempcol <- 5
} else if(texture < bounds[7]){
tempcol <- 6
} else if(texture < bounds[8]){
tempcol <- 7
} else if(texture < bounds[9]){
tempcol <- 8
} else if(texture < bounds[10]){
tempcol <- 9
} else if(texture < bounds[11]){
tempcol <- 10
} else {
tempcol <- 11
}
tempcol <- AWHCDF[,tempcol]
bounds <- AWHCDF[,1]
if(ppe > bounds[2]){
surfaceAWHCDFPointDeduct <- tempcol[1]
} else if(ppe > bounds[3]){
surfaceAWHCDFPointDeduct <- tempcol[2]
} else if(ppe > bounds[4]){
surfaceAWHCDFPointDeduct <- tempcol[3]
} else if(ppe > bounds[5]){
surfaceAWHCDFPointDeduct <- tempcol[4]
} else if(ppe > bounds[6]){
surfaceAWHCDFPointDeduct <- tempcol[5]
} else if(ppe > bounds[7]){
surfaceAWHCDFPointDeduct <- tempcol[6]
} else if(ppe > bounds[8]){
surfaceAWHCDFPointDeduct <- tempcol[7]
} else if(ppe > bounds[9]){
surfaceAWHCDFPointDeduct <- tempcol[8]
} else if(ppe > bounds[10]){
surfaceAWHCDFPointDeduct <- tempcol[9]
} else if(ppe > bounds[11]){
surfaceAWHCDFPointDeduct <- tempcol[10]
} else if(ppe > bounds[12]){
surfaceAWHCDFPointDeduct <- tempcol[11]
} else {
surfaceAWHCDFPointDeduct <- tempcol[12]
}
}
# 2. Return the deduction points for the moisture factor
return(100 - surfaceAWHCDFPointDeduct)
}
#' Mineral Soil Moisture Component Rating Available Water Holding Capacity
#'
#' The mineral soil moisture component returns the point deduction for the available water
#' holding capacity "AWHC".
#' @param surfaceSiltPercent Percentage of surface (depths 0-60cm) silt
#' @param surfaceClayPercent Percentage of surface (depths 0-60cm) clay
#' @param subsurfaceSiltPercent Percentage of subsurface (depths 61-200cm) silt
#' @param subsurfaceClayPercent Percentage of subsurface (depths 61-200cm) clay
#' @return Deduction points for the moisture component rating deduction.
#' @export
mineralSubsurfaceSoilMoistureComponentRating <- function(surfaceSiltPercent,surfaceClayPercent,subsurfaceSiltPercent,subsurfaceClayPercent){
# 1. Available water holding capacity
# 1b. Subsurface available water holding capacity
if(is.na(subsurfaceSiltPercent) || is.na(subsurfaceClayPercent)){
subsurfaceAWHCDFPointDeduct <- 0
} else {
textureminus <- surfaceSiltPercent - surfaceClayPercent
textureSub <- soilTexture(subsurfaceSiltPercent,subsurfaceClayPercent)
AWHCDF <- subsurfaceAWHCDF()
bounds <- AWHCDF[1,]
if(textureminus < bounds[3]){
tempcol <- 2
} else if(textureminus < bounds[4]){
tempcol <- 3
} else if(textureminus < bounds[5]){
tempcol <- 4
} else if(textureminus < bounds[6]){
tempcol <- 5
} else {
tempcol <- 6
}
tempcol <- AWHCDF[,tempcol]
bounds <- AWHCDF[,1]
if(textureSub < bounds[3]){
subsurfaceAWHCDFPointDeduct <- tempcol[2]
} else if(textureSub < bounds[4]){
subsurfaceAWHCDFPointDeduct <- tempcol[3]
} else if(textureSub < bounds[5]){
subsurfaceAWHCDFPointDeduct <- tempcol[4]
} else if(textureSub < bounds[6]){
subsurfaceAWHCDFPointDeduct <- tempcol[5]
} else {
subsurfaceAWHCDFPointDeduct <- tempcol[6]
}
}
# 2. Return the deduction points for the moisture factor
return(100 - subsurfaceAWHCDFPointDeduct)
}
#' Mineral Soil Water Table Depth Component Rating
#'
#' The mineral soil water table depth component returns the point deduction for
#' water table component rating.
#' @param surfaceSiltPercent Percentage of surface (depths 0-60cm) silt
#' @param surfaceClayPercent Percentage of surface (depths 0-60cm) clay
#' @param waterTableDepth Water table depth (in cm)
#' @return Deduction points for the water table depth deduction.
#' @export
mineralWaterTableDepthComponentRating <- function(surfaceSiltPercent,surfaceClayPercent,waterTableDepth){
# 1. Water table adjustments
if(is.na(waterTableDepth) || is.na(surfaceSiltPercent) || is.na(surfaceClayPercent)){
WTAPointDeduct <- 0
} else {
texture <- soilTexture(surfaceSiltPercent,surfaceClayPercent)
WTA <- waterTableAdjustmentDF()
bounds <- WTA[1,]
if(texture < bounds[3]){
tempcol <- 2
} else if(texture < bounds[4]){
tempcol <- 3
} else {
tempcol <- 4
}
tempcol <- WTA[,tempcol]
bounds <- WTA[,1]
if(waterTableDepth < bounds[3]){
WTAPointDeduct <- tempcol[2]
} else if(waterTableDepth < bounds[4]){
WTAPointDeduct <- tempcol[3]
} else if(waterTableDepth < bounds[5]){
WTAPointDeduct <- tempcol[4]
} else if(waterTableDepth < bounds[6]){
WTAPointDeduct <- tempcol[5]
} else if(waterTableDepth < bounds[7]){
WTAPointDeduct <- tempcol[6]
} else {
WTAPointDeduct <- tempcol[7]
}
}
# 2. Return the deduction points for the water table depth
return(100 - WTAPointDeduct)
}
#' Mineral Soil Structure and Consistence Component Rating
#'
#' The Mineral Soil Structure and Consistence Component Rating determines a point
#' deduction for mineral soil structure and consistence.
#' @param surfaceSiltPercent Percentage of surface (depths 0-60cm) silt
#' @param surfaceClayPercent Percentage of surface (depths 0-60cm) clay
#' @param surfaceOC Percentage of surface (depths 0-60cm) organic carbon
#' @return Deduction points for the structure and consistence (D) mineral soil rating.
#' @export
mineralSoilStructureAndConsistenceComponentRating <- function(surfaceSiltPercent,surfaceClayPercent,surfaceOC){
# 1. Structure and consistence (D)
# This will change in future updates
if(is.na(surfaceSiltPercent) || is.na(surfaceClayPercent) || is.na(surfaceOC)){
DPointDeduct <- 0
} else {
if(surfaceOC > 3){
DPointDeduct <- 0
} else {
DPointDeduct <- 1.114*(surfaceOC)^2 - 9.0829*(surfaceOC)+18.733
}
# DPointDeduct <- surfaceOC
# DPointDeduct[surfaceOC > 3] <- 0
# DPointDeduct[surfaceOC <= 3] <- (3 / surfaceOC[surfaceOC < 3]) + ((surfaceSandPercent[surfaceOC<3]) / 3 * surfaceOC[surfaceOC<3]) + surfaceSiltPercent[surfaceOC<3]
#Prevent negative deductions and deductions greater than 10 points.
DPointDeduct[DPointDeduct<0] <- 0
DPointDeduct[DPointDeduct>10] <- 10
}
# 2. Return the deduction points for the interim soil rating (surface factors)
return(100 - DPointDeduct)
}
#' Mineral Soil Organic matter content Component Rating
#'
#' The Mineral Soil Organic matter content Component Rating determines a point
#' deduction for mineral soil Organic matter content.
#' @param surfaceOC Percentage of surface (depths 0-60cm) organic carbon
#' @return Deduction points for organic matter rating.
#' @export
mineralSoilOrganicMatterComponentRating <- function(surfaceOC){
# 2. Organic matter content (F)
if(is.na(surfaceOC)){
FPointDeduct <- 0
} else {
OMDF <- OMDTDF()
bounds <- OMDF[,1]
if(surfaceOC > bounds[1]){
FPointDeduct <- OMDF[1,2]
} else if(surfaceOC > bounds[2]){
FPointDeduct <- OMDF[2,2]
} else if(surfaceOC > bounds[3]){
FPointDeduct <- OMDF[3,2]
} else if(surfaceOC > bounds[4]){
FPointDeduct <- OMDF[4,2]
} else {
FPointDeduct <- OMDF[5,2]
}
}
# 2. Return the organic peaty surface (F)
return(100 - FPointDeduct)
}
#' Mineral Soil Top Soil Component Rating
#'
#' The Mineral Soil Top Soil content Component Rating determines a point
#' deduction for mineral soil Top Soil content.
#' @param depthOfTopSoil Depth of top soil up to a max of 20cm
#' @return Deduction points for Top Soil rating.
#' @export
mineralSoilTopSoilComponentRating <- function(depthOfTopSoil){
# 3. Depth of topsoil (E)
if(is.na(depthOfTopSoil)){
EPointDeduct <- 0
} else {
DTSDF <- depthOfTopSoilDF()
bounds <- DTSDF[,1]
if(depthOfTopSoil > bounds[1]){
EPointDeduct <- DTSDF[1,2]
} else if(depthOfTopSoil > bounds[2]){
EPointDeduct <- DTSDF[2,2]
} else if(depthOfTopSoil > bounds[3]){
EPointDeduct <- DTSDF[3,2]
} else if(depthOfTopSoil > bounds[4]){
EPointDeduct <- DTSDF[4,2]
} else {
EPointDeduct <- DTSDF[5,2]
}
}
# 2. Return the deduction points for the top soil component rating
return(100 - EPointDeduct)
}
#' Mineral Soil surface pH Component Rating
#'
#' The Mineral Soil surface pH content Component Rating determines a point
#' deduction for mineral soil surface pH content.
#' @param surfacepH Surface pH measured in saturated paste (depths 0-60cm)
#' @return Deduction points for interim soil rating.
#' @export
mineralSoilSurfacepHComponentRating <- function(surfacepH){
# 4. Surface reaction (pH) (V)
if(is.na(surfacepH)){
VPointDeduct <- 0
} else {
SRDF <- surfaceReactionDF()
bounds <- SRDF[,1]
if(surfacepH > bounds[1]){
VPointDeduct <- SRDF[1,2]
} else if(surfacepH > bounds[2]){
VPointDeduct <- SRDF[2,2]
} else if(surfacepH > bounds[3]){
VPointDeduct <- SRDF[3,2]
} else if(surfacepH > bounds[4]){
VPointDeduct <- SRDF[4,2]
} else if(surfacepH > bounds[5]){
VPointDeduct <- SRDF[5,2]
} else if(surfacepH > bounds[6]){
VPointDeduct <- SRDF[6,2]
} else if(surfacepH > bounds[7]){
VPointDeduct <- SRDF[7,2]
} else if(surfacepH > bounds[8]){
VPointDeduct <- SRDF[8,2]
} else {
VPointDeduct <- SRDF[9,2]
}
}
# 2. Return the deduction points for the surface pH rating
return(100 - VPointDeduct)
}
#' Mineral Soil surface salinity Component Rating
#'
#' The Mineral Soil surface salinity content Component Rating determines a point
#' deduction for mineral soil surface salinity content.
#' @param surfaceSalinity Surface salinity (depths 0-60cm)
#' @return Deduction points for interim soil rating.
#' @export
mineralSoilSurfaceSalinityComponentRating <- function(surfaceSalinity){
# 5. Surface 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 {
SSDF <- surfaceSalinityDF()
bounds <- SSDF[,1]
if(surfaceSalinity < bounds[1]){
NPointDeduct <- SSDF[1,2]
} else if(surfaceSalinity < bounds[2]){
NPointDeduct <- SSDF[2,2]
} else if(surfaceSalinity < bounds[3]){
NPointDeduct <- SSDF[3,2]
} else {
NPointDeduct <- SSDF[4,2]
}
}
# 2. Return the deduction points for surface salinity
return(100 - NPointDeduct)
}
#' Mineral Soil surface salinity Component Rating
#'
#' The Mineral Soil surface salinity content Component Rating determines a point
#' deduction for mineral soil surface salinity content.
#' @param surfaceSodicity Surface sodicity (depths 0-60cm)
#' @return Deduction points for interim soil rating.
#' @export
mineralSoilSurfaceSodicityComponentRating <- function(surfaceSodicity){
# 6. Surface sodicity (sodium adsorption ratio) (Y)
if(is.na(surfaceSodicity)){
YPointDeduct <- 0
} else {
SSDF <- surfaceSodicityDF()
bounds <- SSDF[,1]
if(surfaceSodicity < bounds[1]){
YPointDeduct <- SSDF[1,3]
} else if(surfaceSodicity < bounds[2]){
YPointDeduct <- SSDF[2,3]
} else if(surfaceSodicity < bounds[3]){
YPointDeduct <- SSDF[3,3]
} else if(surfaceSodicity < bounds[4]){
YPointDeduct <- SSDF[5,3]
} else {
YPointDeduct <- SSDF[6,3]
}
}
# 2. Return the deduction points for the surface sodicity component rating
return(100 - YPointDeduct)
}
#' Mineral Soil subsurface structure and consistence Component Rating
#'
#' The Mineral Soil subsurface structure and consistence content Component Rating determines a point
#' deduction for mineral soil subsurface structure and consistence content.
#' @param subsurfaceSiltPercent Percentage of subsurface (depths 60-200cm) silt
#' @param subsurfaceClayPercent Percentage of subsurface (depths 60-200cm) clay
#' @param subsurfaceBulkDensity Subsurface bulk density
#' @return Percentage deduction for basic soil rating.
#' @export
mineralSoilSubsurfaceStructureAndConsistenceComponentRating <- function(subsurfaceSiltPercent,subsurfaceClayPercent,subsurfaceBulkDensity){
# 1. Structure and consistence (D)
# This will change in future updates
if(is.na(subsurfaceSiltPercent) || is.na(subsurfaceClayPercent) || is.na(subsurfaceBulkDensity)){
DPointDeduct <- 0
} else {
texture <- soilTexture(subsurfaceSiltPercent,subsurfaceClayPercent)
subSCDF <- subsurfaceSCDF()
bounds <- subSCDF[1,]
if(texture < bounds[3]){
tempcol <- 2
} else if(texture < bounds[4]){
tempcol <- 3
} else if(texture < bounds[5]){
tempcol <- 4
} else if(texture < bounds[6]){
tempcol <- 5
} else if(texture < bounds[7]){
tempcol <- 6
} else if(texture < bounds[8]){
tempcol <- 7
} else if(texture < bounds[9]){
tempcol <- 8
} else if(texture < bounds[10]){
tempcol <- 9
} else if(texture < bounds[11]){
tempcol <- 10
} else {
tempcol <- 11
}
tempcol <- subSCDF[,tempcol]
bounds <- subSCDF[,1]
if(subsurfaceBulkDensity < bounds[3]){
DPointDeduct <- tempcol[2]
} else if(subsurfaceBulkDensity < bounds[4]){
DPointDeduct <- tempcol[3]
} else if(subsurfaceBulkDensity < bounds[5]){
DPointDeduct <- tempcol[4]
} else if(subsurfaceBulkDensity < bounds[6]){
DPointDeduct <- tempcol[5]
} else if(subsurfaceBulkDensity < bounds[7]){
DPointDeduct <- tempcol[6]
} else if(subsurfaceBulkDensity < bounds[8]){
DPointDeduct <- tempcol[7]
} else if(subsurfaceBulkDensity < bounds[9]){
DPointDeduct <- tempcol[8]
} else if(subsurfaceBulkDensity < bounds[10]){
DPointDeduct <- tempcol[9]
} else if(subsurfaceBulkDensity < bounds[11]){
DPointDeduct <- tempcol[10]
} else if(subsurfaceBulkDensity < bounds[12]){
DPointDeduct <- tempcol[11]
} else {
DPointDeduct <- tempcol[12]
}
}
# 2. Return the deduction percentage for the subsurface texture and bulk density
return(100 - DPointDeduct)
}
#' Mineral Soil subsurface salinity Component Rating
#'
#' The Mineral Soil subsurface salinity content Component Rating determines a point
#' deduction for mineral soil subsurface salinity content.
#' @param impedingLayerDepth Subsurface impeding layers depth (cm)
#' @param ppe Precipitation minus potential evapotranspiration
#' @return Percentage deduction for basic soil rating.
#' @export
mineralSoilImpedingLayerComponentRating <- function(impedingLayerDepth,ppe){
# 1b. Modifications for impeding subsurface layers
if(is.na(impedingLayerDepth) || is.na(ppe)){
ImpedingPercentDeduct <- 0
} else {
subIDF <- subsurfaceImpedingDF()
bounds <- subSCDF[1,]
if(ppe > bounds[3]){
tempcol <- 2
} else if(ppe > bounds[4]){
tempcol <- 3
} else {
tempcol <- 4
}
tempcol <- subIDF[,tempcol]
bounds <- subIDF[,1]
if(impedingLayerDepth < bounds[3]){
ImpedingPercentDeduct <- tempcol[2]
} else if(impedingLayerDepth < bounds[4]){
ImpedingPercentDeduct <- tempcol[3]
} else if(impedingLayerDepth < bounds[5]){
ImpedingPercentDeduct <- tempcol[4]
} else if(impedingLayerDepth < bounds[6]){
ImpedingPercentDeduct <- tempcol[5]
} else {
ImpedingPercentDeduct <- tempcol[6]
}
}
# 2. Return the deduction percentage for the impeding layer
return(100 - ImpedingPercentDeduct)
}
#' Mineral Soil subsurface reaction Component Rating
#'
#' The Mineral Soil subsurface reaction content Component Rating determines a point
#' deduction for mineral soil subsurface reaction content.
#' @param subsurfacepH Subsurface pH measured in substrate paste (depths 60-200cm)
#' @return Percentage deduction for subsurface reaction.
#' @export
mineralSoilSubsurfacepHComponentRating <- function(subsurfacepH){
# 2. Subsurface reaction (V)
if(is.na(subsurfacepH)){
VPointDeduct <- 0
} else {
if(subsurfacepH > 5.5){
VPointDeduct <- 0
} else if(subsurfacepH > 5){
VPointDeduct <- 2
} else if(subsurfacepH > 4.5){
VPointDeduct <- 5
} else if(subsurfacepH > 4){
VPointDeduct <- 30
} else {
VPointDeduct <- 55
}
}
# 2. Return the deduction point for subsurface pH.
return(100 - VPointDeduct)
}
#' Mineral Soil subsurface salinity Component Rating
#'
#' The Mineral Soil subsurface salinity content Component Rating determines a point
#' deduction for mineral soil subsurface salinity content.
#' @param subsurfaceSalinity Subsurface salinity (depths 60-200cm)
#' @return Percentage deduction for basic soil rating.
#' @export
mineralSoilSubsurfaceSalinityComponentRating <- function(subsurfaceSalinity){
# 3. Subsurface salinity (N)
if(is.na(subsurfaceSalinity)){
NPointDeduct <- 0
} else {
if(subsurfaceSalinity < 4){
NPointDeduct <- 0
} else if(subsurfaceSalinity < 8){
NPointDeduct <- 10
} else if(subsurfaceSalinity < 12){
NPointDeduct <- 20
} else if(subsurfaceSalinity < 16){
NPointDeduct <- 40
} else {
NPointDeduct <- 70
}
}
# 2. Return the deduction points for the subsurface salinity
return(100 - NPointDeduct)
}
#' Mineral Soil subsurface sodicity Component Rating
#'
#' The Mineral Soil subsurface sodicity content Component Rating determines a point
#' deduction for mineral soil subsurface sodicity content.
#' @param subsurfaceSodicity Subsurface sodicity (depths 60-200cm)
#' @return Point deduction for subsurface sodicity.
#' @export
mineralSoilSubsurfaceSodicityComponentRating <- function(subsurfaceSodicity){
# 4. Subsurface sodicity (Y)
if(is.na(subsurfaceSodicity)){
YPointDeduct <- 0
} else {
if(subsurfaceSodicity < 8){
YPointDeduct <- 0
} else if(subsurfaceSodicity < 12){
YPointDeduct <- 10
} else if(subsurfaceSodicity < 16){
YPointDeduct <- 30
} else if(subsurfaceSodicity < 20){
YPointDeduct <- 50
} else {
YPointDeduct <- 80
}
}
# 2. Return the deduction point for subsurface sodicity.
return(100 - YPointDeduct)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.