From e4d826ad340f042960d44330d40ea6cd0e405585 Mon Sep 17 00:00:00 2001 From: Beaudette Date: Mon, 4 Mar 2024 09:56:42 -0800 Subject: [PATCH] new BBOX --- .../geomorphic-summaries-and-ordering.Rmd | 27 ++-- .../geomorphic-summaries-and-ordering.html | 134 +++++++++--------- 2 files changed, 74 insertions(+), 87 deletions(-) diff --git a/AQP/sharpshootR/geomorphic-summaries-and-ordering.Rmd b/AQP/sharpshootR/geomorphic-summaries-and-ordering.Rmd index fca98d0..d9893c1 100644 --- a/AQP/sharpshootR/geomorphic-summaries-and-ordering.Rmd +++ b/AQP/sharpshootR/geomorphic-summaries-and-ordering.Rmd @@ -34,9 +34,15 @@ library(sf) library(sharpshootR) library(SoilTaxonomy) -# way too many ties in geomcomp + +## possible AOIs defined using a bounding-box via SoilWeb + +# WI: many ties bb <- '-97.0983 39.3808,-97.0983 39.4127,-97.0282 39.4127,-97.0282 39.3808,-97.0983 39.3808' +# KS069 +bb <- '-100.5534 37.9177,-100.5534 37.9822,-100.4389 37.9822,-100.4389 37.9177,-100.5534 37.9177' + ## assemble AOI polygon into WKT @@ -76,19 +82,6 @@ osd <- fetchOSD(unique(s$compname), extended = TRUE) ## check out results str(osd, 1) - - -# the latest soilDB::fetchOSD() will automatically encode horizon distinctness offset -# backwards compatibility -if(is.null(osd$SPC$hzd)) { - - # convert horizon boundary distinctness -> vertical distance - osd$SPC$hzd <- hzDistinctnessCodeToOffset( - osd$SPC$distinctness, - codes = c('very abrupt', 'abrubt', 'clear', 'gradual', 'diffuse') - ) -} - ``` @@ -118,7 +111,7 @@ hist(match.rate, las = 1, xlab = 'Matching Rate') Note that profiles deeper than 180cm are marked as truncated via ragged bottoms. ```{r, fig.width=10, fig.height=8.5} # provide additional arguments to aqp::plotSPC() via options -options(.aqp.plotSPC.args = list(max.depth = 180)) +options(.aqp.plotSPC.args = list(max.depth = 190)) par(mar = c(1, 0, 1, 2)) plotGeomorphCrossSection(osd, type = 'line', maxIter = 100, j.amount = 0.05, verbose = TRUE) @@ -162,9 +155,9 @@ print(res$fig) ``` ```{r, fig.width=10, fig.height=8} -par(mar = c(1, 0, 1, 1)) +par(mar = c(1, 0, 1, 2)) idx <- match(hydOrder(o$geom, g = 'flats', clust = FALSE), profile_id(o$SPC)) -plotSPC(o$SPC, plot.order = idx, width = 0.1, name.style = 'center-center', cex.names = 0.65) +plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65) ``` ```{r, fig.width=10, fig.height=8} diff --git a/AQP/sharpshootR/geomorphic-summaries-and-ordering.html b/AQP/sharpshootR/geomorphic-summaries-and-ordering.html index ae29439..cd32f90 100644 --- a/AQP/sharpshootR/geomorphic-summaries-and-ordering.html +++ b/AQP/sharpshootR/geomorphic-summaries-and-ordering.html @@ -11,7 +11,7 @@ - + Hydrologic Ordering of Geomorphic Proportions @@ -354,7 +354,7 @@

Hydrologic Ordering of Geomorphic Proportions

D.E. Beaudette

-

2023-08-08

+

2024-03-04

@@ -365,9 +365,15 @@

2023-08-08

library(sharpshootR) library(SoilTaxonomy) -# way too many ties in geomcomp + +## possible AOIs defined using a bounding-box via SoilWeb + +# WI: many ties bb <- '-97.0983 39.3808,-97.0983 39.4127,-97.0282 39.4127,-97.0282 39.3808,-97.0983 39.3808' +# KS069 +bb <- '-100.5534 37.9177,-100.5534 37.9822,-100.4389 37.9822,-100.4389 37.9177,-100.5534 37.9177' + ## assemble AOI polygon into WKT @@ -407,34 +413,25 @@

2023-08-08

## check out results str(osd, 1) -
## List of 17
+
## List of 18
 ##  $ SPC             :Formal class 'SoilProfileCollection' [package "aqp"] with 9 slots
-##  $ competing       :'data.frame':    85 obs. of  3 variables:
-##  $ geog_assoc_soils:'data.frame':    78 obs. of  2 variables:
-##  $ geomcomp        :'data.frame':    17 obs. of  9 variables:
-##  $ hillpos         :'data.frame':    17 obs. of  8 variables:
+##  $ competing       :'data.frame':    61 obs. of  3 variables:
+##  $ geog_assoc_soils:'data.frame':    75 obs. of  2 variables:
+##  $ geomcomp        :'data.frame':    12 obs. of  9 variables:
+##  $ hillpos         :'data.frame':    12 obs. of  8 variables:
 ##  $ mtnpos          : logi FALSE
-##  $ terrace         :'data.frame':    10 obs. of  5 variables:
-##  $ flats           :'data.frame':    2 obs. of  7 variables:
-##  $ shape_across    :'data.frame':    19 obs. of  8 variables:
-##  $ shape_down      :'data.frame':    19 obs. of  8 variables:
-##  $ pmkind          :'data.frame':    26 obs. of  5 variables:
-##  $ pmorigin        :'data.frame':    10 obs. of  5 variables:
-##  $ mlra            :'data.frame':    130 obs. of  4 variables:
-##  $ climate.annual  :'data.frame':    152 obs. of  12 variables:
-##  $ climate.monthly :'data.frame':    456 obs. of  14 variables:
-##  $ NCCPI           :'data.frame':    19 obs. of  16 variables:
-##  $ soilweb.metadata:'data.frame':    22 obs. of  2 variables:
-
# the latest soilDB::fetchOSD() will automatically encode horizon distinctness offset
-# backwards compatibility
-if(is.null(osd$SPC$hzd)) {
-  
-  # convert horizon boundary distinctness -> vertical distance
-  osd$SPC$hzd <- hzDistinctnessCodeToOffset(
-    osd$SPC$distinctness, 
-    codes = c('very abrupt', 'abrubt', 'clear', 'gradual', 'diffuse')
-  )
-}
+## $ terrace :'data.frame': 6 obs. of 5 variables: +## $ flats :'data.frame': 7 obs. of 7 variables: +## $ shape_across :'data.frame': 14 obs. of 8 variables: +## $ shape_down :'data.frame': 14 obs. of 8 variables: +## $ pmkind :'data.frame': 31 obs. of 5 variables: +## $ pmorigin :'data.frame': 5 obs. of 5 variables: +## $ mlra :'data.frame': 99 obs. of 4 variables: +## $ ecoclassid :'data.frame': 59 obs. of 5 variables: +## $ climate.annual :'data.frame': 112 obs. of 12 variables: +## $ climate.monthly :'data.frame': 336 obs. of 14 variables: +## $ NCCPI :'data.frame': 14 obs. of 16 variables: +## $ soilweb.metadata:'data.frame': 24 obs. of 2 variables:
# single iteration of hydrologic ordering
 h1 <- hydOrder(osd$shape_across, g = 'shape', clust = TRUE)
 
@@ -444,65 +441,65 @@ 

2023-08-08

# compare h1$match.rate
-
## [1] 0.4210526
+
## [1] 0.7857143
h2$match.rate
-
## [1] 0.3684211
+
## [1] 0.7857143
# inspect objective function evolution
 tr <- h2$trace
 
 obj <- sapply(tr, '[[', 'obj')
 hist(obj, las = 1, xlab = 'Objective Function\nLower is Better')
-

+

match.rate <- sapply(tr, '[[', 'match.rate')
 hist(match.rate, las = 1, xlab = 'Matching Rate')
-

+

Note that profiles deeper than 180cm are marked as truncated via ragged bottoms.

# provide additional arguments to aqp::plotSPC() via options
-options(.aqp.plotSPC.args = list(max.depth = 180))
+options(.aqp.plotSPC.args = list(max.depth = 190))
 
 par(mar = c(1, 0, 1, 2))
 plotGeomorphCrossSection(osd, type = 'line', maxIter = 100, j.amount = 0.05, verbose = TRUE)
-

+

plotGeomorphCrossSection(osd, type = 'bar', maxIter = 100, j.amount = 0.05, verbose = TRUE)
-

+

par(mar = c(1, 0, 1, 2))
 plotGeomorphCrossSection(osd, type = 'line', clust = FALSE)
-

+

plotGeomorphCrossSection(osd, type = 'bar', clust = FALSE)
-

+

o <- reconcileOSDGeomorph(osd, 'hillpos')
 res <- vizHillslopePosition(o$geom, verbose = TRUE)
 print(res$fig)
-

+

par(mar = c(1, 0, 1, 1))
 idx <- match(hydOrder(o$geom, g = 'hillpos', clust = FALSE), profile_id(o$SPC))
 plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65)
-

+

o <- reconcileOSDGeomorph(osd, 'geomcomp')
 res <- vizGeomorphicComponent(o$geom, verbose = TRUE)
 print(res$fig)
-

+

par(mar = c(1, 0, 1, 1))
 idx <- match(hydOrder(o$geom, g = 'geomcomp', clust = FALSE), profile_id(o$SPC))
 plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65)
-

+

o <- reconcileOSDGeomorph(osd, 'flats')
 res <- vizFlatsPosition(o$geom, verbose = TRUE)
 print(res$fig)
-

-
par(mar = c(1, 0, 1, 1))
+

+
par(mar = c(1, 0, 1, 2))
 idx <- match(hydOrder(o$geom, g = 'flats', clust = FALSE), profile_id(o$SPC))
-plotSPC(o$SPC, plot.order = idx, width = 0.1, name.style = 'center-center', cex.names = 0.65)
-

+plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65)
+

o <- reconcileOSDGeomorph(osd, 'terrace')
 res <- vizTerracePosition(o$geom, verbose = TRUE)
 print(res$fig)
-

+

par(mar = c(1, 0, 1, 1))
 idx <- match(hydOrder(o$geom, g = 'terrace', clust = FALSE), profile_id(o$SPC))
 plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65)
-

+

o <- reconcileOSDGeomorph(osd, 'mtnpos')
 res <- vizMountainPosition(o$geom, verbose = TRUE)
 print(res$fig)
@@ -512,19 +509,19 @@

2023-08-08

o <- reconcileOSDGeomorph(osd, 'shape_across')
 res <- vizSurfaceShape(o$geom, title = 'Shape Across', verbose = TRUE)
 print(res$fig)
-

+

par(mar = c(1, 0, 1, 1))
 idx <- match(hydOrder(o$geom, g = 'shape', clust = FALSE), profile_id(o$SPC))
 plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65)
-

+

o <- reconcileOSDGeomorph(osd, 'shape_down')
 res <- vizSurfaceShape(o$geom, title = 'Shape Down', verbose = TRUE)
 print(res$fig)
-

+

par(mar = c(1, 0, 1, 1))
 idx <- match(hydOrder(o$geom, g = 'shape', clust = FALSE), profile_id(o$SPC))
 plotSPC(o$SPC, plot.order = idx, width = 0.35, name.style = 'center-center', cex.names = 0.65)
-

+

Problematic Clustering

# use local data
@@ -731,22 +728,21 @@ 

Problematic Clustering

res <- vizHillslopePosition(o$geom, verbose = TRUE)
 print(res$fig)
-

+

# truncate profiles at 180cm
 options(.aqp.plotSPC.args = list(max.depth = 180))
 
 par(mar = c(1, 0, 1, 2))
 plotGeomorphCrossSection(OSDexamples, type = 'line', maxIter = 100, j.amount = 0.05, verbose = TRUE)
-

+

par(mar = c(1, 0, 1, 2))
 plotGeomorphCrossSection(OSDexamples, type = 'line', clust = FALSE)
-

+

## TODO: ensure geomorph data + type aren't mixed up
 
 hydOrder(osd$hillpos, g = 'hillpos', clust = FALSE)
-
##  [1] "BUTLER"    "DETROIT"   "WYMORE"    "CRETE"     "SOGN"      "PAWNEE"    "LABETTE"   "CLIME"    
-##  [9] "HASTINGS"  "GEARY"     "LANCASTER" "KIPSON"    "BENFIELD"  "MUIR"      "TULLY"     "HOBBS"    
-## [17] "TOBIN"
+
##  [1] "SPEARVILLE"   "HARNEY"       "RICHFIELD"    "ULYSSES"      "MANSKER"      "ULY"         
+##  [7] "COLY"         "PENDEN"       "BUFFALO PARK" "DUROC"        "NESS"         "FETERITA"
hydOrder(osd$hillpos, g = 'hillpos', clust = TRUE)
## $clust
 ## 
@@ -755,31 +751,29 @@ 

Problematic Clustering

## ## Cluster method : NA ## Distance : euclidean -## Number of objects: 17 +## Number of objects: 12 ## ## ## $hyd.order -## [1] "BUTLER" "DETROIT" "WYMORE" "CRETE" "SOGN" "PAWNEE" "LABETTE" "CLIME" -## [9] "HASTINGS" "GEARY" "LANCASTER" "KIPSON" "BENFIELD" "MUIR" "TULLY" "HOBBS" -## [17] "TOBIN" +## [1] "SPEARVILLE" "HARNEY" "RICHFIELD" "ULYSSES" "MANSKER" "ULY" +## [7] "COLY" "PENDEN" "BUFFALO PARK" "DUROC" "NESS" "FETERITA" ## ## $clust.hyd.order -## [1] "CRETE" "SOGN" "LABETTE" "CLIME" "PAWNEE" "GEARY" "HASTINGS" "LANCASTER" -## [9] "KIPSON" "BENFIELD" "BUTLER" "DETROIT" "WYMORE" "MUIR" "TULLY" "HOBBS" -## [17] "TOBIN" +## [1] "ULYSSES" "MANSKER" "ULY" "COLY" "PENDEN" "BUFFALO PARK" +## [7] "SPEARVILLE" "HARNEY" "RICHFIELD" "DUROC" "NESS" "FETERITA" ## ## $match.rate -## [1] 0.2352941 +## [1] 0.25 ## ## $obj -## [1] 640
+## [1] 350
hydOrder(osd$flats, g = 'flats', clust = FALSE)
-
## [1] "HASTINGS" "HOBBS"
+
## [1] "MANSKER"   "ULYSSES"   "RICHFIELD" "FETERITA"  "DUROC"     "LOFTON"    "NESS"

Reset options.

options(.aqp.plotSPC.args = NULL)

-

This document is based on aqp version 2.0, -soilDB version 2.7.8, and sharpshootR version +

This document is based on aqp version 2.0.3, +soilDB version 2.8.1, and sharpshootR version 2.2.