diff --git a/DESCRIPTION b/DESCRIPTION index ea7b74c8d4d359a4431f5b297fab8063c0bfd6fb..de9e7357e88708e4ffacc8b952c9f47217aeac06 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SWATdoctR Type: Package Title: Finding the right diagnoses and treatments for SWAT+ models -Version: 0.1.11 +Version: 0.1.12 Author: c(person("Svajunas", "Plunge", email = "svajunas_plunge@sggw.edu.pl", role = c("aut")), diff --git a/R/plot_waterbalance.R b/R/plot_waterbalance.R index 62b7f67a491b49bb6cb892df940068a3bf7b7fdf..13239f9fb221daabf69e349b130e39250a9a8c69 100644 --- a/R/plot_waterbalance.R +++ b/R/plot_waterbalance.R @@ -23,16 +23,23 @@ plot_waterbalance <- function(sim_verify) { wb_aa <- round(unlist(sim_verify$basin_wb_aa[,c(8:12, 14:18, 20:23, 27:32, 34:39, 43)]), 2) aqu_aa <- round(unlist(sim_verify$basin_aqu_aa[,c(8:10, 12:13, 22:24)]), 2) - ratios <- round(c(wb_aa['et'] / wb_aa['precip'], - (wb_aa['surq_gen'] + wb_aa['latq'] + wb_aa['qtile'] + aqu_aa['flo']) / wb_aa['precip'], - (wb_aa['surq_cha'] + wb_aa['latq_cha'] + wb_aa['qtile'] + aqu_aa['flo_cha']) / wb_aa['precip'], - wb_aa['surq_gen'] + wb_aa['latq'] + wb_aa['qtile'] + aqu_aa['flo'], - wb_aa['surq_cha'] + wb_aa['latq_cha'] + wb_aa['qtile'] + aqu_aa['flo_cha'], - aqu_aa['flo'] / (wb_aa['surq_gen'] + wb_aa['latq'] + wb_aa['qtile'] + aqu_aa['flo']) - ), - 2) + if (aqu_aa['flo_cha'] == 0 & aqu_aa['flo_res'] == 0 & aqu_aa['flo'] > 0) { + aqu_flo <- aqu_aa['flo'] + } else { + aqu_flo <- aqu_aa['flo_cha'] + aqu_aa['flo_res'] + } - val <- c('', '', wb_aa, aqu_aa, '', '', '', '', '', '', '', ratios) + surq <- wb_aa['surq_cha'] + wb_aa['surq_res'] + + base <- wb_aa['latq_cha'] + wb_aa['latq_res'] + + aqu_flo + wb_aa['qtile'] + + wyld <- surq + base + + ratios <- round(c(wb_aa['et'] / wb_aa['precip'], wyld / wb_aa['precip'], + surq / wyld, base / wyld, surq, base, wyld), 2) + + val <- c('', '', wb_aa, aqu_aa, '', '', '', '', '', '', '', '', ratios) x <- c(0, 11.81, 2.25, 2.78, 4.69, 7.16, 7.16, @@ -43,36 +50,36 @@ plot_waterbalance <- function(sim_verify) { 9.90, 3.30, 7.16, 0.35, 0.35, 4.44, 2.15, 9.90, 9.90, 9.90, - 7.16, 7.16, 7.16, 7.16, 7.16, - 7.16, 7.16, - 9.90, 9.90, 9.90, 10.75, 10.75, - 9.90) - y <- c( 0, 10.00, - 8.34, 5.80, 5.12, 5.12, 3.48, - 1.87, 7.80, 6.52, 5.68, 4.85, - 8.37, 4.30, 3.80, 3.30, 5.12, - 8.87, 2.85, 6.35, 9.70, 2.83, - 5.68, 5.15, 4.61, 3.98, 3.45, - 2.95, 2.80, - 1.58, 2.08, 1.58, 0.43, 2.22, - 2.12, 1.60, 1.07, - 9.70, 9.20, 8.70, 8.20, 7.70, - 6.90, 6.20, - 9.20, 8.70, 8.20, 6.90, 6.20, - 7.70) - a <- c( 0, 0, - 0, 90, 0, 0, 0, - 90, 90, 90, 90, 90, - 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, - 0, 0, - 0, 0, 0, 90, 90, - 0, 0, 0, - 0, 0, 0, 0, 0, - 0, 0, - 0, 0, 0, 0, 0, - 0) + 7.16, 7.16, 7.16, 9.40, 9.40, + 7.16, 7.16, 7.16, + 8.60, 8.60, 10.75, 10.75, 10.75, + 10.75, 10.75) + y <- c(0, 10.00, + 8.34, 5.80, 5.12, 5.12, 3.48, + 1.87, 7.80, 6.52, 5.68, 4.85, + 8.37, 4.30, 3.80, 3.30, 5.12, + 8.87, 2.85, 6.35, 9.70, 2.83, + 5.68, 5.15, 4.61, 3.98, 3.45, + 2.95, 2.80, + 1.58, 2.08, 1.58, 0.43, 2.22, + 2.12, 1.60, 1.07, + 9.70, 9.20, 8.70, 9.20, 8.70, + 7.80, 6.70, 6.20, + 9.20, 8.70, 9.20, 8.70, 7.80, + 6.70, 6.20) + a <- c(0, 0, + 0, 90, 0, 0, 0, + 90, 90, 90, 90, 90, + 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, + 0, 0, + 0, 0, 0, 90, 90, + 0, 0, 0, + 0, 0, 0, 0, 0, + 0, 0, 0, + 0, 0, 0, 0, 0, + 0, 0) l <- c('','', 'precip:\n', 'sno_fall: ', 'sno_melt: ', 'surq_gen: ', 'latq: ', 'perc: ', 'et: ', 'ecanopy: ', 'eplant: ', 'esoil: ', @@ -82,11 +89,14 @@ plot_waterbalance <- function(sim_verify) { 'latq_ls: ', 'sw_change: ', 'flo: ', 'dep_wt: ', 'stor: ', 'seep: ', 'revap: ', 'flo_cha: ', 'flo_res: ', 'flo_ls: ', - 'Water balance ratios: ', 'et / precip: ', 'wyld / precip :', 'wyld_cha / precip :', 'flo / wyld: ', - 'wyld = surq_gen + latq + qtile + flo :', - 'wyld_cha = surq_cha + latq_cha +\n qtile + flo_cha :', - '', '', '', '', '', - '' + 'Water balance ratios: ', 'et / precip: ', 'wyld / precip:', 'surq / wyld:', 'base / wyld: ', + # 'wyld = surq_gen + latq + qtile + flo :', + paste0('surq = surq_cha + surq_res:'), + paste0('base = latq_cha + latq_res +\n', + ' flo_cha + flo_res +\n', + ' qtile:'), + paste0('wyld = surq + base:'), + '', '', '', '', '', '' ) l <- paste0(l, val)