Test how AMY and leap year related things in EPW and IDF interact

epw-eplus-amy-leapyear.R

library(eplusr)
library(purrr)
library(data.table)
library(lubridate)

create_idf <- function (ver = 8.9, realyear = FALSE, year = NULL, day_of_week = NULL) {
    path <- file.path(eplus_config(ver)$dir, "ExampleFiles", "5Zone_Transformer.idf")
    idf <- read_idf(path)

    idf$Output_Variable <- NULL
    idf$add(Output_Variable = list("*", "Site Outdoor Air Drybulb Temperature", "Hourly"))

    idf$RunPeriod <- NULL
    if (is.na(year)) year <- NULL
    if (is.na(day_of_week)) day_of_week <- NULL
    if (idf$version() <= 8.9) {
        idf$add(RunPeriod = list("TMY", 1, 1, 12, 31, start_year = year,
            day_of_week_for_start_day = day_of_week
        ))
    } else {
        idf$add(RunPeriod = list("AMY", 1, 1, year, 12, 31,
            day_of_week_for_start_day = day_of_week,
            treat_weather_as_actual = ifelse(realyear, "Yes", "No")
        ))
    }

    idf
}

create_epw <- function (ver, leapyear = FALSE, leapyear_in_header = leapyear, realyear = FALSE) {
    path <- file.path(eplus_config(ver)$dir, "WeatherData", "USA_CA_San.Francisco.Intl.AP.724940_TMY3.epw")
    epw <- read_epw(path)

    if (!leapyear) {
        epw_data <- epw$data(start_year = 2021, update = TRUE)
    } else {
        epw_data <- suppressWarnings(epw$data(start_year = 2020, update = TRUE))
        # create fake leap day data
        feb29 <- epw_data[datetime >= ymd("2020-03-01") & datetime < ymd("2020-03-02")]
        set(feb29, NULL, "datetime", feb29$datetime - days(1))
        set(feb29, NULL, "day", 29L)
        epw_data <- rbindlist(list(epw_data, feb29))
        setorder(epw_data, datetime)
    }

    # replace weather data
    epw$set(data = epw_data, realyear = realyear,
        start_day_of_week = weekdays(epw_data$datetime[1])
    )

    # have to modify in the raw EPW data as eplusr will check the consistency
    # between the header and weather data
    val <- get_idf_value(
        get_priv_env(epw)$idd_env(),
        get_priv_env(epw)$idf_env(),
        eplusr:::EPW_CLASS$holiday,
        field = "LeapYear Observed"
    )
    val[, value_chr := ifelse(leapyear_in_header, "Yes", "No")]
    get_priv_env(epw)$idf_env()$value[val, on = "value_id", value_chr := i.value_chr]

    epw
}

# ver
ver <- c(8.9, 9.0, 9.1)

# combine all cases for IDF
comb_idf <- CJ(ver = ver, realyear = c(TRUE, FALSE), year = c(NA, 2020, 2021), day_of_week = c(NA, "Wednesday", "Friday"))
# actual year support added in v9.0
comb_idf <- comb_idf[!(ver <= 8.9 & realyear == TRUE)]
# only test the match of day of week when year is given
comb_idf <- comb_idf[!(is.na(year) & is.na(day_of_week))]
comb_idf[, index := .I]
setnames(comb_idf, sprintf("idf_%s", names(comb_idf)))

# create IDFs
path_idf <- pmap_chr(comb_idf, ~{
    idf <- create_idf(ver = ..1, realyear = ..2, year = ..3, day_of_week = ..4)
    nm <- sprintf("ver(%s)-realyear(%s)-year(%s)-day_of_week(%s).idf", ..1, ..2, ..3, ..4)
    idf$save(file.path(tempdir(), "idf", nm), overwrite = TRUE)
    idf$path()
})

# combine all cases for EPW
comb_epw <- CJ(leapyear = c(TRUE, FALSE), leapyear_in_header = c(TRUE, FALSE), realyear = c(TRUE, FALSE))
comb_epw[, index := .I]
setnames(comb_epw, sprintf("epw_%s", names(comb_epw)))

path_epw <- pmap_chr(comb_epw, ~{
    epw <- create_epw(ver = ver[1], leapyear = ..1, leapyear_in_header = ..2, realyear = ..3)
    nm <- sprintf("leapyear(%s)-leapyear_header(%s)-realyear(%s).epw", ..1, ..2, ..3)
    epw$save(file.path(tempdir(), "epw", nm), overwrite = TRUE)
    epw$path()
})

# combine all cases of IDF and EPW
comb <- CJ(idf_index = comb_idf$idf_index, epw_index = comb_epw$epw_index)
comb[, index := .I]
comb <- comb[comb_idf, on = "idf_index"][comb_epw, on = "epw_index"]

# run all cases
grp <- group_job(path_idf[comb$idf_index], path_epw[comb$epw_index])
grp$run(file.path(tempdir(), "sim", comb$index), separate = FALSE)

# extract all simulation status
comb[, sim_status := grp$status()$job_status$status]

# extract results for Feb 28 and Feb 29
data <- grp$report_data(
    comb[sim_status == "completed", index],
    key_value = "Environment", month = 2, day = c(28, 29), all = TRUE
)
# check whether Feb 29th data is reported
data_count <- data[, .(datetime, month, day), by = "index"][, .N, by = "index"]
set(comb, data_count$index, "feb29", data_count$N == 48L)

# check the number of hours in the SQL 'Time' table
time <- grp$read_table(comb[sim_status == "completed", index], "Time")
time_count <- time[interval == 60L, .N, by = "index"]
set(comb, time_count$index, "hours", time_count$N)

# extract warnings and errors related to EPW
errs <- grp$errors()
msg <- map2_df(errs, comb$index, ~{
    # get rid of warning about location mismatch between IDF and EPW
    err <- .x[!J(.x[grepl("Weather file location", message), index]), on = "index"]

    # concatenate messages in order to save them in a csv
    msg <- err[, list(message = paste0(message, collapse = " ")), by = c("index", "level")]
    msg <- msg[, by = "level", list(message = paste0(sprintf("[%i]: %s", seq_len(.N), message), collapse = "; "))]

    # add simulation index
    setDT(msg[, index := .y])
})[, level := tolower(level)] %>% dcast(index ~ level, value.var = "message")
comb <- msg[comb, on = "index"]
setcolorder(comb, c(setdiff(names(comb), c("warning", "severe", "fatal")), c("warning", "severe", "fatal")))

# save results
fwrite(comb, "eplus_amy_test.csv")

sessionInfo()
# R version 4.0.4 (2021-02-15)
# Platform: x86_64-w64-mingw32/x64 (64-bit)
# Running under: Windows 10 x64 (build 19042)
#
# Matrix products: default
#
# locale:
# [1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252
# [3] LC_MONETARY=English_United States.1252 LC_NUMERIC=C
# [5] LC_TIME=C
#
# attached base packages:
# [1] stats     graphics  grDevices utils     datasets  methods   base
#
# other attached packages:
# [1] purrr_0.3.4        lubridate_1.7.10   data.table_1.14.0  eplusr_0.14.1.9004
#
# loaded via a namespace (and not attached):
#  [1] Rcpp_1.0.6        compiler_4.0.4    pillar_1.5.0      prettyunits_1.1.1
#  [5] tools_4.0.4       progress_1.2.2    bit_4.0.4         RSQLite_2.2.4
#  [9] memoise_2.0.0     lifecycle_1.0.0   tibble_3.0.6      checkmate_2.0.0
# [13] pkgconfig_2.0.3   rlang_0.4.10      DBI_1.1.1         cli_2.3.1
# [17] rstudioapi_0.13   fastmap_1.1.0     dplyr_1.0.4       generics_0.1.0
# [21] vctrs_0.3.6       hms_1.0.0         tidyselect_1.1.0  bit64_4.0.5
# [25] glue_1.4.2        R6_2.5.0          processx_3.4.5    fansi_0.4.2
# [29] callr_3.5.1       blob_1.2.1        magrittr_2.0.1    backports_1.2.1
# [33] ps_1.6.0          ellipsis_0.3.1    units_0.7-0       assertthat_0.2.1
# [37] utf8_1.1.4        stringi_1.5.3     cachem_1.0.4      crayon_1.4.1