From 263e8a651211eeeee1cd7c7ab80bb3866d0bbeaf Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Thu, 14 Nov 2024 16:57:29 -0800 Subject: [PATCH] dmu-summary v0.4 - implement parameter for custom cache files - other minor adjustments - update README/NASIS instructions --- inst/reports/region2/dmu-summary/README.md | 18 +-- inst/reports/region2/dmu-summary/cache-data.R | 2 +- inst/reports/region2/dmu-summary/config.R | 9 +- inst/reports/region2/dmu-summary/custom.R | 8 +- inst/reports/region2/dmu-summary/report.Rmd | 153 ++++++++---------- inst/reports/region2/dmu-summary/setup.R | 2 +- 6 files changed, 88 insertions(+), 104 deletions(-) diff --git a/inst/reports/region2/dmu-summary/README.md b/inst/reports/region2/dmu-summary/README.md index aab7c5b..d8569b5 100644 --- a/inst/reports/region2/dmu-summary/README.md +++ b/inst/reports/region2/dmu-summary/README.md @@ -1,16 +1,9 @@ # DMU Summary Report -PENDING -## Typical Usage -This report requires setting up a selected set in your local NASIS database: - - * load legend by area symbol - * load related MU (approved / provisional only) - * load related DMU (rep DMU only) - * load related component pedons - * load related site observation +## Usage Run the following commands to setup the report template. + ```r # load this library library(soilReports) @@ -22,9 +15,10 @@ reportSetup(reportName='region2/dmu-summary') reportInit(reportName='region2/dmu-summary', outputDir='dmu-summary') ``` -TODO: Setup `cached.rds`. +This report requires loading several related objects into your NASIS Selected Set, including Area, Legend Mapunit, Correlation, Component Pedon, Pedon and Site Observation. -TODO: specification of map unit symbol via `params` +A useful NASIS query that gets all of the necessary objects is **_NSSC Pangaea_: _Area/Legend/Mapunit/DMU/Pedon/Site by areasymbol_**. -Open `report.Rmd` and then click "knit". + - This query has detailed instructions for loading necessary data, and includes only representative data map units. Several other variants of this same query can be used to obtain data based on component or pedon information rather than area symbol. +Open `report.Rmd`, review the "params" section of the YAML header to select target mapunit and cache file name, then click "knit". You can cache the data for many map units (e.g. a whole soil survey area) once, then re-run the report several times with different `musym` values. To force new data to be loaded from the database, delete the .rda file specified in `cache_file` in the document directory. diff --git a/inst/reports/region2/dmu-summary/cache-data.R b/inst/reports/region2/dmu-summary/cache-data.R index 748dd3f..a076b57 100644 --- a/inst/reports/region2/dmu-summary/cache-data.R +++ b/inst/reports/region2/dmu-summary/cache-data.R @@ -80,6 +80,6 @@ cm <- cm[, c('.label', 'comppct_r', cm.names)] # TODO: re-level component names based on mean comppct ## save -save(co, cm, p, cp, osds, cotx, geom, pm, file = 'data.rda') +save(co, cm, p, cp, osds, cotx, geom, pm, file = params$cache_file) diff --git a/inst/reports/region2/dmu-summary/config.R b/inst/reports/region2/dmu-summary/config.R index 8ae5807..9dd3d53 100644 --- a/inst/reports/region2/dmu-summary/config.R +++ b/inst/reports/region2/dmu-summary/config.R @@ -15,12 +15,17 @@ .label = 'CA792', variable = factor( c('elev', 'ffd', 'maat', 'map', 'slope'), - labels = c('Elevation (m)', 'Frost-Free Days', 'MAAT (deg C)', 'MAP (mm)', 'Slope (%)') + labels = c( + 'Elevation (m)', + 'Frost-Free Days', + 'MAAT (deg C)', + 'MAP (mm)', + 'Slope (%)' + ) ), rv = c(3005, 83, 3.28, 984, 43), low = c(1469, 40, -1.02, 583, 8), high = c(3728, 193, 12.01, 1381, 99) - ) diff --git a/inst/reports/region2/dmu-summary/custom.R b/inst/reports/region2/dmu-summary/custom.R index 9a4d436..11136a6 100644 --- a/inst/reports/region2/dmu-summary/custom.R +++ b/inst/reports/region2/dmu-summary/custom.R @@ -16,23 +16,23 @@ #' #' # simplest case, use a SPC #' data("jacobs2000") -#' emtpySPC(jacobs2000) +#' emptySPC(jacobs2000) #' #' # convert to SPC with data.table internals #' x <- jacobs2000 #' aqp_df_class(x) <- 'data.table' #' x <- rebuildSPC(x) #' -#' emtpySPC(x) +#' emptySPC(x) #' #' # convert to SPC with tibble internals #' x <- jacobs2000 #' aqp_df_class(x) <- 'tibble' #' x <- rebuildSPC(x) #' -#' emtpySPC(x) +#' emptySPC(x) #' -emtpySPC <- function(x, fakeID = 'MISSING', top = 0, bottom = max(x)) { +emptySPC <- function(x, fakeID = 'MISSING', top = 0, bottom = max(x)) { # use the first profile / horizon # as template diff --git a/inst/reports/region2/dmu-summary/report.Rmd b/inst/reports/region2/dmu-summary/report.Rmd index d1871d0..43b3f1d 100644 --- a/inst/reports/region2/dmu-summary/report.Rmd +++ b/inst/reports/region2/dmu-summary/report.Rmd @@ -6,31 +6,37 @@ output: smart: no keep_md: no params: - musym: '3110' + musym: '3145' + cache_file: 'CA792.rda' --- - -```{r, echo=FALSE, results='hide', warning=FALSE, message=FALSE} - .report.name <- 'DMU-summary' - .report.version <- '0.3' - .report.description <- 'DMU Summary Report' -``` - ```{r echo=FALSE, results='hide', warning=FALSE, message=FALSE} -library(knitr, quietly=TRUE) +## debugging +# params <- list(musym = '3145', +# cache_file = 'CA792.rda') # chunk options -opts_chunk$set(message=FALSE, warning=FALSE, background='#F7F7F7', fig.align='center', fig.retina=2, dev='png', tidy=FALSE, verbose=FALSE, progress=FALSE, echo = FALSE) - +knitr::opts_chunk$set( + message = FALSE, + warning = FALSE, + background = '#F7F7F7', + fig.align = 'center', + fig.retina = 2, + dev = 'png', + tidy = FALSE, + verbose = FALSE, + progress = FALSE, + echo = FALSE +) -library(aqp, quietly=TRUE) -library(soilDB, quietly=TRUE) -library(sharpshootR, quietly=TRUE) -library(latticeExtra, quietly=TRUE) -library(reshape2, quietly=TRUE) -library(tactile, quietly=TRUE) -library(ggplot2, quietly=TRUE) -library(cluster, quietly=TRUE) +library(aqp, quietly = TRUE) +library(soilDB, quietly = TRUE) +library(sharpshootR, quietly = TRUE) +library(latticeExtra, quietly = TRUE) +library(reshape2, quietly = TRUE) +library(tactile, quietly = TRUE) +library(ggplot2, quietly = TRUE) +library(cluster, quietly = TRUE) # local functions source('custom.R') @@ -38,16 +44,13 @@ source('custom.R') # local configuration source('config.R') - ## re-make cached data -# source('cache-data.R') - - -# load cached data -load('data.rda') - -## debugging -# params <- list(musym = '3145') +if (is.null(params$cache_file) || !file.exists(params$cache_file)) { + source('cache-data.R') +} else { + # load cached data + load(params$cache_file) +} ## subset pieces @@ -57,7 +60,6 @@ co <- subset(co, musym == params$musym) # component month (DF) cm <- subset(cm, subset = coiid %in% profile_id(co)) - # component pedon linkage (DF) cp <- subset(cp, subset = coiid %in% profile_id(co)) @@ -76,29 +78,24 @@ geom <- subset(geom, subset = coiid %in% profile_id(co)) pm <- subset(pm, subset = coiid %in% profile_id(co)) - ## re-level component labels co$.label <- factor( co$.label, levels = co$.label[order(co$comppct_r, decreasing = TRUE)] ) - ## add component pedon / component data to pedons ## TODO: check to make sure that there is only a single case of each pedon any(table(cp$peiid) > 1) - # merge subset component pedons into SPC site(p) <- cp[, c('peiid', 'coiid', 'representative')] - # look-up associated component label site(p)$.comp_label <- co$.label[match(p$coiid, site(co)$coiid)] ## TODO: sort component names / labels by decreasing component percent - # pedon convenience label p$.pedon_label <- p$taxonname @@ -129,9 +126,6 @@ do.comp.comparison <- length(co) > 1 ``` - - -
@@ -143,16 +137,12 @@ report version `r .report.version` `r format(Sys.time(), "%Y-%m-%d %H:%M")`
-
-This report requires setting up a selected set in your local NASIS database: +This report requires loading several related objects into your NASIS Selected Set, including Area, Legend Mapunit, Correlation, Component Pedon, Pedon and Site Observation. - * load legend by area symbol - * load related MU (approved / provisional only) - * load related DMU (rep DMU only) - * load related component pedons - * load related site observation +A useful NASIS query that gets all of the necessary objects is **_NSSC Pangaea_: _Area/Legend/Mapunit/DMU/Pedon/Site by areasymbol_**. +This query has detailed instructions for loading necessary data, and includes only representative data map units. Several other variants of this same query can be used to obtain data based on component or pedon information rather than area symbol. ## Components ```{r echo = FALSE} @@ -164,7 +154,6 @@ kableExtra::kable_styling( ) ``` - ### Component Parent Material | Landform ```{r echo = FALSE} pm.summary <- site(co)[, c('.label', 'landform_string', 'pmkind', 'pmorigin')] @@ -175,7 +164,6 @@ kableExtra::kable_styling( ) ``` - ### Component Text Notes ```{r echo = FALSE} txt <- cotx[which(cotx$textcat == 'GENSOIL'), ] @@ -191,7 +179,7 @@ txt <- merge( txt <- txt[order(txt$comppct_r, decreasing = TRUE), ] kableExtra::kable_styling( - kable(txt[, c('.label', 'textentry')], row.names = FALSE, format = 'html'), full_width = FALSE, font_size = 11 + knitr::kable(txt[, c('.label', 'textentry')], row.names = FALSE, format = 'html'), full_width = FALSE, font_size = 11 ) ``` @@ -217,7 +205,6 @@ txt <- txt[order(txt$comppct_r, decreasing = TRUE), ] # txt.table <- read.table(textConnection(object = txt$textentry[1]), skip = 3) # names(txt.table) <- nm - for(i in 1:nrow(txt)) { cat('
')
   cat(txt$.label[i])
@@ -228,14 +215,10 @@ for(i in 1:nrow(txt)) {
 
 ```
 
-
-
 
 
 ```{r echo=FALSE, results='hide', fig.width=12, fig.height=6.5, eval=do.osd.dend}
-try(
-  print(vizAnnualClimate(osds.ac)$fig)
-  )
+try(print(vizAnnualClimate(osds.ac)$fig))
 ```
 
 ### Component Climate
@@ -293,8 +276,6 @@ segplot(
   )
 ```
 
-
-
 ### Component | OSD Taxonomic Comparison
 ```{r echo=FALSE, results='hide', fig.width=osd.fig.width, fig.height=6, eval=do.osd.dend}
 # combine OSDs + comp
@@ -318,8 +299,6 @@ try(
 # SoilTaxonomyDendrogram(osds, cex.taxon.labels = 0.8, width = 0.25, name.style = 'center-center', hz.depths = TRUE, plot.depth.axis = FALSE)
 ```
 
-
-
 ### Component Diagnostic Features
 ```{r echo = FALSE, fig.width=8, fig.height=6}
 d.wide <- soilDB:::.diagHzLongtoWide(diagnostic_hz(co), feature = 'featkind', id = 'coiid')
@@ -333,23 +312,24 @@ try(
 )
 ```
 
-
 ### Component Comparison
 ```{r echo = FALSE, fig.width=8, fig.height=6, eval = do.comp.comparison}
-suppressMessages(
-  d <- profile_compare(
-    co, 
-    vars = c('sandtotal_r', 'claytotal_r', 'fragvoltot_r', 'ph1to1h2o_r', 'om_r'),
-    max_d = max(co, v = 'claytotal_r'),
-    k = 0,
-    rescale.result = TRUE
+try({
+  suppressMessages(
+    d <- NCSP(
+      co, 
+      vars = c('sandtotal_r', 'claytotal_r', 'fragvoltot_r', 'ph1to1h2o_r', 'om_r'),
+      # max_d = max(co, v = 'claytotal_r'),
+      k = 0,
+      # rescale.result = TRUE
+    )
   )
-)
-
-h <- as.hclust(diana(d))
-
-par(mar = c(0, 0, 0, 0))
-plotProfileDendrogram(co, clust = h, width = 0.25, name.style = 'center-center', hz.depths = TRUE, plot.depth.axis = FALSE, label = '.label', y.offset = 0.15, scaling.factor = 0.007, color = 'claytotal_r')
+  
+  h <- as.hclust(diana(d))
+  
+  par(mar = c(0, 0, 0, 0))
+  plotProfileDendrogram(co, clust = h, width = 0.25, name.style = 'center-center', hz.depths = TRUE, plot.depth.axis = FALSE, label = '.label', y.offset = 0.15, scaling.factor = 0.007, color = 'claytotal_r')
+})
 ```
 
 
@@ -357,16 +337,26 @@ plotProfileDendrogram(co, clust = h, width = 0.25, name.style = 'center-center',
 textureTriangleSummary(data.frame(SAND=co$sandtotal_r, SILT=co$silttotal_r, CLAY = co$claytotal_r))
 ```
 
-
 ### Component Pedons
 ```{r echo = FALSE, fig.width = copedon.profile.fig.width, fig.height = 6.5}
-par(mar = c(0, 0, 1, 0))
-# component convenience labels
-groupedProfilePlot(p, groups = '.comp_label', label = '.pedon_label', group.name.offset = c(-15, -5), id.style = 'side', group.name.cex = 0.75, name.style = 'center-center', hz.depths = TRUE, plot.depth.axis = FALSE, cex.names = 0.66)
+try({
+  par(mar = c(0, 0, 1, 0))
+  # component convenience labels
+  groupedProfilePlot(
+    p,
+    groups = '.comp_label',
+    label = '.pedon_label',
+    group.name.offset = c(-15, -5),
+    id.style = 'side',
+    group.name.cex = 0.75,
+    name.style = 'center-center',
+    hz.depths = TRUE,
+    plot.depth.axis = FALSE,
+    cex.names = 0.66
+  )
+})
 ```
 
-
-
 ### Component RV Evaluation
 ```{r echo = FALSE, fig.width=comp.profile.fig.width, fig.height=6.5}
 par(mar=c(0.25, 0.5, 4, 0))
@@ -386,7 +376,6 @@ plotSPC(co, label='.label', group.name.cex = 0.75, color='ecec_r', col.label='EC
 plotSPC(co, label='.label', group.name.cex = 0.75, color='sumbases_r', col.label='Sum of Bases (cmol[+] / kg)', col.legend.cex=0.75, name.style = 'center-center', hz.depths = TRUE, plot.depth.axis = FALSE, cex.names = 0.66, width = 0.25)
 ```
 
-
 ### Component Low/RV/High Evaluation
 ```{r echo = FALSE, fig.width = 10, fig.height = 6.5}
 # iterate over component IDs
@@ -407,14 +396,14 @@ for(comp in co.ids){
   # there may not be an OSD yet
   if(length(osds.sub) == 0) {
     # use filler based on deepest component subset
-    osds.sub <- emtpySPC(co.sub[1, ], top = 0, bottom = max(co.sub)) 
+    osds.sub <- emptySPC(co.sub[1, ], top = 0, bottom = max(co.sub)) 
 
   }
   
   # there may be no component pedons
   if(length(p.sub) == 0) {
     # use filler based on deepest component subset
-    p.sub <- emtpySPC(co.sub[1, ], top = 0, bottom = max(co.sub)) 
+    p.sub <- emptySPC(co.sub[1, ], top = 0, bottom = max(co.sub)) 
   }
 
 
@@ -439,10 +428,6 @@ thematicSketches(v.co = 'ph1to1h2o', v.p = 'phfield', fig.title = 'pH 1:1 H2O',
 
 ```
 
-
-
-
-
 ### Component Month
 ```{r echo=FALSE, results='hide', fig.width=9, fig.height=4.5}
 ggplot(cm, aes(month, .label, flodfreqcl)) + geom_tile(aes(fill = flodfreqcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Flooding Frequency') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('') + theme(legend.position="bottom") + guides(fill=guide_legend(nrow=2,byrow=TRUE))
diff --git a/inst/reports/region2/dmu-summary/setup.R b/inst/reports/region2/dmu-summary/setup.R
index eb1c023..72965a1 100644
--- a/inst/reports/region2/dmu-summary/setup.R
+++ b/inst/reports/region2/dmu-summary/setup.R
@@ -13,7 +13,7 @@
 .report.name <- 'DMU-summary'
 
 # version of report
-.report.version <- '0.3'
+.report.version <- '0.4'
 
 # brief description for `soilReports::listReports()`
 .report.description <- 'DMU Summary Report'