From 2415d80c3873cde5c670c893e31d5824938c57fa Mon Sep 17 00:00:00 2001 From: dleutnant Date: Sat, 17 Feb 2018 18:14:44 +0100 Subject: [PATCH] update travis yml --- .travis.yml | 7 +- R/convert_to_sf.R | 10 +- man/create_sf_of_linestring.Rd | 17 +++ man/create_sf_of_pt.Rd | 17 +++ vignettes/How_swmmr_reads_and_writes_files.R | 12 ++ ...to_autocalibrate_a_SWMM_model_with_swmmr.R | 103 ++++++++++++++++++ 6 files changed, 160 insertions(+), 6 deletions(-) create mode 100644 man/create_sf_of_linestring.Rd create mode 100644 man/create_sf_of_pt.Rd create mode 100644 vignettes/How_swmmr_reads_and_writes_files.R create mode 100644 vignettes/How_to_autocalibrate_a_SWMM_model_with_swmmr.R diff --git a/.travis.yml b/.travis.yml index 7848c7e..e6c4bc2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,6 +4,9 @@ language: R sudo: false cache: packages +env: + - _R_CHECK_FORCE_SUGGESTS_=false + # do not run R code in vignettes -r_build_args: "--no-build-vignettes" -r_check_args: "--no-vignettes" +r_build_args: '--no-build-vignettes' +r_check_args: '--as-cran --ignore-vignettes' \ No newline at end of file diff --git a/R/convert_to_sf.R b/R/convert_to_sf.R index 5f3f755..c9bbdeb 100644 --- a/R/convert_to_sf.R +++ b/R/convert_to_sf.R @@ -705,8 +705,9 @@ inp_to_sf <- function(x) { return(sf) } -# helper function to create a simple feature object from point geometry -# function is not exported +#' helper function to create a simple feature object from point geometry +#' function is not exported +#' #' @param x a tibble to be converted #' @keywords internal create_sf_of_pt <- function(x) { @@ -724,8 +725,9 @@ create_sf_of_pt <- function(x) { } -# helper function to create a simple feature object from linestring geometry -# function is not exported +#' helper function to create a simple feature object from linestring geometry +#' function is not exported +#' #' @param x a tibble to be converted #' @keywords internal create_sf_of_linestring <- function(x) { diff --git a/man/create_sf_of_linestring.Rd b/man/create_sf_of_linestring.Rd new file mode 100644 index 0000000..60acb44 --- /dev/null +++ b/man/create_sf_of_linestring.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert_to_sf.R +\name{create_sf_of_linestring} +\alias{create_sf_of_linestring} +\title{helper function to create a simple feature object from linestring geometry +function is not exported} +\usage{ +create_sf_of_linestring(x) +} +\arguments{ +\item{x}{a tibble to be converted} +} +\description{ +helper function to create a simple feature object from linestring geometry +function is not exported +} +\keyword{internal} diff --git a/man/create_sf_of_pt.Rd b/man/create_sf_of_pt.Rd new file mode 100644 index 0000000..113dd6a --- /dev/null +++ b/man/create_sf_of_pt.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert_to_sf.R +\name{create_sf_of_pt} +\alias{create_sf_of_pt} +\title{helper function to create a simple feature object from point geometry +function is not exported} +\usage{ +create_sf_of_pt(x) +} +\arguments{ +\item{x}{a tibble to be converted} +} +\description{ +helper function to create a simple feature object from point geometry +function is not exported +} +\keyword{internal} diff --git a/vignettes/How_swmmr_reads_and_writes_files.R b/vignettes/How_swmmr_reads_and_writes_files.R new file mode 100644 index 0000000..7f4f14d --- /dev/null +++ b/vignettes/How_swmmr_reads_and_writes_files.R @@ -0,0 +1,12 @@ +## ----setup, include = FALSE---------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----inp_sec, echo = FALSE----------------------------------------------- +swmmr:::input_sections + +## ----rpt_sec, echo = FALSE----------------------------------------------- +swmmr:::report_sections + diff --git a/vignettes/How_to_autocalibrate_a_SWMM_model_with_swmmr.R b/vignettes/How_to_autocalibrate_a_SWMM_model_with_swmmr.R new file mode 100644 index 0000000..a8a2fdf --- /dev/null +++ b/vignettes/How_to_autocalibrate_a_SWMM_model_with_swmmr.R @@ -0,0 +1,103 @@ +## ----setup, include = FALSE---------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----load_libs----------------------------------------------------------- +library(swmmr) +library(DEoptim) + +## ----model_setup--------------------------------------------------------- +# set the path to inp file +# in case your operating system is Windows, please change this path to +# "C:\Users\your user name\Documents\EPA SWMM Projects\Examples\Example1.inp" +# and substitute your user name. +inp_file <- "~/EPA_SWMM_Projects/Examples/Example1.inp" +# both rpt and out files are temporary files +tmp_rpt_file <- tempfile() +tmp_out_file <- tempfile() + +# initiate the simulation +swmm_files <- run_swmm( + inp = inp_file, + rpt = tmp_rpt_file, + out = tmp_out_file +) + +## ----obs----------------------------------------------------------------- +obs <- read_out( + file = swmm_files$out, + iType = 1, + object_name = "18", + vIndex = 4 +)[["18"]]$total_inflow + +## ----sim_and_read-------------------------------------------------------- +# read model structure +inp <- read_inp(swmm_files$inp) + +# show the original parameter values +inp$subcatchments[inp$subcatchments$Area > 10, ] + + +## ----gof----------------------------------------------------------------- +# function calculates the goodness of fit value +# input x is a two column xts object, col1: obs, col2: sim +nse <- function(x) { + 1 - sum((x[, 1] - x[, 2]) ^ 2) / sum((x[, 1] - mean(x[, 1])) ^ 2) +} + +## ----obj_fun------------------------------------------------------------- +obj_fun <- function(x, inp, obs) { + + # set new parameters and update inp object + inp$subcatchments <- transform( + inp$subcatchments, + Perc_Imperv = ifelse(Area > 10, x, Perc_Imperv) + ) + + # write new inp file to disk + tmp_inp <- tempfile() + write_inp(inp, tmp_inp) + + # run swmm with new parameter set + swmm_files <- suppressMessages(run_swmm(tmp_inp, stdout = NULL)) + + # remove files when function exits to avoid heavy disk usage + on.exit(file.remove(unlist(swmm_files))) + + # read sim result + sim <- read_out( + file = swmm_files$out, # path to out file + iType = 1, # type: node + object_name = "18", # name of node + vIndex = 4 # parameter at node: total inflow + )[["18"]]$total_inflow # directly access to xts object + + # calculate goodness-of-fit + # note: multiply by minus one to have a real min problem (nse: +1 to -Inf) + nse(merge(obs, sim)) * -1 +} + + +## ----optim--------------------------------------------------------------- + set.seed(84) # to get reproducible results + + calibration_res <- DEoptim( + fn = obj_fun, + lower = c(0, 0), + upper = c(100, 100), + control = list( + itermax = 50, # maximum iterations + trace = 10, # print progress every 10th iteration + packages = c("swmmr"), # export packages to optimization environment + parVar = c("nse"), # export function to optimization environment + parallelType = 0 # set to 1 to use all available cores + ), + inp = inp, # 'inp' object + obs = obs # xts object containing observation data + ) + + summary(calibration_res) +