Full workflow from `param`

[Rafnuss]

Possible function to run the entire workflow from a simple param list

#' @export
geopressure <- function(param,
                        save_tag = TRUE,
                        save_graph = TRUE,
                        save_pressurepath = FALSE,
                        export_product = c("most_likely", "marginal", "simulation"),
                        quiet = TRUE) {
  # Check version
  param$GeoPressureR_version

  # Check is param is complete?
  # if (is.null(param$extent)){
  #   cli::cli_abort(c(
  #     x="Both {.var param} and {.var id} and/or {.var extent} have not been provided.",
  #     ">" = "Either {.var param} or {.var id} and {.var extent} are required"
  #   ))
  # }

  cli::cli_h1("Creating and label `tag`")

  id <- param$id # required for call2eval(param$sensor_file_directory)
  tag <- tag_create(
    id = id,
    directory = call2eval(param$sensor_file_directory),
    pressure_file = call2eval(param$pressure_file),
    light_file = call2eval(param$light_file),
    acceleration_file = call2eval(param$acceleration_file),
    crop_start = param$crop_start,
    crop_end = param$crop_end,
    quiet = quiet
  )

  tag <- tag_label(tag,
    file = call2eval(param$label_file),
    quiet = quiet
  )

  tag <- tag_setmap(tag,
    extent = param$extent,
    scale = param$scale,
    known = param$known,
    include_stap_id = call2eval(param$include_stap_id),
    include_min_duration = param$include_min_duration
  )

  cli::cli_h1("Computing light map")
  # Geolight Map
  result <- try({
    if ("light" %in% names(tag)) {
      twilight_create(tag,
        twl_thr = param$twl_thr,
        twl_offset = param$twl_offset
      ) |>
        twilight_label_read(
          file = call2eval(param$twilight_file)
        ) |>
        geolight_map(
          twl_calib_adjust = param$twl_calib_adjust,
          twl_llp = call2eval(param$twl_llp),
          compute_known = param$compute_known
        )
    } else {
      tag
    }
  })

  if (inherits(result, "try-error")) {
    cli::cli_inform(c(">" = "An error occurred during the computation of of the light map\f"))
    cli::cli_inform(c("i" = "Returning {.var tag} before the error for you to debug\f"))
    return(tag)
  } else {
    tag <- result
  }

  # Geopressure Map
  cli::cli_h1("Computing pressure map")
  result <- try({
    geopressure_map(tag,
      max_sample = param$max_sample,
      margin = param$margin,
      sd = param$sd,
      thr_mask = param$thr_mask,
      log_linear_pooling_weight = call2eval(param$log_linear_pooling_weight),
      compute_known = param$compute_known
    )
  })

  if (inherits(result, "try-error")) {
    cli::cli_inform(c(">" = "An error occurred during the computation of the pressure map {.fun geopressure_map}\f"))
    cli::cli_inform(c("i" = "Returning {.var tag} before the error for you to debug\f"))
    return(tag)
  } else {
    tag <- result
  }

  # Export tag
  if (save_tag) {
    save_tag(tag)
  }

  # Create Graph
  cli::cli_h1("Creating graph")
  result <- try({
    graph <- graph_create(tag,
      thr_likelihood = param$thr_likelihood,
      thr_gs = param$thr_gs
    )
  })
  if (inherits(result, "try-error")) {
    cli::cli_inform(c(">" = "An error occurred during the creation of the graph\f"))
    cli::cli_inform(c("i" = "Returning {.var tag} before the error for you to debug\f"))
    return(tag)
  } else {
    tag <- result
  }

  cli::cli_h1("Movement model")
  result <- try({
    if (FALSE) {
      graph <- graph_add_wind(graph, tag$pressure,
        thr_as = param$thr_as,
        file = call2eval(param$wind_file)
      )
    }
    graph <- graph_add_movement(graph,
      type = call2eval(param$type),
      method = call2eval(param$method),
      shape = param$shape,
      scale = param$scale,
      location = param$location,
      bird = param$bird,
      power2prob = call2eval(param$power2prob),
      low_speed_fix = param$low_speed_fix
    )
  })

  if (inherits(result, "try-error")) {
    cli::cli_inform(c(">" = "An error occurred when defining the movement model of the graph\f"))
    cli::cli_inform(c("i" = "Returning {.var graph} before the error for you to debug\f"))
    return(graph)
  } else {
    graph <- result
  }

  if (save_graph) {
    save_graph(graph)
  }

  cli::cli_h1("Creating products")

  if ("most_likely" %in% export_product) {
    most_likely <- graph_most_likely(graph)
    utils::write.csv(most_likely, glue::glue("data/processed/{param$id}/most_likely.csv"), row.names = FALSE)
  }

  if ("marginal" %in% export_product) {
    marginal <- graph_marginal(graph)
    terra::writeRaster(map2rast(marginal), glue::glue("data/processed/{param$id}/marginal.tif"), filetype = "GTiff", overwrite = TRUE)
  }

  if ("most_likely" %in% export_product) {
    simulation <- graph_simulation(graph, nj = param$nj)
    utils::write.csv(simulation, glue::glue("data/processed/{param$id}/simulation.csv"), row.names = FALSE)
  }
}

call2eval <- function(x) {
  if (is.call(x)) {
    eval.parent(x, n = 2)
  } else {
    x
  }
}

Can be run with

param <- param_create(
  id = "18LX",
  extent = c(-16, 23, 0, 50),
  known = data.frame(
    stap_id = 1,
    known_lon = 17.05,
    known_lat = 48.9
  ),
  default = TRUE
)

geopressure(param,
                 save_tag = F,
                 save_graph = F,
                 save_pressurepath = F,
                 export_product = c("most_likely", "marginal", "simulation"),
                 quiet = TRUE
)