Nothing
R/particleSizeClasses.R
In aqp: Algorithms for Quantitative Pedology
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param flat logical, use flat coarse fragment classes
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.usda <- function(sub, flat, .upper_limit = 1e5, ...) {
#'
#' if(flat) {
#' # flat, top-level classes
#' .p <- c(
#' clay = 0.002,
#' silt = 0.05,
#' sand = 2,
#' channers = 150,
#' flagstones = 380,
#' stones = 600,
#' boulders = .upper_limit
#' )
#' } else {
#' if(sub) {
#' # non-flat, subdivisions
#' .p <- c(
#' fine_clay = 0.0002,
#' coarse_clay = 0.002,
#' fine_silt = 0.02,
#' coarse_silt = 0.05,
#' very_fine_sand = 0.1,
#' fine_sand = 0.25,
#' medium_sand = 0.5,
#' coarse_sand = 1,
#' very_coarse_sand = 2,
#' fine_gravel = 5,
#' medium_gravel = 20,
#' coarse_gravel = 76,
#' cobbles = 250,
#' stones = 600,
#' boulders = .upper_limit
#' )
#' } else {
#' # non-flat, top-level classes
#' .p <- c(
#' clay = 0.002,
#' silt = 0.05,
#' sand = 2,
#' gravel = 76,
#' cobbles = 250,
#' stones = 600,
#' boulders = .upper_limit
#' )
#' }
#' }
#'
#' return(.p)
#' }
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.international <- function(sub, .upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' clay = 0.002,
#' silt = 0.02,
#' fine_sand = 0.2,
#' coarse_sand = 2,
#' gravel = 20,
#' stones = .upper_limit
#' )
#' } else {
#' .p <- c(
#' clay = 0.002,
#' silt = 0.02,
#' sand = 2,
#' gravel = 20,
#' stones = .upper_limit
#' )
#' }
#'
#' return(.p)
#' }
#'
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.unified <- function(sub, .upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' silt_or_clay = 0.074,
#' fine_sand = 0.42,
#' medium_sand = 2,
#' coarse_sand = 4.8,
#' fine_gravel = 19,
#' coarse_gravel = 76,
#' cobbles = 300,
#' boulders = .upper_limit
#' )
#' } else {
#' .p <- c(
#' silt_or_clay = 0.074,
#' sand = 4.8,
#' gravel = 76,
#' cobbles = 300,
#' boulders = .upper_limit
#' )
#' }
#'
#' return(.p)
#' }
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.aashto <- function(sub, rounded, .upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' clay = 0.005,
#' silt = 0.74,
#' fine_sand = 0.42,
#' coarse_sand = 2,
#' fine_gravel = 9.5,
#' medium_gravel = 25,
#' coarse_gravel = 75,
#' big = .upper_limit
#' )
#' } else {
#' .p <- c(
#' clay = 0.005,
#' silt = 0.74,
#' sand = 2,
#' gravel = 75,
#' big = .upper_limit
#' )
#' }
#'
#' # adjust largest particle size class based on roundness
#' if(rounded) {
#' .bigstuff <- 'broken rock'
#' } else {
#' .bigstuff <- 'boulders'
#' }
#'
#' names(.p)[length(.p)] <- 'bigstuff'
#'
#' return(.p)
#' }
#'
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.mod.wentworth <- function(.upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' clay = 0.004,
#' silt = 0.062,
#' sand = 2,
#' pebbles = 64,
#' cobbles = 256,
#' boulders = .upper_limit
#' )
#' } else {
#' .p <- c(
#' clay = 0.004,
#' silt = 0.062,
#' sand = 2,
#' pebbles = 64,
#' cobbles = 256,
#' boulders = .upper_limit
#' )
#' }
#'
#'
#' return(.p)
#' }
#'
#' particleClasses <- function(sys = c('usda', 'international', 'unified', 'aashto', 'mod.wentworth'), sub = TRUE, flat = FALSE, rounded = FALSE, .upper_limit = 1e5) {
#'
#' # normalize to lower case
#' sys <- tolower(sys)
#'
#' # most frequent option, usually not specified
#' if(missing(sys)) {
#' sys <- 'usda'
#' } else {
#' sys <- match.arg(sys)
#' }
#'
#' .pc <- switch(sys,
#' 'usda' = {
#' .particles.usda(sub = sub, flat = flat, .upper_limit = .upper_limit)
#' },
#' 'international' = {
#' .particles.international(sub = sub, .upper_limit = .upper_limit)
#' },
#' 'unified' = {
#' .particles.unified(sub = sub, .upper_limit = .upper_limit)
#' },
#' 'aashto' = {
#' .particles.aashto(sub = sub, rounded = rounded, .upper_limit = .upper_limit)
#' },
#' 'mod.wentworth' = {
#' .particles.mod.wentworth(sub = sub, .upper_limit = .upper_limit)
#' }
#' )
#'
#' return(.pc)
#'
#' }
#'
#'
#'
#'
#'
#' particleSieve <- function() {
#'
#' }
#'
#'
#'
#'
#'
#'
#' ## TODO:
#' ## * NA handling
#' ## * vectorization
#' ## * distance-based matching -> is this sufficient
#' ## * other systems
#'
#'
#' convertParticleDiameterUnits <- function(x, from, to) {
#'
#' ## enumerate possible from/to conversions
#' .possibilities <- combn(
#' x = c('mm', 'sieve', 'phi'),
#' m = 2
#' )
#'
#' # combine forward and reverse conversions
#' .possibilities <- t(
#' cbind(
#' .possibilities,
#' apply(.possibilities, 2, rev)
#' )
#' )
#'
#' # simplify to data.frame
#' .possibilities <- data.frame(.possibilities)
#' names(.possibilities) <- c('from', 'to')
#'
#' # setup conversion rules
#' .possibilities$rule <- paste(.possibilities$from, .possibilities$to, sep = '-')
#'
#' # select conversion rule
#' .rule <- .possibilities$rule[.possibilities$from == from & .possibilities$to == to]
#'
#'
#' ## US standard sieve sizes
#' # .lut <- read.table(textConnection(readClipboard()))
#' # names(.lut) <- c('mm', 'in', 'no')
#'
#' .us_sieve_size_lut <- structure(
#' list(
#' `mm` = c(11.2, 6.35, 5.6, 4.75, 4, 3.35, 2.8, 2.36,
#' 2, 1.7, 1.4, 1.18, 1, 0.841, 0.71, 0.595, 0.5, 0.4, 0.355, 0.3,
#' 0.25, 0.21, 0.177, 0.149, 0.125, 0.105, 0.088, 0.074, 0.063,
#' 0.053, 0.044, 0.037, 0.025, 0.02),
#' `in` = c(0.438, 0.25, 0.223,
#' 0.187, 0.157, 0.132, 0.11, 0.0937, 0.0787, 0.0661, 0.0555, 0.0469,
#' 0.0394, 0.0331, 0.0278, 0.0232, 0.0197, 0.0165, 0.0139, 0.0117,
#' 0.0098, 0.0083, 0.007, 0.0059, 0.0049, 0.0041, 0.0035, 0.0029,
#' 0.0024, 0.0021, 0.0017, 0.0015, 0.001, 8e-04),
#' `no` = c("7/16",
#' "1/4", "3.5", "4", "5", "6", "7", "8", "10", "12", "14", "16",
#' "18", "20", "25", "30", "35", "40", "45", "50", "60", "70", "80",
#' "100", "120", "140", "170", "200", "230", "270", "325", "400",
#' "500", "632")),
#' class = "data.frame",
#' row.names = c(NA, -34L)
#' )
#'
#' ## phi numbers, used with modified wentworth
#' .phi_lut <- data.frame(
#' phi = c(12:1, 0, -c(1:12)),
#' mm = c(
#' 1 / 2^c(12:1),
#' 2^c(0:12)
#' )
#' )
#'
#'
#'
#' ## process rules
#' if(.rule == 'mm-sieve') {
#' .idx <- which.min(outer(x, .us_sieve_size_lut$mm, FUN = '-')^2)
#' .us_sieve_size_lut$no[.idx]
#'
#' }
#'
#' if(.rule == 'sieve-mm') {
#'
#' }
#'
#' if(.rule == 'mm-phi') {
#'
#' }
#'
#' if(.rule == 'phi-mm') {
#'
#' }
#'
#' if(.rule == 'sieve-phi') {
#'
#' }
#'
#' if(.rule == 'phi-sieve') {
#'
#' }
#'
#'
#' return(.res)
#'
#' }
#'
#'
#'
#'
Try the aqp package in your browser
Any scripts or data that you put into this service are public.
aqp documentation built on Jan. 17, 2026, 9:07 a.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.
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param flat logical, use flat coarse fragment classes
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.usda <- function(sub, flat, .upper_limit = 1e5, ...) {
#'
#' if(flat) {
#' # flat, top-level classes
#' .p <- c(
#' clay = 0.002,
#' silt = 0.05,
#' sand = 2,
#' channers = 150,
#' flagstones = 380,
#' stones = 600,
#' boulders = .upper_limit
#' )
#' } else {
#' if(sub) {
#' # non-flat, subdivisions
#' .p <- c(
#' fine_clay = 0.0002,
#' coarse_clay = 0.002,
#' fine_silt = 0.02,
#' coarse_silt = 0.05,
#' very_fine_sand = 0.1,
#' fine_sand = 0.25,
#' medium_sand = 0.5,
#' coarse_sand = 1,
#' very_coarse_sand = 2,
#' fine_gravel = 5,
#' medium_gravel = 20,
#' coarse_gravel = 76,
#' cobbles = 250,
#' stones = 600,
#' boulders = .upper_limit
#' )
#' } else {
#' # non-flat, top-level classes
#' .p <- c(
#' clay = 0.002,
#' silt = 0.05,
#' sand = 2,
#' gravel = 76,
#' cobbles = 250,
#' stones = 600,
#' boulders = .upper_limit
#' )
#' }
#' }
#'
#' return(.p)
#' }
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.international <- function(sub, .upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' clay = 0.002,
#' silt = 0.02,
#' fine_sand = 0.2,
#' coarse_sand = 2,
#' gravel = 20,
#' stones = .upper_limit
#' )
#' } else {
#' .p <- c(
#' clay = 0.002,
#' silt = 0.02,
#' sand = 2,
#' gravel = 20,
#' stones = .upper_limit
#' )
#' }
#'
#' return(.p)
#' }
#'
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.unified <- function(sub, .upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' silt_or_clay = 0.074,
#' fine_sand = 0.42,
#' medium_sand = 2,
#' coarse_sand = 4.8,
#' fine_gravel = 19,
#' coarse_gravel = 76,
#' cobbles = 300,
#' boulders = .upper_limit
#' )
#' } else {
#' .p <- c(
#' silt_or_clay = 0.074,
#' sand = 4.8,
#' gravel = 76,
#' cobbles = 300,
#' boulders = .upper_limit
#' )
#' }
#'
#' return(.p)
#' }
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.aashto <- function(sub, rounded, .upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' clay = 0.005,
#' silt = 0.74,
#' fine_sand = 0.42,
#' coarse_sand = 2,
#' fine_gravel = 9.5,
#' medium_gravel = 25,
#' coarse_gravel = 75,
#' big = .upper_limit
#' )
#' } else {
#' .p <- c(
#' clay = 0.005,
#' silt = 0.74,
#' sand = 2,
#' gravel = 75,
#' big = .upper_limit
#' )
#' }
#'
#' # adjust largest particle size class based on roundness
#' if(rounded) {
#' .bigstuff <- 'broken rock'
#' } else {
#' .bigstuff <- 'boulders'
#' }
#'
#' names(.p)[length(.p)] <- 'bigstuff'
#'
#' return(.p)
#' }
#'
#'
#'
#'
#' #' @param sub logical, return class subdivisions
#' #' @param .upper_limit numeric, upper limit for particle size
#' #' @return vector of particle classes and associated diameters in mm
#' .particles.mod.wentworth <- function(.upper_limit = 1e5, ...) {
#'
#' if(sub) {
#' .p <- c(
#' clay = 0.004,
#' silt = 0.062,
#' sand = 2,
#' pebbles = 64,
#' cobbles = 256,
#' boulders = .upper_limit
#' )
#' } else {
#' .p <- c(
#' clay = 0.004,
#' silt = 0.062,
#' sand = 2,
#' pebbles = 64,
#' cobbles = 256,
#' boulders = .upper_limit
#' )
#' }
#'
#'
#' return(.p)
#' }
#'
#' particleClasses <- function(sys = c('usda', 'international', 'unified', 'aashto', 'mod.wentworth'), sub = TRUE, flat = FALSE, rounded = FALSE, .upper_limit = 1e5) {
#'
#' # normalize to lower case
#' sys <- tolower(sys)
#'
#' # most frequent option, usually not specified
#' if(missing(sys)) {
#' sys <- 'usda'
#' } else {
#' sys <- match.arg(sys)
#' }
#'
#' .pc <- switch(sys,
#' 'usda' = {
#' .particles.usda(sub = sub, flat = flat, .upper_limit = .upper_limit)
#' },
#' 'international' = {
#' .particles.international(sub = sub, .upper_limit = .upper_limit)
#' },
#' 'unified' = {
#' .particles.unified(sub = sub, .upper_limit = .upper_limit)
#' },
#' 'aashto' = {
#' .particles.aashto(sub = sub, rounded = rounded, .upper_limit = .upper_limit)
#' },
#' 'mod.wentworth' = {
#' .particles.mod.wentworth(sub = sub, .upper_limit = .upper_limit)
#' }
#' )
#'
#' return(.pc)
#'
#' }
#'
#'
#'
#'
#'
#' particleSieve <- function() {
#'
#' }
#'
#'
#'
#'
#'
#'
#' ## TODO:
#' ## * NA handling
#' ## * vectorization
#' ## * distance-based matching -> is this sufficient
#' ## * other systems
#'
#'
#' convertParticleDiameterUnits <- function(x, from, to) {
#'
#' ## enumerate possible from/to conversions
#' .possibilities <- combn(
#' x = c('mm', 'sieve', 'phi'),
#' m = 2
#' )
#'
#' # combine forward and reverse conversions
#' .possibilities <- t(
#' cbind(
#' .possibilities,
#' apply(.possibilities, 2, rev)
#' )
#' )
#'
#' # simplify to data.frame
#' .possibilities <- data.frame(.possibilities)
#' names(.possibilities) <- c('from', 'to')
#'
#' # setup conversion rules
#' .possibilities$rule <- paste(.possibilities$from, .possibilities$to, sep = '-')
#'
#' # select conversion rule
#' .rule <- .possibilities$rule[.possibilities$from == from & .possibilities$to == to]
#'
#'
#' ## US standard sieve sizes
#' # .lut <- read.table(textConnection(readClipboard()))
#' # names(.lut) <- c('mm', 'in', 'no')
#'
#' .us_sieve_size_lut <- structure(
#' list(
#' `mm` = c(11.2, 6.35, 5.6, 4.75, 4, 3.35, 2.8, 2.36,
#' 2, 1.7, 1.4, 1.18, 1, 0.841, 0.71, 0.595, 0.5, 0.4, 0.355, 0.3,
#' 0.25, 0.21, 0.177, 0.149, 0.125, 0.105, 0.088, 0.074, 0.063,
#' 0.053, 0.044, 0.037, 0.025, 0.02),
#' `in` = c(0.438, 0.25, 0.223,
#' 0.187, 0.157, 0.132, 0.11, 0.0937, 0.0787, 0.0661, 0.0555, 0.0469,
#' 0.0394, 0.0331, 0.0278, 0.0232, 0.0197, 0.0165, 0.0139, 0.0117,
#' 0.0098, 0.0083, 0.007, 0.0059, 0.0049, 0.0041, 0.0035, 0.0029,
#' 0.0024, 0.0021, 0.0017, 0.0015, 0.001, 8e-04),
#' `no` = c("7/16",
#' "1/4", "3.5", "4", "5", "6", "7", "8", "10", "12", "14", "16",
#' "18", "20", "25", "30", "35", "40", "45", "50", "60", "70", "80",
#' "100", "120", "140", "170", "200", "230", "270", "325", "400",
#' "500", "632")),
#' class = "data.frame",
#' row.names = c(NA, -34L)
#' )
#'
#' ## phi numbers, used with modified wentworth
#' .phi_lut <- data.frame(
#' phi = c(12:1, 0, -c(1:12)),
#' mm = c(
#' 1 / 2^c(12:1),
#' 2^c(0:12)
#' )
#' )
#'
#'
#'
#' ## process rules
#' if(.rule == 'mm-sieve') {
#' .idx <- which.min(outer(x, .us_sieve_size_lut$mm, FUN = '-')^2)
#' .us_sieve_size_lut$no[.idx]
#'
#' }
#'
#' if(.rule == 'sieve-mm') {
#'
#' }
#'
#' if(.rule == 'mm-phi') {
#'
#' }
#'
#' if(.rule == 'phi-mm') {
#'
#' }
#'
#' if(.rule == 'sieve-phi') {
#'
#' }
#'
#' if(.rule == 'phi-sieve') {
#'
#' }
#'
#'
#' return(.res)
#'
#' }
#'
#'
#'
#'
Try the aqp 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.