upgrade.R

#' Upgrade a GeoPressureTemplate directory from v3.3 to v3.4
#'
#' This function processes all interim Rdata files, upgrading the `param` structure within each
#' file if it exists. We also upgrade `config.yml`. The function renames the original files to
#' indicate that they have been processed, and saves the updated versions with the same original
#' filename.
#'
#' @return NULL
#' @export
upgrade_geopressuretemplate <- function() {
  # Upgrade the configuration file if it exists
  upgrade_config()

  # Directory containing Rdata files
  data_dir <- "data/interim/"
  files <- list.files(data_dir, pattern = "\\.RData$", full.names = TRUE)

  # Process each Rdata file
  for (file in files) {
    saved_variable <- load(file) # Load the Rdata file

    changes <- FALSE # Flag to track if any changes were made

    # Upgrade `param` if it exists
    if ("param" %in% saved_variable) {
      param <- upgrade_param(param) # Convert param structure
      changes <- TRUE
    }

    # Upgrade `tag` if it exists
    if ("tag" %in% saved_variable) {
      tag$param <- upgrade_param(tag$param) # Convert param structure
      changes <- TRUE
    }

    # Upgrade `graph` if it exists
    if ("graph" %in% saved_variable) {
      graph$param <- upgrade_param(graph$param) # Convert param structure
      changes <- TRUE
    }

    # If changes were made, rename and save the updated file
    if (changes) {
      file.rename(file, sub("\\.Rdata$", "_old.Rdata", file))
      save(list = saved_variable, file = file)
      
    }
  }
}

#' Upgrade the param structure to the new format.
#'
#' This function takes a `param` object and reformats it to a new structure
#' suitable for use with the updated geopressure templates.
#'
#' @param param A list containing the old param structure.
#' @return A list containing the upgraded param structure.
#' @export
upgrade_param <- function(param) {
  return(list(
    id = param$id,
    tag_create = list(
      manufacturer = param$manufacturer,
      crop_start = param$crop_start,
      crop_end = param$crop_end,
      directory = param$sensor_file_directory,
      pressure_file = param$pressure_file,
      light_file = param$light_file,
      acceleration_file = param$acceleration_file,
      temperature_file = param$temperature_file,
      airtemperature_file = param$airtemperature_file,
      magnetic_file = param$magnetic_file,
      assert_pressure = TRUE # Assuming this was not in the old structure
    ),
    tag_label = list(
      file = param$label_file
    ),
    tag_set_map = list(
      extent = param$extent,
      scale = param$scale,
      known = param$known,
      include_stap_id = param$include_stap_id,
      include_min_duration = param$include_min_duration
    ),
    geopressure_map = list(
      max_sample = param$max_sample,
      margin = param$margin,
      sd = param$sd,
      thr_mask = param$thr_mask,
      log_linear_pooling_weight = param$log_linear_pooling_weight,
      compute_known = param$compute_known
    ),
    twilight_create = list(
      twl_thr = param$twl_thr,
      twl_offset = param$twl_offset,
      transform_light = param$transform_light
    ),
    twilight_label_read = list(
      file = param$twilight_file
    ),
    geolight_map = list(
      twl_calib_adjust = param$twl_calib_adjust,
      twl_llp = param$twl_llp,
      compute_known = FALSE # Assuming this was not in the old structure
    ),
    graph_create = list(
      thr_likelihood = param$thr_likelihood,
      thr_gs = param$thr_gs,
      likelihood = param$likelihood
    ),
    graph_set_movement = list(
      type = param$movement$type,
      method = param$movement$method,
      shape = param$movement$shape,
      scale = param$movement$scale,
      location = param$movement$location,
      power2prob = param$movement$power2prob,
      low_speed_fix = param$movement$low_speed_fix
    ),
    bird = list(
      mass = param$movement$mass,
      wing_span = param$movement$wing_span,
      wing_aspect = param$movement$wing_aspect,
      wing_area = param$movement$wing_area,
      body_frontal_area = param$movement$body_frontal_area
    ),
    graph_add_wind = list(
      rounding_interval = param$rounding_interval,
      interp_spatial_linear = param$interp_spatial_linear,
      thr_as = param$thr_as,
      file = param$wind_file
    ),
    GeoPressureR_version = utils::packageVersion("GeoPressureR")
  ))
}

#' Upgrade the configuration file.
#'
#' This function reads an existing `config.yml` file, upgrades its structure,
#' and saves the updated version. If the `config.yml` file does not exist,
#' it raises an error.
#'
#' @return NULL
#' @export
upgrade_config <- function() {
  if (!file.exists("config.yml")) {
    stop("config.yml not found")
  }

  config <- yaml::read_yaml("config.yml")

  # Upgrade each section of the configuration
  for (i in seq_len(length(config))) {
    tmp <- upgrade_param(config[[i]])
    tmp$GeoPressureR_version <- NULL # Remove version info
    tmp <- clean_list(tmp) # Clean the list structure
    config[[i]] <- clean_list(tmp) # Update the config with the cleaned list
  }

  file.rename("config.yml", "config_old.yml") # Rename old config file
  writeLines(yaml::as.yaml(config), "config.yml") # Write the new config
}

#' Clean a list by removing NULL values and empty lists.
#'
#' This function filters a list to remove any NULL values or empty lists,
#' recursively cleaning all nested lists.
#'
#' @param lst A list to be cleaned.
#' @return A cleaned list with NULLs and empty lists removed.
#' @export
clean_list <- function(lst) {
  lst <- Filter(function(x) !is.null(x) && !(is.list(x) && length(x) == 0), lst)
  lapply(lst, function(x) if (is.list(x)) clean_list(x) else x)
}