Tutorial
For example, using the Blacksburg, VA National Weather Service station-based precipitation, temperature, and season from 1991 to 2020, we can generate simulated precipitation and temperature for any desired time length and ensemble size. Your variables must be named as the following: ‘year’, ‘month’, ‘day’, ‘prcp’, ‘temp’, ‘season’. All input variables must be contained within the same dataframe or text file. If inputting a text file, it must be comma separated (.csv). The weather generator can handle NA values for precipitation or temperature, but all other variables should be numeric values.
Step 1: Load your data
library(wxgenR)
library(lubridate)
#>
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#>
#> date, intersect, setdiff, union
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(tidyr)
library(ggpubr)
#> Loading required package: ggplot2
library(moments)
library(seas)
#> Loading required package: MASS
#>
#> Attaching package: 'MASS'
#> The following object is masked from 'package:dplyr':
#>
#> select
data(BlacksburgVA)
# head(BlacksburgVA)Step 2: Select your run settings and run the weather generator
Use the variables within the wx() function like syr and
eyr (start and end year) to set the temporal boundaries
from which to sample, otherwise, if left empty the start and end years
will default to the beginning and end of your training data. Use
nsim to set the length (in years) of your simulated
weather, and nrealz to set the ensemble size (number of
traces).
The variable wwidth will set the sampling window for
each day of year (Jan. 1 through Dec. 31) for every year in the
simulation. The sampling window for each day of year is +/-
wwidth + 1, effectively sampling wwidth number
of days before and after each day of year, including that day of year. A
lower value for wwidth will sample fewer surrounding days
and a higher value will sample more days, resulting in dampened and
heightened variability, respectively. Typical setting of
wwidth is between 1 and 15, resulting in a daily sampling
window of 3 days and 31 days, respectively. Generally, higher and lower
values of wwidth result in higher and lower variance,
respectively, in the simulated data.
For example, to simulate precipitation on day 1 of the simulation
(Jan. 1 of year 1), with wwidth = 1 (a 3-day window), the
algorithm will sample days in the training record between (and
including) December 31 and January 2 (for all years in the training
record). For day 2 of the simulation (Jan. 2 of year 1), the algorithm
will sample days in the training record between January 1 and January 3.
Simulation day 3 (Jan. 3) will sample between January 2 and January 4,
and so on. Increasing wwidth to 2 (a 5-day window) will
sample between December 30 and January 3 for Jan. 1 simulations,
December 31 to January 4 for Jan. 2, and January 1 to January 5 for
Jan. 3, and so on.
In some cases, the wwidth will be automatically
increased through an adaptive window width if precipitation occurred on
a given day but there were less than two daily precipitation values over
0.01 inches during the window for that day. wwidth will
adaptively increase by 1 until two or more daily precipitation values
over 0.01 inches are in each window. Adaptive window width is most
likely to occur in regions with high aridity, dry seasons, a small
initial value of wwidth is used, or if the number of years
in the training data is relatively short (e.g., less than 30 years). To
display the results of the adaptive window width, set
awinFlag = T.
Here, our training data spans 1991-01-01 to 2020-12-31, but we don’t
want to use the full historical record, so we set syr and
eyr to 2000 and 2004, respectively, in the
wx() function so that the training data is subset between
those years. We want a simulation length of 5-years (nsim)
in order to match the length of the subset training record and 2 traces
in our ensemble (nrealz) for computational efficiency
(although more traces, e.g. 50, are recommended). Sampling for each day
of the year will sample from the preceding 1-day, the day of, and the
following 1-day (wwidth) for a total window size of
3-days.
We may also want to increase the variability of our simulated
precipitation by sampling outside the historical envelope with an
Epanechnikov Kernel (ekflag = T). For more details on the
Epanechnikov kernel and its use in a weather generator, see Rajagopalan
et al. (1996). Setting tempPerturb = T will increase the
variability of the simulated temperature by adding random noise from a
normal distribution fit using a mean of zero and a standard deviation
equal to the monthly standard deviation of simulated temperature
residuals. Given that simulated daily temperature at time t is a
function of temperature(t-1), cosine(t), sine(t), precipitation
occurrence(t), and monthly mean temperature(t), the standard deviation
of daily residuals from this model is calculated for each month and used
to add random noise to the simulated temperature. The temperature
simulation approach is inspired by- and adapted from- Verdin et
al. (2015, 2018).
Since the training data has units of inches and degrees Fahrenheit
for precipitation and temperature, respectively, we must set
unitSystem = "Metric". Setting numbCores to 2
or greater will enable parallel computing for precipitation simulation
which is the most computationally intensive aspect of the weather
generator.
nsim = 5 #number of simulation years
nrealz = 2 #number of traces in ensemble
startTime <- Sys.time() #benchmark run time
z = wx(trainingData = BlacksburgVA, syr = 2000, eyr = 2004,
smo = 1, emo = 12,
nsim = nsim, nrealz = nrealz, aseed = 123,
wwidth = c(7,5,1,3), unitSystem = "Metric", ekflag = TRUE,
awinFlag = FALSE, tempPerturb = TRUE, pcpOccFlag = FALSE,
numbCores = 2)
#> ...Simulate precipitation occurrence and temperature...
#> 1
#> 2
#> ...Simulate precipitation amount...
endTime = Sys.time()The wx() function will return a list containing both your
input/training data, and a variety of processed outputs, named here as
the variable z. Within z, dat.d
is the original input data as well as some intermediary variables.
simyr1 contains the years within your training data that
were sampled to generate simulated values for each trace. X
is the occurrence of daily precipitation for each trace, where 1 and 0
indicate the presence and absence of precipitation, respectively.
Xseas is the season index for each day and trace.
Xpdate shows which days from the training data were sampled
for each simulated day and trace, if precipitation was simulated to
occur on a given day. Xpamt is the simulated precipitation
amount for each day and trace. Xtemp is the simulated
temperature for each day and trace.
Generally, Xpamt and Xtemp will be of most
interest to users as these are the desired outputs of simulated daily
precipitation and temperature.
Step 3: Analyze simulated weather
First, use modified approach from writeSim function to post-process/format output
#parse variables from wx() output
dat.d = z$dat.d
simyr1 = z$simyr1
X = z$X
Xseas = z$Xseas
Xpdate = z$Xpdate
Xpamt = z$Xpamt
Xtemp = z$Xtemp
#write simulation output
#
it1 <- seq(1, length(X[,1]), 366)
it2 = it1+366-1
#initialize storage
sim.pcp = matrix(NA, nrow = nsim*366, ncol = nrealz+3)
sim.tmp = matrix(NA, nrow = nsim*366, ncol = nrealz+3)
sim.szn = matrix(NA, nrow = nsim*366, ncol = nrealz+3)
#loop through realization
irealz = 1
for (irealz in 1:nrealz){
outmat <- vector()
#loop through simulation years
isim = 1
for (isim in 1:nsim){
leapflag = FALSE
ayr = simyr1[isim, irealz]
if (lubridate::leap_year(ayr)) leapflag = TRUE
col1 = rep(isim, 366) #column 1, simulation year
d1 = ayr*10^4+01*10^2+01; d2 = ayr*10^4+12*10^2+31
i1 = which(dat.d$date1 == d1)
i2 = which(dat.d$date1 == d2)
col2 = dat.d$date1[i1:i2] #column 2, simulation date
if (leapflag == FALSE) col2 = c(col2,NA)
i1 = it1[isim]
i2 = it2[isim]
col3 = Xseas[i1:i2, irealz] #column 3, simulation season
col4 = X[i1:i2, irealz] #column 4, precipitation occurrence
col5 = Xpdate[i1:i2, irealz] #column 5, precipation resampling date
col6 = Xpamt[i1:i2, irealz] #column 6, resampled precipitation amount
col7 = Xtemp[i1:i2, irealz] #column7, simulated temperature
#create time series of 'simulation day'
sim.yr = rep(isim, length(col2))
sim.month = month(ymd(col2))
sim.day = day(ymd(col2))
outmat = rbind(outmat, cbind(sim.yr, sim.month, sim.day, col6, col7, col3))
} #isim
colnames(outmat) = c("simulation year", "month", "day", "prcp", "temp", "season")
if(irealz == 1){
sim.pcp[,1:3] = outmat[,1:3]
sim.tmp[,1:3] = outmat[,1:3]
sim.szn[,1:3] = outmat[,1:3]
}
sim.pcp[,irealz+3] = outmat[,4]
sim.tmp[,irealz+3] = outmat[,5]
sim.szn[,irealz+3] = outmat[,6]
} #irealz#Format dataframes for simulated precip, temperature, and season
df = sim.pcp
formatting = function(df){
df = as.data.frame(df)
colnames(df) = c("simulation year", "month", "day", paste0("Trace_", 1:nrealz))
#remove 366 days for non-leap years
df = drop_na(df, c(month, day))
#assign simulation year to start at the same time as training data
df$`simulation year` = df$`simulation year` + dat.d$year[1] - 1
#format date
df$Date = ymd(paste(df$`simulation year`, df$month, df$day, sep = "-"))
#remove years that aren't leap years
# df = drop_na(df, Date)
df = df %>%
mutate(yday = as.numeric(yday(Date)),
week = as.numeric(week(Date))) %>%
relocate(c(Date,yday,week), .after = day) %>%
pivot_longer(cols = starts_with("Trace_"),
names_to = "variable",
values_to = "value")
return(df)
}Format training data
First you might want to plot the daily time series for verification
If your data contained NA values, they can propagate to simulated
temperature values (NA precip values in your data are set to 0), so use
na.rm = T for any subsequent analysis. You may also choose
to replace NA values with daily or monthly averages.
Additionally, leap years may be included in the simulated weather if
they are included in your training data, so all non-leap years include a
row of ‘NA’ values at the end of the calendar year as a book-keeping
measure so that the total number of rows in each trace is the same.
#plot simulated daily data
simDat = sim.tmp
obsDat = obs.tmp
Tag = "Temp"
dailyPlot = function(simDat, obsDat, Tag){
simD = simDat %>%
drop_na() %>%
group_by(variable, yday) %>%
summarise(
mean = mean(value, na.rm = T),
max = max(value, na.rm = T),
sd = sd(value, na.rm = T),
skew = skewness(value, na.rm = T)
) %>%
ungroup()
simDq <- simD %>%
group_by(yday) %>%
summarise(
mean_q5 = quantile(mean, 0.05, na.rm = T),
mean_med = median(mean, na.rm = T),
mean_q95 = quantile(mean, 0.95, na.rm =T),
max_q5 = quantile(max, 0.05, na.rm = T),
max_med = median(max, na.rm = T),
max_q95 = quantile(max, 0.95, na.rm = T),
sd_q5 = quantile(sd, 0.05, na.rm = T),
sd_med = median(sd),
sd_q95 = quantile(sd, 0.95, na.rm = T),
skew_q5 = quantile(skew, 0.05, na.rm = T),
skew_med = median(skew, na.rm = T),
skew_q95 = quantile(skew, 0.95, na.rm = T)
) %>%
drop_na() %>%
ungroup()
if(Tag == "Temp"){
obs <- obsDat %>%
drop_na() %>%
group_by(yday) %>%
summarise(
mean = mean(temp, na.rm = T),
max = max(temp, na.rm = T),
sd = sd(temp, na.rm = T),
skew = skewness(temp, na.rm = T)
) %>%
ungroup()
} else if(Tag == "Precip"){
obs <- obsDat %>%
drop_na() %>%
group_by(yday) %>%
summarise(
mean = mean(prcp, na.rm = T),
max = max(prcp, na.rm = T),
sd = sd(prcp, na.rm = T),
skew = skewness(prcp, na.rm = T)
) %>%
ungroup()
}
colnames(obs)[-1] = paste0("obs_", colnames(obs)[-1])
df.comb = left_join(simDq, obs, by = "yday")
#plotting --------------------------------
lgdLoc = c(0.8, 0.9)
if(Tag == "Temp"){
yLabel = "Daily Temperature "
units = "(°F)"
} else if(Tag == "Precip"){
yLabel = "Daily Precipitation "
units = "(inches)"
}
trnAlpha = 0.65
#daily mean
p1 = ggplot(df.comb) +
geom_ribbon(aes(x = yday, ymin = mean_q5, ymax = mean_q95, fill = "95% Confidence"), alpha = 0.25) +
geom_line(aes(x = yday, y = mean_med, color = "Simulation Median"), size = 1, alpha = 0.8) +
geom_line(aes(x = yday, y = obs_mean, color = "Training Data"), size = 0.3, alpha = trnAlpha, linetype = "solid") +
geom_point(aes(x = yday, y = obs_mean, color = "Training Data"), size = 0.6, alpha = trnAlpha) +
# Corrected scale_colour_manual()
scale_colour_manual(values = c("Training Data" = "blue", "Simulation Median" = "red")) +
# Ensure fill is mapped for the ribbon
scale_fill_manual(values = c("95% Confidence" = "grey")) +
theme_classic() +
theme(axis.title = element_text(face = "bold"),
panel.grid.major = element_line(),
legend.title = element_blank(),
legend.position = lgdLoc,
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank()) +
xlab("Day of Year") + ylab(paste0("Mean ", yLabel, units))
#daily SD
p2 = ggplot(df.comb) +
geom_ribbon(aes(x = yday, ymin = sd_q5, ymax = sd_q95, fill = "95% Confidence"), alpha = 0.25) +
geom_line(aes(x = yday, y = sd_med, color = "Simulation Median"), size = 1, alpha = 0.8) +
geom_line(aes(x = yday, y = obs_sd, color = "Training Data"), size = 0.3, alpha = trnAlpha, linetype = "solid") +
geom_point(aes(x = yday, y = obs_sd, color = "Training Data"), size = 0.6, alpha = trnAlpha) +
scale_colour_manual(values = c("Training Data" = "blue", "Simulation Median" = "red")) +
scale_fill_manual(values = c("95% Confidence" = "grey")) +
theme_classic() +
theme(axis.title = element_text(face = "bold"),
panel.grid.major = element_line(),
legend.title = element_blank(),
legend.position = lgdLoc,
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank()) +
xlab("Day of Year") + ylab(paste0("Std. Deviation of ", yLabel, units))
#daily skew
p3 = ggplot(df.comb) +
geom_ribbon(aes(x = yday, ymin = skew_q5, ymax = skew_q95, fill = "95% Confidence"), alpha = 0.25) +
geom_line(aes(x = yday, y = skew_med, color = "Simulation Median"), size = 1, alpha = 0.8) +
geom_line(aes(x = yday, y = obs_skew, color = "Training Data"), size = 0.3, alpha = trnAlpha, linetype = "solid") +
geom_point(aes(x = yday, y = obs_skew, color = "Training Data"), size = 0.6, alpha = trnAlpha) +
scale_colour_manual(values = c("Training Data" = "blue", "Simulation Median" = "red")) +
scale_fill_manual(values = c("95% Confidence" = "grey")) +
theme_classic() +
theme(axis.title = element_text(face = "bold"),
panel.grid.major = element_line(),
legend.title = element_blank(),
legend.position = lgdLoc,
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank()) +
xlab("Day of Year") + ylab(paste0("Skew of ", yLabel, " (-)"))
#daily Max
p4 = ggplot(df.comb) +
geom_ribbon(aes(x = yday, ymin = max_q5, ymax = max_q95, fill = "95% Confidence"), alpha = 0.25) +
geom_line(aes(x = yday, y = max_med, color = "Simulation Median"), size = 1, alpha = 0.8) +
geom_line(aes(x = yday, y = obs_max, color = "Training Data"), size = 0.3, alpha = trnAlpha, linetype = "solid") +
geom_point(aes(x = yday, y = obs_max, color = "Training Data"), size = 0.6, alpha = trnAlpha) +
scale_colour_manual(values = c("Training Data" = "blue", "Simulation Median" = "red")) +
scale_fill_manual(values = c("95% Confidence" = "grey")) +
theme_classic() +
theme(axis.title = element_text(face = "bold"),
panel.grid.major = element_line(),
legend.title = element_blank(),
legend.position = lgdLoc,
legend.background = element_blank(),
legend.box.background = element_blank(),
legend.key = element_blank()) +
xlab("Day of Year") + ylab(paste0("Maximum ", yLabel, units))
p.comb = ggarrange(p1, p2, p3, p4, nrow = 2, ncol = 2, common.legend = TRUE, legend = "bottom")
print(p.comb)
# p.out = paste0(tempdir(), "/outputPlots/dailyStats_", Tag, ".png")
# ggsave(filename = p.out, plot = p.comb, device = "png")
}plot daily precipitation
dailyPlot(sim.pcp, obs.pcp, "Precip")
#> `summarise()` has grouped output by 'variable'. You can override using the
#> `.groups` argument.
#> Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
#> ℹ Please use `linewidth` instead.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
#> 3.5.0.
#> ℹ Please use the `legend.position.inside` argument of `theme()` instead.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: Removed 2 rows containing missing values or values outside the scale range
#> (`geom_line()`).
#> Warning: Removed 44 rows containing missing values or values outside the scale range
#> (`geom_point()`).
