tests/testthat/test-netcdf.R

In hongyuanjia/epwshiftr: Create Future 'EnergyPlus' Weather Files using 'CMIP6' Data

test_that("get_nc_meta()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20590101-20591231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_type(meta <- get_nc_meta(path), "list")
        expect_named(meta,
            c("mip_era", "activity_id", "institution_id", "source_id",
              "experiment_id", "variant_label", "table_id", "grid_label",
              "nominal_resolution", "variable_id", "tracking_id",
              "standard_name", "units", "time_units", "time_calendar"
            )
        )

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_meta(con), meta, ignore_attr = TRUE)
        RNetCDF::close.nc(con)
    }
})

test_that("get_nc_atts()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_s3_class(atts <- get_nc_atts(path), "data.table")
        expect_named(atts, c("id", "variable", "attribute", "value"))
        expect_true(all(unique(atts$variable) %in% c("height", "lat", "lon", "NC_GLOBAL", "tas", "time")))
        expect_identical(atts[variable == "NC_GLOBAL", unique(id)], -1L)

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_atts(con), atts, ignore_attr = TRUE)
        RNetCDF::close.nc(con)
    }
})

test_that("get_nc_vars()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_s3_class(vars <- get_nc_vars(path), "data.table")
        expect_named(vars, c("id", "name", "type", "ndims", "natts"))

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_vars(con), vars, ignore_attr = TRUE)
        RNetCDF::close.nc(con)
    }
})

test_that("get_nc_dims()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_s3_class(dims <- get_nc_dims(path), "data.table")
        expect_named(dims, c("id", "name", "length", "unlim"))

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_dims(con), dims, ignore_attr = TRUE)
        RNetCDF::close.nc(con)
    }
})

test_that("get_nc_axes()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_s3_class(axes <- get_nc_axes(path), "data.table")
        expect_named(axes, c("axis", "variable", "dimension"))

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_axes(con), axes, ignore_attr = TRUE)
        RNetCDF::close.nc(con)
    }
})

test_that("get_nc_time()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_s3_class(time <- get_nc_time(path), "POSIXct")
        expect_equal(length(time), 366)

        expect_s3_class(time <- get_nc_time(path, range = TRUE), "POSIXct")
        expect_equal(length(time), 2L)

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_time(con, range = TRUE), time, ignore_attr = TRUE)
        RNetCDF::close.nc(con)

        # can stop if invalid calendar found
        mockery::stub(get_nc_time, "get_nc_atts",
            data.table(
                variable = "time",
                attribute = "calendar",
                value = list("invalid")
            )
        )
        expect_error(get_nc_time(path), "Unsupported calendar")

        # can work with only date specification
        mockery::stub(get_nc_time, "get_nc_atts",
            data.table(
                variable = c("time", "time"),
                attribute = c("calendar", "units"),
                value = list("standard", "days since 1850-01-01")
            )
        )
        expect_s3_class(get_nc_time(path, range = TRUE), "POSIXct")

        # can warning if months resolution found
        mockery::stub(get_nc_time, "get_nc_atts",
            data.table(
                variable = c("time", "time"),
                attribute = c("calendar", "units"),
                value = list("standard", "months since 1850-01")
            )
        )
        expect_warning(get_nc_time(path, range = TRUE), "Month time resolution")

        # can stop if invlaid time unit string
        mockery::stub(get_nc_time, "get_nc_atts",
            data.table(
                variable = c("time", "time"),
                attribute = c("calendar", "units"),
                value = list("standard", "months 1850-01")
            )
        )
        expect_error(get_nc_time(path, range = TRUE), "Invalid time units")
    }
})

test_that("match_nc_time()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        expect_type(matched <- match_nc_time(path, 2060), "list")
        expect_equal(names(matched), c("datetime", "which"))
        expect_equal(length(matched$datetime), 1L)
        expect_equal(length(matched$datetime[[1L]]), 366L)
        expect_equal(length(matched$which), 1L)
        expect_equal(matched$which[[1L]], 1:366)

        expect_type(matched <- match_nc_time(path), "list")
        expect_equal(names(matched), c("datetime", "which"))
        expect_equal(length(matched$datetime), 1L)
        expect_equal(length(matched$datetime[[1L]]), 366L)
        expect_equal(length(matched$which), 1L)
        expect_equal(matched$which[[1L]], 1:366)

        expect_type(matched <- match_nc_time(path, 2059), "list")
        expect_equal(length(matched$datetime), 1L)
        expect_equal(length(matched$datetime[[1L]]), 0L)
        expect_equal(length(matched$which), 1L)
        expect_equal(length(matched$which[[1L]]), 0L)

        con <- RNetCDF::open.nc(path)
        expect_equal(match_nc_time(con, 2059), matched)
        RNetCDF::close.nc(con)

        expect_type(matched <- match_nc_time(path, 2059:2061), "list")
        expect_equal(length(matched), 2L)
        expect_equal(length(matched$datetime), 3L)
        expect_equal(length(matched$which), 3L)
        expect_equal(length(matched$datetime[[1]]), 0L)
        expect_equal(length(matched$datetime[[2]]), 366L)
        expect_equal(length(matched$datetime[[3]]), 0L)
        expect_equal(length(matched$which[[1]]), 0L)
        expect_equal(length(matched$which[[2]]), 366L)
        expect_equal(length(matched$which[[3]]), 0L)
    }
})

test_that("summary_database()", {
    skip_on_cran()

    cache <- get_cache()
    file_2059 <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20590101-20591231.nc"
    file_2060 <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    file_2061 <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20610101-20611231.nc"
    paths <- file.path(cache, c(file_2059, file_2060, file_2061))
    names(paths) <- c("2059", "2060", "2061")

    options(epwshiftr.dir = tempdir())
    index <- file.path(tempdir(), "cmip6_index.csv")

    if (all(file.exists(paths)) && file.exists(index)) {
        expect_s3_class(db <- summary_database(cache), "data.table")
        expect_true(all(!is.na(load_cmip6_index()$file_path)))
        expect_true(all(!is.na(load_cmip6_index()$file_realsize)))
        expect_true(all(!is.na(load_cmip6_index()$file_mtime)))
        expect_true(all(!is.na(load_cmip6_index()$time_units)))
        expect_true(all(!is.na(load_cmip6_index()$time_calendar)))
        expect_s3_class(not <- attr(db, "not_matched"), "data.table")
        expect_equal(names(not),
            c("mip_era", "activity_id", "institution_id", "source_id", "experiment_id",
              "variant_label", "table_id", "grid_label", "nominal_resolution",
              "variable_id", "tracking_id", "standard_name", "units", "time_units",
              "time_calendar", "datetime_start", "datetime_end", "file_path",
              "file_realsize", "file_mtime"
            )
        )
        expect_s3_class(mis <- attr(db, "not_found"), "data.table")
        expect_equal(names(mis),
            c("file_id", "dataset_id", "mip_era", "activity_drs",
              "institution_id", "source_id", "experiment_id", "member_id",
              "table_id", "frequency", "grid_label", "version",
              "nominal_resolution", "variable_id", "variable_long_name",
              "variable_units", "datetime_start", "datetime_end", "file_size",
              "data_node", "file_url", "dataset_pid", "tracking_id"
            )
        )
        expect_equal(nrow(mis), 0L)
        expect_equal(as.integer(db$dl_percent), 100L)
        expect_equal(as.integer(db$dl_num), 3L)

        # 'append' can still work for initial summary
        idx <- load_cmip6_index()
        cols <- c("file_path", "file_realsize", "file_mtime", "time_units", "time_calendar")
        if (any(cols %in% names(idx))) set(idx, NULL, cols[cols %in% names(idx)], NULL)
        set_cmip6_index(idx)
        expect_s3_class(db <- summary_database(cache, append = TRUE), "data.table")
        load_cmip6_index()
        expect_equal(as.integer(db$dl_percent), 100L)
        expect_equal(as.integer(db$dl_num), 3L)

        # can append to existing database results
        idx <- load_cmip6_index()
        idx[1L, `:=`(file_path = "ori.nc", file_realsize = 1)]
        idx[2L, `:=`(file_path = NA, file_realsize = 1)]
        set_cmip6_index(idx)
        expect_warning(db <- summary_database(cache, append = TRUE))
        expect_s3_class(db, "data.table")
        idx <- load_cmip6_index()
        expect_equal(idx$file_path[1], "ori.nc")
        expect_equal(idx$file_realsize[1], 1.0)
        expect_true(!is.na(idx$file_path[2]))
        expect_equal(as.integer(db$dl_percent), 100L)
        expect_equal(as.integer(db$dl_num), 3L)
        attr(db, "not_found")

        # can give warnings if missing outputs found
        nc_2059 <- tempfile(fileext = ".nc")
        file.rename(paths["2059"], nc_2059)
        expect_warning(db <- summary_database(cache))
        idx <- load_cmip6_index()
        file.rename(nc_2059, paths["2059"])
        expect_true(is.na(idx$file_path[1]))
        expect_equal(as.integer(db$dl_percent), 66L)
        expect_equal(as.integer(db$dl_num), 2L)

        # can overwrite output metadata if the original file path does not
        # exists
        summary_database(cache)
        idx <- load_cmip6_index()
        idx[1L, `:=`(file_path = "ori.nc")]
        idx[2L, `:=`(file_path = NA)]
        set_cmip6_index(idx)
        suppressWarnings(expect_warning(db <- summary_database(cache, append = TRUE, miss = "overwrite")))

        # can work if no NetCDF files were found
        expect_s3_class(db <- summary_database(tempdir()), "data.table")
        expect_equal(names(db),
            c("activity_drs", "experiment_id", "member_id", "table_id",
              "variable_id", "source_id", "nominal_resolution",
              "datetime_start", "datetime_end", "file_num", "file_size",
              "dl_num", "dl_percent", "dl_size"
            )
        )
        expect_equal(db$dl_num, 0L)
        expect_equal(db$dl_percent, units::set_units(0L, "%"))
        expect_equal(attr(db, "not_matched"), data.table())
        idx <- load_cmip6_index()
        set(idx, NULL, 25:28, NULL)
        set_cmip6_index(idx, TRUE)
        expect_s3_class(db <- summary_database(tempdir(), append = TRUE), "data.table")
        expect_equal(names(db),
            c("activity_drs", "experiment_id", "member_id", "table_id",
              "variable_id", "source_id", "nominal_resolution",
              "datetime_start", "datetime_end", "file_num", "file_size",
              "dl_num", "dl_percent", "dl_size"
            )
        )
        expect_equal(db$dl_num, 0L)
        expect_equal(db$dl_percent, units::set_units(0L, "%"))
        expect_equal(attr(db, "not_matched"), data.table())

        # can update local cmip6_index.csv
        expect_s3_class(db <- summary_database(tempdir(), update = TRUE), "data.table")
        expect_equal(nm <- names(load_cmip6_index(TRUE)),
            c("file_id", "dataset_id", "mip_era", "activity_drs", "institution_id",
              "source_id", "experiment_id", "member_id", "table_id", "frequency",
              "grid_label", "version", "nominal_resolution", "variable_id",
              "variable_long_name", "variable_units", "datetime_start", "datetime_end",
              "file_size", "data_node", "file_url", "dataset_pid", "tracking_id",
              "file_path", "file_realsize", "file_mtime", "time_units", "time_calendar"
            )
        )
        expect_true(all(is.na(load_cmip6_index()$file_path)))
        expect_true(all(is.na(load_cmip6_index()$file_realsize)))
        expect_true(all(is.na(load_cmip6_index()$file_mtime)))
        expect_true(all(is.na(load_cmip6_index()$time_units)))
        expect_true(all(is.na(load_cmip6_index()$time_calendar)))

        # can give warnings if duplicates found
        file.copy(paths["2059"], file.path(cache, "dup_2059.nc"), copy.date = TRUE)
        suppressWarnings(expect_warning(summary_database(cache)))
        suppressWarnings(expect_warning(summary_database(cache, mult = "latest")))
        unlink(file.path(cache, "dup_2059.nc"), force = TRUE)
    }
})

test_that("get_nc_data()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)

    if (file.exists(path)) {
        loc <- eplusr:::WEATHER_DB[grepl("Singapore", title)]
        coord <- match_nc_coord(path, loc$latitude, loc$longitude, max_num = 1L)
        expect_s3_class(d <- get_nc_data(path, coord, years = 2060), "data.table")
        expect_equal(names(d),
            c("index", "activity_drs", "institution_id", "source_id", "experiment_id",
              "member_id", "table_id", "lon", "lat", "dist", "datetime", "variable",
              "description", "units", "value"
            )
        )
        expect_s3_class(d$value, "units")

        expect_s3_class(d <- get_nc_data(path, coord, years = 2000), "data.table")
        expect_equal(names(d),
            c("index", "activity_drs", "institution_id", "source_id", "experiment_id",
              "member_id", "table_id", "lon", "lat", "dist", "datetime", "variable",
              "description", "units", "value"
            )
        )
        expect_equal(nrow(d), 0L)
        expect_type(d$value, "double")

        con <- RNetCDF::open.nc(path)
        expect_equal(get_nc_data(con, coord, years = 2000), d, ignore_attr = TRUE)
        RNetCDF::close.nc(con)
    }
})

test_that("extract_data()", {
    skip_on_cran()

    cache <- get_cache()
    file <- "tas_day_EC-Earth3_ssp585_r1i1p1f1_gr_20600101-20601231.nc"
    path <- file.path(cache, file)
    epw <- file.path(cache, "SGP_Singapore.486980_IWEC.epw")

    if (file.exists(path) && file.exists(epw)) {
        options(epwshiftr.dir = tempdir())
        summary_database(cache)
        idx <- load_cmip6_index()
        set_cmip6_index(idx[2L])
        coord <- match_coord(epw)
        set_cmip6_index(idx)

        expect_s3_class(d <- extract_data(coord, years = 2060), "epw_cmip6_data")
        expect_equal(names(d), c("epw", "meta", "data"))
        expect_s3_class(d$epw, "Epw")
        expect_equal(d$meta, coord$meta)
        expect_s3_class(d$data, "data.table")
        expect_named(d$data,
            c("activity_drs", "institution_id", "source_id", "experiment_id",
              "member_id", "table_id", "lon", "lat", "dist", "datetime", "variable",
              "description", "units", "value"
            )
        )
        expect_identical(nrow(d$data), 2196L)

        expect_s3_class(d1 <- extract_data(coord, out_dir = cache), "epw_cmip6_data")
        expect_identical(d1$data, data.table())
        expect_true(file.exists(file.path(cache, "data.fst")))
        unlink(file.path(cache, "data.fst"))

        expect_s3_class(
            d2 <- extract_data(coord, out_dir = cache,
                by = c("source", "experiment", "variable"),
                years = 2060L
            ),
            "epw_cmip6_data"
        )
        expect_equal(d2$data, data.table())
        expect_true(file.exists(file.path(cache, "EC-Earth3.ssp585.tas.fst")))
        unlink(file.path(cache, "EC-Earth3.ssp585.tas.fst"))

        expect_s3_class(
            d3 <- extract_data(coord, out_dir = cache,
                by = c("source", "experiment", "variable"), keep = TRUE,
                years = 2060L
            ),
            "epw_cmip6_data"
        )
        expect_equal(d3$data, d$data)
        expect_true(file.exists(file.path(cache, "EC-Earth3.ssp585.tas.fst")))
    }
})