R/mineral_soil_index_add_data.R

Defines functions mineralSoilSubsurfaceSodicityComponentRating mineralSoilSubsurfaceSalinityComponentRating mineralSoilSubsurfacepHComponentRating mineralSoilImpedingLayerComponentRating mineralSoilSubsurfaceStructureAndConsistenceComponentRating mineralSoilSurfaceSodicityComponentRating mineralSoilSurfaceSalinityComponentRating mineralSoilSurfacepHComponentRating mineralSoilTopSoilComponentRating mineralSoilOrganicMatterComponentRating mineralSoilStructureAndConsistenceComponentRating mineralWaterTableDepthComponentRating mineralSubsurfaceSoilMoistureComponentRating mineralSurfaceSoilMoistureComponentRating

Documented in mineralSoilImpedingLayerComponentRating mineralSoilOrganicMatterComponentRating mineralSoilStructureAndConsistenceComponentRating mineralSoilSubsurfacepHComponentRating mineralSoilSubsurfaceSalinityComponentRating mineralSoilSubsurfaceSodicityComponentRating mineralSoilSubsurfaceStructureAndConsistenceComponentRating mineralSoilSurfacepHComponentRating mineralSoilSurfaceSalinityComponentRating mineralSoilSurfaceSodicityComponentRating mineralSoilTopSoilComponentRating mineralSubsurfaceSoilMoistureComponentRating mineralSurfaceSoilMoistureComponentRating mineralWaterTableDepthComponentRating

################ 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)

}
mitmon/SRS documentation built on Jan. 12, 2023, 12:15 a.m.