R/organic_soil_index_add_data.R

Defines functions organicSubsurfaceSalinityComponentRating organicSubsurfacepHComponentRating organicSubsurfaceStructureConsistenceComponentRating organicSurfaceSalinityComponentRating organicSurfacepHComponentRating organicSurfaceBulkDensityComponentRating organicSubsurfaceWaterSupplyingAbilityComponentRating organicSurfaceWaterSupplyingAbilityComponentRating soilClimateComponentRating

Documented in organicSubsurfacepHComponentRating organicSubsurfaceSalinityComponentRating organicSubsurfaceStructureConsistenceComponentRating organicSubsurfaceWaterSupplyingAbilityComponentRating organicSurfaceBulkDensityComponentRating organicSurfacepHComponentRating organicSurfaceSalinityComponentRating organicSurfaceWaterSupplyingAbilityComponentRating soilClimateComponentRating

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

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