From 5da384e55ce3beda487de05e1af9f00ab02816ce Mon Sep 17 00:00:00 2001 From: Beaudette Date: Thu, 2 May 2024 11:55:35 -0700 Subject: [PATCH] updates --- AQP/sharpshootR/CA-snow-survey.Rmd | 2 +- AQP/sharpshootR/CA-snow-survey.html | 26 ++++++------- AQP/soilDB/WCS-demonstration-01.Rmd | 48 ++++++++++++------------ AQP/soilDB/WCS-demonstration-01.html | 55 +++++++++++++++++----------- 4 files changed, 70 insertions(+), 61 deletions(-) diff --git a/AQP/sharpshootR/CA-snow-survey.Rmd b/AQP/sharpshootR/CA-snow-survey.Rmd index f6ddf6e..3092693 100644 --- a/AQP/sharpshootR/CA-snow-survey.Rmd +++ b/AQP/sharpshootR/CA-snow-survey.Rmd @@ -96,7 +96,7 @@ library(purrr) # current data are: yr <- 2024 -mo <- 'April' +mo <- 'May' # Stanislaus River watershed course.data <- data.frame(course_number=c(129, 323, 131, 132, 134, 345, 344, 138, 139, 384, 140, 142, 143, 145, 152)) diff --git a/AQP/sharpshootR/CA-snow-survey.html b/AQP/sharpshootR/CA-snow-survey.html index 6531044..6aa63d6 100644 --- a/AQP/sharpshootR/CA-snow-survey.html +++ b/AQP/sharpshootR/CA-snow-survey.html @@ -11,7 +11,7 @@ - + California Cooperative Snow Survey Summary @@ -353,7 +353,7 @@

California Cooperative Snow Survey Summary

D.E. Beaudette

-

2024-04-03

+

2024-05-01

@@ -437,7 +437,7 @@

Data and Summary for the Stanislaus

# current data are: yr <- 2024 -mo <- 'April' +mo <- 'May' # Stanislaus River watershed course.data <- data.frame(course_number=c(129, 323, 131, 132, 134, 345, 344, 138, 139, 384, 140, 142, 143, 145, 152)) @@ -520,7 +520,7 @@

Data and Summary for the Stanislaus

trellis.par.set(tps) print(p3, more=TRUE, position=c(0,0.08,1,1)) print(p4, more=FALSE, position=c(0.125,0,0.425,0.175)) -

+

Analysis of the Entire Record, all Courses

@@ -558,22 +558,22 @@

Analysis of the Entire Record, all Courses

scaled.data$month <- factor(scaled.data$month)
# plot all data, each line is a course
 xyplot(SWE ~ year | month, data=scaled.data, groups=name, col=rgb(0.1, 0.1, 0.1, alpha=0.25), type=c('l','g'), span=0.125, as.table=TRUE, scales=list(alternating=3, x=list(tick.number=10, rot=90)))
-

+

# plot all data: each dot is a survey
 xyplot(SWE ~ year | month, data=scaled.data, type=c('p','g', 'smooth'), span=0.125, as.table=TRUE, scales=list(alternating=3, x=list(tick.number=10, rot=90)), cex=0.25, pch=16, lwd=2)
-

+

xyplot(scaled.SWE ~ year | month, data=scaled.data, type=c('p','g', 'smooth'), span=0.125, as.table=TRUE, scales=list(alternating=3, x=list(tick.number=10, rot=90)), cex=0.25, pch=16, lwd=2)
-

+

xyplot(emp.pctile ~ year | month, data=scaled.data, type=c('p','g', 'smooth'), span=0.125, as.table=TRUE, scales=list(alternating=3, x=list(tick.number=10, rot=90)), cex=0.25, pch=16, lwd=2)
-

+

xyplot(emp.pctile ~ year | month, data=scaled.data, type=c('p','g', 'smooth'), span=0.25, as.table=TRUE, scales=list(alternating=3, x=list(tick.number=10, rot=90)), cex=0.25, pch=16, lwd=2, subset=year > 1970)
-

+

tps <- tactile.theme(box.dot=list(col='black', pch='|'), box.rectangle=list(col='black'), box.umbrella=list(col='black', lty=1), plot.symbol=list(col='black', cex=0.33), strip.background=list(col=grey(0.85)))
 
 bwplot(emp.pctile ~ factor(year) | month, data=scaled.data, as.table=TRUE, par.settings=tps, scales=list(alternating=3, x=list(tick.number=10, rot=90)), subset=year > 1970 & month == mo, stats=custom.bwplot, panel=function(...) {panel.grid(-1, -1); panel.bwplot(...)})
-

+

bwplot(spi ~ factor(year) | month, data=scaled.data, as.table=TRUE, par.settings=tps, scales=list(alternating=3, x=list(tick.number=10, rot=90)), subset=year > 1970 & month == mo, stats=custom.bwplot, panel=function(...) {panel.grid(-1, -1); panel.bwplot(...)})
-

+

por <- sprintf('Period of Record: 1939-%s', yr)
 
 bwplot(emp.pctile ~ factor(year), data=scaled.data, main=sprintf('%s Snow Survey', mo), sub = por, ylim=c(-0.05, 1.1), ylab='Empirical Percentiles of SWE', par.settings=tps, scales=list(alternating=3, y=list(tick.number=10)), subset=year > 1997 & month == mo, panel=function(x=x, y=y, ...) {
@@ -584,9 +584,9 @@ 

Analysis of the Entire Record, all Courses

panel.text(x=1:length(n.stations), y=1.03, labels=n.stations, cex=0.65, font=2) panel.text(x=10, y=1.075, labels='Snow Courses Reporting', cex=0.85, font=3) })
-

+


-

This document is based on sharpshootR version 2.2.

+

This document is based on sharpshootR version 2.3.

diff --git a/AQP/soilDB/WCS-demonstration-01.Rmd b/AQP/soilDB/WCS-demonstration-01.Rmd index 69dfa05..27a1702 100644 --- a/AQP/soilDB/WCS-demonstration-01.Rmd +++ b/AQP/soilDB/WCS-demonstration-01.Rmd @@ -961,18 +961,18 @@ levelplot(s, ### Soil / Land Classification ```{r fig.width=8, fig.height=8} -# make a bounding box and assign a CRS (4326: GCS, WGS84) -a <- st_bbox( - c(xmin = -114.30, xmax = -114.00, ymin = 47.5, ymax = 47.70), - crs = st_crs(4326) -) +# use terra methods to define a BBOX, from SoilWeb 'b' keypress +# https://casoilresource.lawr.ucdavis.edu/gmap/?loc=47.24008,-99.73114,z11 -# convert bbox to sf geometry -a <- st_as_sfc(a) +# generate WKT description of viewport BBOX +bb <- '-100.2976 47.0407,-100.2976 47.4717,-99.3013 47.4717,-99.3013 47.0407,-100.2976 47.0407' +wkt <- sprintf('POLYGON((%s))', bb) + +# init spatVector +a <- vect(wkt, crs = 'epsg:4326') -# these are grids + RAT +# results are grids + RAT greatgroup <- ISSR800.wcs(aoi = a, var = 'greatgroup') -lcc_irrigated <- ISSR800.wcs(aoi = a, var = 'lcc_irrigated') # create a large color palette for greatgroup classes cols <- brewer.pal(12, 'Set3') @@ -980,13 +980,25 @@ cols <- darken(cols, amount = 0.25) cr <- colorRampPalette(cols, space = 'Lab', interpolate = 'spline') plot(greatgroup, axes = FALSE, col = cr(50), mar = c(1, 1, 1, 6)) +``` -# colors for irrigated LCC + +```{r fig.width=8, fig.height=8} +# both LCC data may or may not available in some places +lcc_nonirrigated <- ISSR800.wcs(aoi = a, var = 'lcc_nonirrigated') +lcc_irrigated <- ISSR800.wcs(aoi = a, var = 'lcc_irrigated') + +# check NA fraction +global(lcc_nonirrigated, 'isNA') / ncell(lcc_nonirrigated) +global(lcc_irrigated, 'isNA') / ncell(lcc_irrigated) + + +# colors for irrigated/non-irrigated LCC cols <- hcl.colors(50, 'Spectra', rev = TRUE) cols <- colorspace::darken(cols, amount = 0.1) cr <- colorRampPalette(cols, space = 'Lab', interpolate = 'spline') -plot(lcc_irrigated, axes = FALSE, col = cr(50), mar = c(1, 1, 1, 6)) +plot(lcc_nonirrigated, axes = FALSE, col = cr(50), mar = c(1, 1, 1, 6), main = 'Non-Irrigated LCC') ``` @@ -1119,21 +1131,7 @@ plot(ss, axes = FALSE, main = 'FAO Salt Severity', col = hcl.colors(10)) ## Others - - - -```{r fig.width = 8, fig.height = 8, eval = FALSE, echo = FALSE} -library(tanaka) -tanaka( - pH_3060cm, - breaks = c(6, 7, 8), - legend.pos = "topright", - legend.title = "pH 1:1 H2O (30-60cm)", - col = hcl.colors(4) -) - -``` ---------------------------- diff --git a/AQP/soilDB/WCS-demonstration-01.html b/AQP/soilDB/WCS-demonstration-01.html index 40b59a0..c42d3b9 100644 --- a/AQP/soilDB/WCS-demonstration-01.html +++ b/AQP/soilDB/WCS-demonstration-01.html @@ -10,7 +10,7 @@ - + Map Unit Key Web Coverage Service @@ -1704,7 +1704,7 @@

Map Unit Key Web Coverage Service

-

2024-04-25

+

2024-05-02

@@ -2030,7 +2030,7 @@

Map Unit Key Grids

## extent : -1365495, -1358925, 2869245, 2873655 (xmin, xmax, ymin, ymax) ## coord. ref. : NAD83 / Conus Albers (EPSG:5070) ## source(s) : memory -## varname : file40c8179f2de +## varname : file3b28190611e1 ## categories : mukey ## name : mukey ## min value : 144983 @@ -2124,7 +2124,7 @@

Raster Soil Survey Data

## extent : 1129005, 1135005, 1402995, 1411005 (xmin, xmax, ymin, ymax) ## coord. ref. : NAD83 / Conus Albers (EPSG:5070) ## source(s) : memory -## varname : file40c8834c1 +## varname : file3b2855f94464 ## categories : mukey ## name : mukey ## min value : 545800 @@ -2137,7 +2137,7 @@

Raster Soil Survey Data

## extent : 1129005, 1135005, 1402995, 1411005 (xmin, xmax, ymin, ymax) ## coord. ref. : NAD83 / Conus Albers (EPSG:5070) ## source(s) : memory -## varname : file40c814e05664 +## varname : file3b286d6c75a2 ## categories : mukey ## name : mukey ## min value : 545800 @@ -2150,7 +2150,7 @@

Raster Soil Survey Data

## extent : 1129005, 1135005, 1402995, 1411005 (xmin, xmax, ymin, ymax) ## coord. ref. : NAD83 / Conus Albers (EPSG:5070) ## source(s) : memory -## varname : file40c855c42630 +## varname : file3b285cf22aa0 ## categories : mukey ## name : mukey ## min value : 3244721 @@ -2184,7 +2184,7 @@

STATSGO

## extent : 1129005, 1135005, 1402995, 1411095 (xmin, xmax, ymin, ymax) ## coord. ref. : NAD83 / Conus Albers (EPSG:5070) ## source(s) : memory -## varname : file40c823db7cfc +## varname : file3b283903451 ## categories : mukey ## name : mukey ## min value : 659074 @@ -3162,18 +3162,18 @@

ISSR-800

Soil / Land Classification

-
# make a bounding box and assign a CRS (4326: GCS, WGS84)
-a <- st_bbox(
-  c(xmin = -114.30, xmax = -114.00, ymin = 47.5, ymax = 47.70), 
-  crs = st_crs(4326)
-)
+
# use terra methods to define a BBOX, from SoilWeb 'b' keypress
+# https://casoilresource.lawr.ucdavis.edu/gmap/?loc=47.24008,-99.73114,z11
 
-# convert bbox to sf geometry
-a <- st_as_sfc(a)
+# generate WKT description of viewport BBOX
+bb <- '-100.2976 47.0407,-100.2976 47.4717,-99.3013 47.4717,-99.3013 47.0407,-100.2976 47.0407'
+wkt <- sprintf('POLYGON((%s))', bb)
+
+# init spatVector
+a <- vect(wkt, crs = 'epsg:4326')
 
-# these are grids + RAT
+# results are grids + RAT
 greatgroup <- ISSR800.wcs(aoi = a, var = 'greatgroup')
-lcc_irrigated <- ISSR800.wcs(aoi = a, var = 'lcc_irrigated')
 
 # create a large color palette for greatgroup classes
 cols <- brewer.pal(12, 'Set3')
@@ -3181,14 +3181,25 @@ 

Soil / Land Classification

cr <- colorRampPalette(cols, space = 'Lab', interpolate = 'spline') plot(greatgroup, axes = FALSE, col = cr(50), mar = c(1, 1, 1, 6))
-

-
# colors for irrigated LCC
+

+
# both LCC data may or may not available in some places
+lcc_nonirrigated <- ISSR800.wcs(aoi = a, var = 'lcc_nonirrigated')
+lcc_irrigated <- ISSR800.wcs(aoi = a, var = 'lcc_irrigated')
+
+# check NA fraction
+global(lcc_nonirrigated, 'isNA') / ncell(lcc_nonirrigated)
+
##              isNA
+## label 0.000490918
+
global(lcc_irrigated, 'isNA') / ncell(lcc_irrigated)
+
##                                  isNA
+## Land Capability Class, irrigated    1
+
# colors for irrigated/non-irrigated LCC
 cols <- hcl.colors(50, 'Spectra', rev = TRUE)
 cols <- colorspace::darken(cols, amount = 0.1)
 cr <- colorRampPalette(cols, space = 'Lab', interpolate = 'spline')
 
-plot(lcc_irrigated, axes = FALSE, col = cr(50), mar = c(1, 1, 1, 6))
-

+plot(lcc_nonirrigated, axes = FALSE, col = cr(50), mar = c(1, 1, 1, 6), main = 'Non-Irrigated LCC')
+

Soil Color

@@ -3233,7 +3244,7 @@

Soil Color

# color table is pre-set by soilColor.wcs() plot(s, legend = FALSE, axes = FALSE, main = metags(s, name = 'description'))
-

+

Classification

@@ -3274,7 +3285,7 @@

Classification

## extent : -2178400, -2064800, 1816800, 1947200 (xmin, xmax, ymin, ymax) ## coord. ref. : NAD83 / Conus Albers (EPSG:5070) ## source(s) : memory -## varname : file40c84bcf7082 +## varname : file3b28556b7014 ## categories : label ## name : FAO Salt Severity ## min value : extremely saline