Merge pull request #12 from jfisher-usgs/master

Merge with upstream

Author: jfisher-usgs

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: wrv
 Title: Wood River Valley Groundwater-Flow Model
-Version: 1.1.1.9000
+Version: 1.1.2
 Authors@R: person(given=c("Jason", "C."), family="Fisher", role=c("aut", "cre"), email="jfisher@usgs.gov")
 Description: A processing program for the groundwater-flow model of the Wood
     River Valley aquifer system, south-central Idaho. Included in the package is

Makefile

@@ -17,7 +17,7 @@ build:
 
 install: build
 	cd ..;\
-	R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz;\
+	R CMD INSTALL --build $(PKGNAME)_$(PKGVERS).tar.gz;\
 
 check:
 	cd ..;\

NEWS.md

@@ -1,6 +1,12 @@
-# wrv 1.1.1.9000
+# wrv 1.1.2
 
-- ...
+- In `RunWaterBalance` function, sum groundwater diversions for `div.gw` dataset records having an identical site location and stress period.
+
+- Remove hard codding of irrigation years in appendix C, see `irr.lands` dataset creation.
+
+- In `GetWellConfig` function, fixed error that occurred when a well was located outside the model grid.
+
+- Specify `desc` argument in `inlmisc::SummariseBudget` function call, required for new version of **inlmisc** package.
 
 # wrv 1.1.1
 

R/GetWellConfig.R

@@ -54,11 +54,12 @@
 #' \dontrun{# see Appendix D. Uncalibrated Groundwater-Flow Model}
 #'
 
-GetWellConfig <- function(rs.model, wells, well.col, rate.col=NULL,
-                          lay2.hk.tol=1e-02) {
+GetWellConfig <- function(rs.model, wells, well.col, rate.col=NULL, lay2.hk.tol=1e-02) {
 
   wells@data$cell <- sp::over(wells, methods::as(rs.model, "SpatialGrid"))
-  is.in.model <- as.logical(!is.na(rs.model[["lay1.top"]])[wells@data$cell])
+  is.in.grid <- !is.na(wells@data$cell)
+  wells <- wells[is.in.grid, , drop=FALSE]
+  is.in.model <- !is.na(rs.model[["lay1.top"]][wells@data$cell])
   wells <- wells[is.in.model, , drop=FALSE]
 
   d <- wells@data

R/RunWaterBalance.R

@@ -269,8 +269,7 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
 
     comp <- entity.components[[i]]@data
     comp <- comp[comp$Source == "Mixed", cols]
-    names(comp) <- c("EntityName", "area.mix", "et.mix", "precip.mix",
-                     "cir.mix")
+    names(comp) <- c("EntityName", "area.mix", "et.mix", "precip.mix", "cir.mix")
     d <- suppressWarnings(dplyr::left_join(d, comp, by="EntityName"))
     d$cir.mix[is.na(d$cir.mix)] <- 0
 
@@ -312,8 +311,7 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
     d$hg.mix[is.src] <- d$SWDel[is.src]
     d$gw.dem.mix[is.src] <- d$cir.mix[is.src] / d$Eff[is.src] - d$hg.mix[is.src]
     d$gw.dem.mix[is.src & d$cir.mix <= 0] <- 0
-    d$gw.div.est[is.src] <- d$WWDiv[is.src] - d$gw.dem.mix[is.src] -
-                            d$GWDiv[is.src]
+    d$gw.div.est[is.src] <- d$WWDiv[is.src] - d$gw.dem.mix[is.src] - d$GWDiv[is.src]
     is.pos <- is.src & d$gw.div.est >= 0
     d$gw.div.est[is.pos] <- 0
     d$rech.mix[is.src] <- d$hg.mix[is.src] - d$GWDiv[is.src] + d$WWDiv[is.src] -
@@ -346,8 +344,7 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
     d$gw.dem.gw[is.src & d$cir.gw <= 0] <- 0
     d$gw.div.est[is.src] <- -d$gw.dem.gw[is.src] - d$GWDiv[is.src]
     d$gw.div.est[is.src & d$gw.div.est > 0] <- 0
-    d$rech.gw[is.src] <- -d$GWDiv[is.src] - d$gw.div.est[is.src] -
-                         d$cir.gw[is.src]
+    d$rech.gw[is.src] <- -d$GWDiv[is.src] - d$gw.div.est[is.src] - d$cir.gw[is.src]
 
     return(d)
   }
@@ -357,18 +354,13 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
   cols <- names(div.by.entity[[1]])
   FUN <- function(i) {
     d <- data.frame(EntityName=levels(irr.entities@data$EntityName))
-
     d <- suppressWarnings(dplyr::left_join(d, sw.div.by.entity[[i]], by="EntityName"))
     d$SWDiv[is.na(d$SWDiv)] <- 0
-
     d <- suppressWarnings(dplyr::left_join(d, gw.div.by.entity[[i]], by="EntityName"))
     d$GWDiv[is.na(d$GWDiv)] <- 0
-
     d <- suppressWarnings(dplyr::left_join(d, ww.div.by.entity[[i]], by="EntityName"))
     d$WWDiv[is.na(d$WWDiv)] <- 0
-
     d$rech.gw <- d$SWDiv - d$GWDiv + d$WWDiv
-
     d[, cols[!cols %in% names(d)]] <- NA
     return(d[, cols])
   }
@@ -383,8 +375,7 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
 
     cols <- names(div.by.entity[[1]])
     d <- dplyr::bind_rows(lapply(div.by.entity, function(i) i[, cols]))
-    year.month <- rep(names(div.by.entity),
-                      times=vapply(div.by.entity, nrow, 0L))
+    year.month <- rep(names(div.by.entity), times=vapply(div.by.entity, nrow, 0L))
     d <- cbind(YearMonth=year.month, d)
     rownames(d) <- NULL
     d <- d[order(d$EntityName), c(2, 1, 3:ncol(d))]
@@ -464,12 +455,10 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
   FUN <- function(i) {
     d <- comb.sw.irr
     d$sw.rate <- 0
-    priority.cut <- priority.cuts[priority.cuts$YearMonth == i,
-                                       "Pdate_BWR"]
+    priority.cut <- priority.cuts[priority.cuts$YearMonth == i, "Pdate_BWR"]
     is.lt <- !is.sc.src & (!is.na(priority.cut) & d$Pdate < priority.cut)
     d$sw.rate[is.lt] <- d$MaxDivRate[is.lt]
-    priority.cut <- priority.cuts[priority.cuts$YearMonth == i,
-                                       "Pdate_SC"]
+    priority.cut <- priority.cuts[priority.cuts$YearMonth == i, "Pdate_SC"]
     is.lt <- is.sc.src & (!is.na(priority.cut) & d$Pdate < priority.cut)
     d$sw.rate[is.lt] <- d$MaxDivRate[is.lt]
     d <- dplyr::summarise_(dplyr::group_by_(d, "WaterRight"),
@@ -486,8 +475,7 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
     d <- d[is.est, ]
     d.agg <- dplyr::summarise_(dplyr::group_by_(d, "EntityName"),
                                gw.rate="sum(gw.rate, na.rm=TRUE)")
-    d$fraction <- d$gw.rate /
-                  d.agg$gw.rate[match(d$EntityName, d.agg$EntityName)]
+    d$fraction <- d$gw.rate / d.agg$gw.rate[match(d$EntityName, d.agg$EntityName)]
     d$gw.div <- 0
     div <- div.by.entity[[i]][, c("EntityName", "gw.div.est")]
     idxs <- match(d$EntityName, div$EntityName)
@@ -499,8 +487,7 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
   names(rech.by.pod) <- yr.mo.irr
 
   FUN <- function(i) {
-    rec <- gw.div.by.wmis.no[gw.div.by.wmis.no$YearMonth == i,
-                             c("WMISNumber", "GWDiv")]
+    rec <- gw.div.by.wmis.no[gw.div.by.wmis.no$YearMonth == i, c("WMISNumber", "GWDiv")]
     est <- rech.by.pod[[i]][, c("WMISNumber", "gw.div")]
     est <- dplyr::summarise_(dplyr::group_by_(est, "WMISNumber"),
                              gw.div="sum(gw.div, na.rm=TRUE)")
@@ -517,7 +504,8 @@ RunWaterBalance <- function(r.grid, tr.stress.periods,
 
   is.non.irr <- div.gw$YearMonth %in% yr.mo.non.irr
   d <- div.gw[is.non.irr, c("WMISNumber", "YearMonth", "GWDiv")]
-
+  d <- aggregate(d$GWDiv, by=list(paste(d[, 1], d[, 2])), sum)
+  d <- data.frame(do.call(rbind, strsplit(d[, 1], split=" ")), d[, 2])
   rows <- match(d[, 1], rownames(pod.rech))
   cols <- match(d[, 2], colnames(pod.rech))
   pod.rech[cbind(rows, cols)] <- d[, 3]

inst/doc/sir20165080_AppendixC.R

@@ -906,8 +906,9 @@ CheckStatus("irr.entities")
 
 ## ----irr_lands_1---------------------------------------------------------
 path <- file.path(dir.in, "irr")
-yr <- c(1996, 2000, 2002, 2006, 2008, 2009, 2010)
-files <- paste0("irr.lands.", yr)
+files <- grep("^irr.lands.\\d{4}.shp$", list.files(path), value = TRUE)
+files <- tools::file_path_sans_ext(files)
+yr <- sub("irr.lands.", "", files)
 irr.lands <- list()
 for (i in seq_along(files)) {
   p <- readOGR(path, files[i], verbose = FALSE)
@@ -919,7 +920,7 @@ for (i in seq_along(files)) {
   p@data <- droplevels(p@data)
   irr.lands[[i]] <- p
 }
-names(irr.lands) <- as.character(yr)
+names(irr.lands) <- yr
 save(irr.lands, file = file.path(dir.out, "irr.lands.rda"), compress = "xz")
 
 ## ----echo=FALSE----------------------------------------------------------

inst/doc/sir20165080_AppendixC.Rnw

@@ -1543,8 +1543,9 @@ Irrigated and semi-irrigated lands of the WRV.
 
 <<irr_lands_1>>=
 path <- file.path(dir.in, "irr")
-yr <- c(1996, 2000, 2002, 2006, 2008, 2009, 2010)
-files <- paste0("irr.lands.", yr)
+files <- grep("^irr.lands.\\d{4}.shp$", list.files(path), value = TRUE)
+files <- tools::file_path_sans_ext(files)
+yr <- sub("irr.lands.", "", files)
 irr.lands <- list()
 for (i in seq_along(files)) {
   p <- readOGR(path, files[i], verbose = FALSE)
@@ -1556,7 +1557,7 @@ for (i in seq_along(files)) {
   p@data <- droplevels(p@data)
   irr.lands[[i]] <- p
 }
-names(irr.lands) <- as.character(yr)
+names(irr.lands) <- yr
 save(irr.lands, file = file.path(dir.out, "irr.lands.rda"), compress = "xz")
 @
 

inst/extdata/README.md

@@ -63,16 +63,18 @@ The only unprocessed dataset used during model construction and not included und
 |   +-- irr.lands.2008.zip (location of irrigated lands during 2008)
 |   +-- irr.lands.2009.zip (location of irrigated lands during 2009)
 |   +-- irr.lands.2010.zip (location of irrigated lands during 2010)
+|   +-- irr.lands.2011.zip (location of irrigated lands during 2011)
 |   +-- irr.lands.year.csv (substitute years for missing years of irrigated lands)
 +-- opt (parameter estimation)
 |   +-- div.ret.exch.zip (diversions, returns, and exchange wells)
 |   +-- kriging.zones.zip (kriging zones)
 |   +-- obs.wells.head.csv (groundwater-level measurements)
 |   +-- obs.wells.zip (observation wells)
 |   +-- pilot.points.zip (location of pilot points)
-|   +-- reach.recharge.csv (recharge from stream-aquifer flow exchange)
-|   +-- sensitivity.csv (sensitivity analysis)
+|   +-- reach.recharge.csv (recharge from stream-aquifer flow exchange on major river reaches)
 |   +-- seepage.study.zip (stream seepage study)
+|   +-- sensitivity.csv (sensitivity analysis)
+|   +-- subreach.recharge.csv (recharge from stream-aquifer flow exchange sub-reaches)
 +-- precip
 |   +-- precip.csv (precipitation recorded at weather stations)
 |   +-- swe.choco.csv (snow water equivalent recorded at the Chocolate Gulch weather station)
@@ -85,11 +87,11 @@ The only unprocessed dataset used during model construction and not included und
 +-- drains.kml (location of outlet boundaries represented as drains)
 +-- misc.seepage.csv (recharge rates at miscellaneous recharge sources)
 +-- perennial.reaches.csv (perennial river reaches)
-+-- precipitation.csv (mean monthly precipitation depth)
 +-- public.parcels.zip (location of public land parcels)
 +-- README.md
 +-- river.reaches.zip (location of major river reaches)
-+-- soils.zip (location of surficial soil units and their maximum seepage rates)
++-- soils.csv (maximum seepage rates on surficial soil units)
++-- soils.zip (location of surficial soil units)
 +-- tributaries.csv (flow properties in the tributaries)
 +-- tributaries.kml (location of groundwater inflow boundaries in the tributary canyons)
 +-- wetlands.zip (location of wetlands)

inst/misc/Rd2.tex

@@ -14,7 +14,7 @@ \chapter*{}
 \raggedright{}
 \inputencoding{utf8}
 \item[Title]\AsIs{Wood River Valley Groundwater-Flow Model}
-\item[Version]\AsIs{1.1.1.9000}
+\item[Version]\AsIs{1.1.2}
 \item[Description]\AsIs{A processing program for the groundwater-flow model of the Wood
 River Valley aquifer system, south-central Idaho. Included in the package is
 MODFLOW-USG version 1.3, a U.S. Geological Survey groundwater-flow model.}

vignettes/sir20165080_AppendixC.Rnw

@@ -1543,8 +1543,9 @@ Irrigated and semi-irrigated lands of the WRV.
 
 <<irr_lands_1>>=
 path <- file.path(dir.in, "irr")
-yr <- c(1996, 2000, 2002, 2006, 2008, 2009, 2010)
-files <- paste0("irr.lands.", yr)
+files <- grep("^irr.lands.\\d{4}.shp$", list.files(path), value = TRUE)
+files <- tools::file_path_sans_ext(files)
+yr <- sub("irr.lands.", "", files)
 irr.lands <- list()
 for (i in seq_along(files)) {
   p <- readOGR(path, files[i], verbose = FALSE)
@@ -1556,7 +1557,7 @@ for (i in seq_along(files)) {
   p@data <- droplevels(p@data)
   irr.lands[[i]] <- p
 }
-names(irr.lands) <- as.character(yr)
+names(irr.lands) <- yr
 save(irr.lands, file = file.path(dir.out, "irr.lands.rda"), compress = "xz")
 @