## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.align = "center", warning = FALSE, message = FALSE, eval = FALSE ) ## ----load_package------------------------------------------------------------- # library(clim4health) ## ----input_functions_table, echo = FALSE, eval = TRUE------------------------- knitr::kable( data.frame( `Forecast Start Date` = c("July 1994", "July 1995", "...", "July 2016"), `Lead Time 1` = c("July 1994", "July 1995", "...", "July 2016"), `Lead Time 2` = c("August 1994", "August 1995", "...", "August 2016"), `Lead Time 3` = c("September 1994", "September 1995", "...", "September 2016"), check.names = FALSE ), format = "markdown", caption = "Table 1: Hindcast structure, for forecasts issued in July. Note that Lead Time 1 corresponds to the same month as the forecast initialisation date (the forecast is issued at the beginning of the month, and provides information for that same month)." ) ## ----Load forecast data------------------------------------------------------- # fcst_path <- system.file("extdata/forecast/", package = "clim4health") # fcst_path <- paste0(fcst_path, "/") # # # Load the forecast data # forecast <- c4h_load(fcst_path, # variable = "t2m", # year = 2025, # month = 1, # leadtime_month = "all", # ext = "nc") # # forecast <- c4h_convert_units(forecast, to = "celsius") ## ----Load hindcast data------------------------------------------------------- # hindcast_path <- system.file("extdata/hindcast/", package = "clim4health") # hindcast_path <- paste0(hindcast_path, "/") # # # Load the hindcast data # hindcast <- c4h_load(hindcast_path, # variable = "t2m", # year = 2010:2012, # month = 1, # leadtime_month = 1:3, # ext = "nc") # # hindcast <- c4h_convert_units(hindcast, to = "celsius") ## ----Load reanalysis data----------------------------------------------------- # reanalysis_path <- system.file("extdata/reanalysis/", package = "clim4health") # reanalysis_path <- paste0(reanalysis_path, "/") # # # Load the reanalysis data # reanalysis <- c4h_load(reanalysis_path, # variable = "t2m", # year = 2010:2012, # month = 1, # leadtime_month = 1:3, # ext = "nc") # # reanalysis <- c4h_convert_units(reanalysis, to = "celsius") ## ----------------------------------------------------------------------------- # message("print forecast class") # class(forecast) # message("print dimensions of the stored data") # dim(forecast$data) # message("print the names of the list elements in forecast") # names(forecast) # message("print a summary of the data stored in forecast") # summary(forecast$data) # message("print extended information about the list elements in forecast") # str(forecast) ## ----------------------------------------------------------------------------- # print(forecast$attrs$Dates) # # print(dim(forecast$attrs$Dates)) # # print(forecast$attrs$Dates[, 1]) # to obtain the forecast start dates # print(forecast$coords$sdate) # start dates are also stored as a coordinate ## ----------------------------------------------------------------------------- # c4h_plot(forecast, time = 1:3, ensemble = 1:3) ## ----structure---------------------------------------------------------------- # print(forecast) ## ----load_csv----------------------------------------------------------------- # csv_path <- system.file("extdata/stations/", package = "clim4health") # data_in <- read.csv(paste0(csv_path, "/temp_vallecauca.csv")) ## ----explore_csv-------------------------------------------------------------- # print(head(data_in)) ## ----extract_coords----------------------------------------------------------- # # these will be used to match values in the data_in object # locations_long <- data_in$station_code # lats_long <- data_in$lat # lons_long <- data_in$lon # # # these will be our unique coordinates for the s2dv_cube # locations <- unique(locations_long) # lats <- unique(lats_long[match(locations, locations_long)]) # lons <- unique(lons_long[match(locations, locations_long)]) # # # extract dates in a time series format (sdate = 1, time = length of dates) # dates_long <- data_in$date # dates <- unique(dates_long) # # we can choose specific date ranges if desired # dates <- dates[which(lubridate::month(dates) %in% 1:2)] # # # set up final coordinates # ensemble <- 1 # var <- c("temp_mean", "temp_min", "temp_max") ## ----reshape_data------------------------------------------------------------- # # create an empty array with the correct dimensions # data_array <- array(NA, dim = c(dataset = 1, # var = length(var), # sdate = 1, # time = length(dates), # ensemble = length(ensemble), # location = length(locations))) # # # fill the array with the values from the data frame, matching the coordinates # for (i in seq_along(var)) { # var_name <- var[i] # for (j in seq_along(locations)) { # location_name <- locations[j] # for (k in seq_along(dates)) { # date_value <- dates[k] # value <- data_in[locations_long == location_name & # dates_long == date_value, var_name] # # only fill the array if there is a value in the data frame # if (length(value) != 0) { # data_array[1, i, 1, k, 1, j] <- value # } # } # } # } ## ----add_dims_coords_attrs---------------------------------------------------- # new_dims <- dim(data_array) # # new_coords <- list(dataset = 1, # index # var = var, # variable names # sdate = 1, # index # time = seq_along(dates), # index # ensemble = ensemble, # index # location = seq_along(locations)) # index # # new_attrs <- list( # Dates = array(dates, dim = c(sdate = 1, time = length(dates))), # Variable = list(varName = var, # metadata = list(variable = var, # units = c(temp_mean = "degrees C", # temp_min = "degrees C", # temp_max = "degrees C"), # source_files = "inst/extdata/stations/temp_vallecauca.csv")), # source_files = "inst/extdata/stations/temp_vallecauca.csv") # # # in the case of station data, we also need to add the latitude and longitude coordinates to the attributes # new_attrs$location <- list(longitude = lons, # latitude = lats) # # # we also need to ensure the Dates attribute is a POSIXct object # new_attrs$Dates <- as.POSIXct(new_attrs$Dates) # dim(new_attrs$Dates) <- c(sdate = 1, time = length(dates)) ## ----create_s2dv_cube--------------------------------------------------------- # # method 1: manually create the list and set its class # s2dv_cube_manual <- list(data = data_array, # dims = new_dims, # coords = new_coords, # attrs = new_attrs) # class(s2dv_cube_manual) <- "s2dv_cube" # # # method 2: use the function s2dv_cube() from CSTools # s2dv_cube_function <- CSTools::s2dv_cube(data_array, # coords = new_coords, # varName = var, # metadata = new_attrs$Variable$metadata, # Dates = new_attrs$Dates, # source_files = new_attrs$source_files)