feat: Parse results from JSON

R/PM_cov.R

@@ -54,10 +54,10 @@ PM_cov <- R6::R6Class(
     #' Creation of new `PM_cov` object is automatic and not generally necessary
     #' for the user to do.
     #' @param PMdata include `r template("PMdata")`.
-    #' @param path include `r template("path")`.
+    #' @param json A parsed JSON list from `result.json`, as read by [PM_parse].
     #' @param ... Not currently used.
-    initialize = function(PMdata = NULL, path = ".", ...) {
-      self$data <- private$make(PMdata, path)
+    initialize = function(PMdata = NULL, json = NULL, ...) {
+      self$data <- private$make(PMdata, json)
     },
     #' @description
     #' Stepwise linear regression of covariates and Bayesian posterior
@@ -94,29 +94,125 @@ PM_cov <- R6::R6Class(
     }
   ), # end public
   private = list(
-    make = function(data, path) {
-      if (file.exists(file.path(path, "posterior.csv"))) {
-        posts <- readr::read_csv(file = file.path( path, "posterior.csv"), show_col_types = FALSE)
-      } else if (inherits(data, "PM_cov") & !is.null(data$data)) { # file not there, and already PM_cov
+    make = function(data, json = NULL) {
+      # --- Obtain posterior data ---
+      if (!is.null(json) && !is.null(json$posterior)) {
+        par_names <- json$settings$parameters$parameters$name
+        # json$theta is already a matrix [nspp x npar]
+        theta_mat <- json$theta
+        colnames(theta_mat) <- par_names
+        theta <- tibble::as_tibble(theta_mat)
+        theta$prob <- json$w
+        # json$data$subjects is a data.frame with column $id
+        subject_ids <- json$data$subjects$id
+        # json$posterior is a matrix [nsubjects x nspp]
+        post_list <- lapply(seq_len(nrow(json$posterior)), function(i) {
+          probs <- json$posterior[i, ]
+          df <- theta[, par_names, drop = FALSE]
+          df$prob <- probs
+          df$id <- subject_ids[i]
+          df$point <- seq_len(length(probs))
+          df
+        })
+        posts <- dplyr::bind_rows(post_list) %>%
+          dplyr::relocate(id, point, dplyr::everything())
+      } else if (inherits(data, "PM_cov") & !is.null(data$data)) {
         class(data$data) <- c("PM_cov_data", "data.frame")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate covariate-posterior information.",
-          "i" = "{.file {file.path(path, 'posterior.csv')}} does not exist, and result does not have valid {.code PM_cov} object."
+          "i" = "No JSON posterior and no valid {.code PM_cov} object."
         ))
         return(NULL)
       }
 
-      if (file.exists(file.path(path, "covs.csv"))) {
-        covs <- readr::read_csv(file = file.path(path, "covs.csv"), show_col_types = FALSE)
-      } else if (inherits(data, "PM_cov")) { # file not there, and already PM_cov
+      # --- Obtain covariates data ---
+      if (!is.null(json) && !is.null(json$data$subjects)) {
+        subjects <- json$data$subjects
+        n_subj <- nrow(subjects)
+        cov_list <- vector("list", n_subj * 50L)
+        list_idx <- 0L
+
+        for (i in seq_len(n_subj)) {
+          subj_id <- subjects$id[i]
+          occ_df <- subjects$occasions[[i]]
+          n_occ <- nrow(occ_df)
+
+          for (j in seq_len(n_occ)) {
+            block <- occ_df$index[j]
+            covs_inner <- occ_df[["covariates"]][["covariates"]]
+            cov_names <- names(covs_inner)
+            if (length(cov_names) == 0) next
+
+            # Collect segments per covariate for this occasion
+            seg_list <- setNames(vector("list", length(cov_names)), cov_names)
+            all_from <- numeric(0)
+            for (cn in cov_names) {
+              segs <- covs_inner[[cn]][["segments"]][[j]]
+              seg_list[[cn]] <- segs
+              all_from <- c(all_from, segs[["from"]])
+            }
+            all_times <- sort(unique(all_from))
+
+            # Evaluate covariates at each unique segment start time
+            for (t_val in all_times) {
+              row_data <- list(id = subj_id, time = t_val, block = block)
+              for (cn in cov_names) {
+                segs <- seg_list[[cn]]
+                n_seg <- nrow(segs)
+                value <- NA_real_
+                for (k in seq_len(n_seg)) {
+                  seg_from <- segs[["from"]][k]
+                  seg_to <- segs[["to"]][k]
+                  in_seg <- (t_val >= seg_from) &&
+                    (is.na(seg_to) || t_val < seg_to)
+                  # Match at or beyond the last segment start
+                  if (!in_seg && k == n_seg && t_val >= seg_from) {
+                    in_seg <- TRUE
+                  }
+                  if (in_seg) {
+                    lin <- segs[["method"]][["Linear"]]
+                    cf <- segs[["method"]][["CarryForward"]]
+                    if (!is.null(lin) && !is.na(lin[["intercept"]][k])) {
+                      value <- lin[["intercept"]][k] +
+                        lin[["slope"]][k] * (t_val - seg_from)
+                    } else if (!is.null(cf) && !is.na(cf[["value"]][k])) {
+                      value <- cf[["value"]][k]
+                    }
+                    break
+                  }
+                }
+                row_data[[cn]] <- value
+              }
+              list_idx <- list_idx + 1L
+              cov_list[[list_idx]] <- tibble::as_tibble(row_data)
+            }
+          }
+        }
+
+        if (list_idx > 0L) {
+          covs <- dplyr::bind_rows(cov_list[seq_len(list_idx)])
+          # Deduplicate: keep one row per unique covariate combination
+          # within each subject/block, retaining the earliest time
+          covs <- covs %>%
+            dplyr::group_by(id, block) %>%
+            dplyr::distinct(
+              dplyr::across(dplyr::all_of(cov_names)),
+              .keep_all = TRUE
+            ) %>%
+            dplyr::ungroup()
+        } else {
+          cli::cli_warn(c("!" = "No covariates found in JSON data."))
+          return(NULL)
+        }
+      } else if (inherits(data, "PM_cov")) {
         class(data$data) <- c("PM_cov_data", "data.frame")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate covariate-posterior information.",
-          "i" = "{.file {file.path(path, 'covs.csv')}} does not exist, and result does not have valid {.code PM_cov} object."
+          "i" = "No covariate data and no valid {.code PM_cov} object."
         ))
         return(NULL)
       }

R/PM_cycle.R

@@ -55,11 +55,10 @@ PM_cycle <- R6::R6Class(
     #' Creation of new `PM_cycle` object is automatic and not generally necessary
     #' for the user to do.
     #' @param PMdata include `r template("PMdata")`.
-    #' @param path include `r template("path")`.
+    #' @param json A parsed JSON list from `result.json`, as read by [PM_parse].
     #' @param ... Not currently used.
-
-    initialize = function(PMdata = NULL, path = ".", ...) {
-      self$data <- private$make(PMdata, path )
+    initialize = function(PMdata = NULL, json = NULL, ...) {
+      self$data <- private$make(PMdata, json)
     },
     #' @description
     #' Plot method
@@ -119,59 +118,99 @@ PM_cycle <- R6::R6Class(
     }
   ), # end active
   private = list(
-    make = function(data, path) {
-      if (file.exists(file.path(path, "cycles.csv"))) {
-        raw <- readr::read_csv(file = file.path(path, "cycles.csv"), show_col_types = FALSE)
-        if (nrow(raw)==0){ # posterior 
+    make = function(data, json = NULL) {
+      # --- Obtain cycles data ---
+      if (!is.null(json) && !is.null(json$cyclelog)) {
+        cycles_raw <- json$cyclelog$cycles
+        # cycles_raw is a data.frame with columns: cycle, objf, error_models, theta, nspp, delta_objf, status
+        raw <- tibble::tibble(
+          cycle = cycles_raw$cycle,
+          neg2ll = -2 * cycles_raw$objf,
+          nspp = cycles_raw$nspp,
+          delta_objf = cycles_raw$delta_objf,
+          status = sapply(cycles_raw$status, function(s) {
+            if (is.list(s)) names(s)[1] else as.character(s)
+          })
+        )
+        # Extract gamlam values from error_models
+        # cycles_raw$error_models is a data.frame with column $models (list column)
+        gamlam_vals <- sapply(cycles_raw$error_models$models, function(models) {
+          sapply(models, function(m) {
+            if (is.list(m) && !is.null(names(m))) {
+              # m is e.g. list(Additive = list(lambda = ..., poly = ...))
+              model_type <- names(m)[1]
+              lam <- m[[model_type]]$lambda
+              if (is.list(lam)) lam[[1]] else lam
+            } else {
+              NA
+            }
+          })
+        })
+        # Extract per-parameter mean/sd/median from theta in each cycle
+        par_names <- json$settings$parameters$parameters$name
+        n_params <- length(par_names)
+        # cycles_raw$theta is a list column of matrices [nspp_i x npar]
+        cycle_stats <- lapply(cycles_raw$theta, function(theta_mat) {
+          # theta_mat is already a matrix after jsonlite simplification
+          if (is.null(theta_mat) || (is.matrix(theta_mat) && nrow(theta_mat) == 0)) return(NULL)
+          if (!is.matrix(theta_mat)) theta_mat <- matrix(theta_mat, ncol = n_params)
+          stats <- list()
+          for (j in seq_len(n_params)) {
+            vals <- theta_mat[, j]
+            stats[[paste0(par_names[j], ".mean")]] <- mean(vals)
+            stats[[paste0(par_names[j], ".sd")]] <- sd(vals)
+            stats[[paste0(par_names[j], ".median")]] <- median(vals)
+          }
+          as.data.frame(stats)
+        })
+        cycle_stats_df <- dplyr::bind_rows(cycle_stats)
+        raw <- dplyr::bind_cols(raw, cycle_stats_df)
+        # Add gamlam columns
+        if (is.matrix(gamlam_vals)) {
+          for (k in seq_len(nrow(gamlam_vals))) {
+            raw[[paste0("gamlam.", k - 1)]] <- gamlam_vals[k, ]
+          }
+        } else {
+          raw[["gamlam.0"]] <- gamlam_vals
+        }
+        if (nrow(raw) == 0) {
           raw <- data.frame(cycle = 0, status = "Posterior")
-          write.csv(raw, file.path(path, "cycles.csv"), row.names = FALSE)
         }
-      } else if (inherits(data, "PM_cycle") & !is.null(data$data)) { # file not there, and already PM_cycle
+      } else if (inherits(data, "PM_cycle") & !is.null(data$data)) {
         class(data$data) <- c("PM_cycle_data", "list")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate cycle information.",
-          "i" = "{.file {file.path(path, 'cycles.csv')}} does not exist, and result does not have valid {.code PM_cycle} object."
+          "i" = "No JSON cyclelog and no valid {.code PM_cycle} object."
         ))
         return(NULL)
       }
 
-
-      if (file.exists(file.path(path, "pred.csv"))) {
-        op_raw <- readr::read_csv(file = file.path(path, "pred.csv"), 
-        col_types = list(
-          time = readr::col_double(),
-          outeq = readr::col_integer(),
-          block = readr::col_integer(),
-          obs = readr::col_double(),
-          cens = readr::col_character(),
-          pop_mean = readr::col_double(),
-          pop_median = readr::col_double(),
-          post_mean = readr::col_double(),
-          post_median = readr::col_double()
-        ), show_col_types = FALSE) %>% filter(!is.na(obs))
-      } else if (inherits(data, "PM_cycle")) { # file not there, and already PM_op
+      # --- Obtain predictions data (for AIC/BIC n_subjects) ---
+      if (!is.null(json) && !is.null(json$predictions)) {
+        op_raw <- tibble::as_tibble(json$predictions$predictions) %>% filter(!is.na(obs))
+      } else if (inherits(data, "PM_cycle")) {
         class(data$data) <- c("PM_cycle_data", "list")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate cycle information.",
-          "i" = "{.file {file.path(path, 'pred.csv')}} does not exist, and result does not have valid {.code PM_cycle} object."
+          "i" = "No JSON predictions and no valid {.code PM_cycle} object."
         ))
         return(NULL)
       }
 
-
-      if (file.exists(file.path(path, "settings.json"))) {
-        config <- jsonlite::fromJSON(file.path(path, "settings.json"))
-      } else if (inherits(data, "PM_cycle") & !is.null(data$data)) { # file not there, and already PM_op
+      # --- Obtain settings/config ---
+      if (!is.null(json) && !is.null(json$settings)) {
+        config <- json$settings
+      } else if (inherits(data, "PM_cycle") & !is.null(data$data)) {
         class(data$data) <- c("PM_cycle_data", "list")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate cycle information.",
-          "i" = "{.file {file.path(path, 'settings.json')}} does not exist, and result does not have valid {.code PM_cycle} object."
+          "i" = "No JSON settings and no valid {.code PM_cycle} object."
         ))
         return(NULL)
       }

R/PM_final.R

@@ -80,10 +80,10 @@ PM_final <- R6::R6Class(
     #' Creation of new `PM_final` object is automatic and not generally necessary
     #' for the user to do.
     #' @param PMdata include `r template("PMdata")`.
-    #' @param path include `r template("path")`.
+    #' @param json A parsed JSON list from `result.json`, as read by [PM_parse].
     #' @param ... Not currently used.
-    initialize = function(PMdata = NULL, path = ".", ...) {
-      self$data <- private$make(PMdata, path)
+    initialize = function(PMdata = NULL, json = NULL, ...) {
+      self$data <- private$make(PMdata, json)
       class(self) <- c(c("NPAG", "IT2B")[1 + as.numeric(is.null(self$popPoints))], class(self))
     },
     #' @description
@@ -230,42 +230,64 @@ PM_final <- R6::R6Class(
     }
   ), # end active
   private = list(
-    make = function(data, path) {
-      if (file.exists(file.path(path, "theta.csv"))) {
-        theta <- readr::read_csv(file = file.path(path, "theta.csv"), show_col_types = FALSE)
-      } else if (inherits(data, "PM_final") & !is.null(data$data)) { # file not there, and already PM_final
+    make = function(data, json = NULL) {
+      # --- Obtain theta ---
+      if (!is.null(json) && !is.null(json$theta)) {
+        par_names <- json$settings$parameters$parameters$name
+        # json$theta is already a matrix [nspp x npar] after jsonlite simplification
+        theta_mat <- json$theta
+        colnames(theta_mat) <- par_names
+        theta <- tibble::as_tibble(theta_mat)
+        theta$prob <- json$w
+      } else if (inherits(data, "PM_final") & !is.null(data$data)) {
         class(data$data) <- c("PM_final_data", "list")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate final cycle information.",
-          "i" = "{.file {file.path(path, 'theta.csv')}} does not exist, and result does not have valid {.code PM_final} object."
+          "i" = "No JSON theta and no valid {.code PM_final} object."
         ))
         return(NULL)
       }
 
-      if (file.exists(file.path(path, "posterior.csv"))) {
-        post <- readr::read_csv(file = file.path(path, "posterior.csv"), show_col_types = FALSE)
-      } else if (inherits(data, "PM_final") & !is.null(data$data)) { # file not there, and already PM_final
+      # --- Obtain posterior ---
+      if (!is.null(json) && !is.null(json$posterior)) {
+        par_names <- json$settings$parameters$parameters$name
+        # json$posterior is a matrix [nsubjects x nspp] after jsonlite simplification
+        # rows = subjects, columns = support points (probabilities)
+        # json$data$subjects is a data.frame with column $id
+        subject_ids <- json$data$subjects$id
+        post_list <- lapply(seq_len(nrow(json$posterior)), function(i) {
+          probs <- json$posterior[i, ]
+          df <- theta[, par_names, drop = FALSE]
+          df$prob <- probs
+          df$id <- subject_ids[i]
+          df$point <- seq_len(length(probs))
+          df
+        })
+        post <- dplyr::bind_rows(post_list) %>%
+          dplyr::relocate(id, point, dplyr::everything())
+      } else if (inherits(data, "PM_final") & !is.null(data$data)) {
         class(data$data) <- c("PM_final_data", "data.frame")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate final cycle information.",
-          "i" = "{.file {file.path(path, 'posterior.csv')}} does not exist, and result does not have valid {.code PM_final} object."
+          "i" = "No JSON posterior and no valid {.code PM_final} object."
         ))
         return(NULL)
       }
 
-      if (file.exists(file.path(path, "settings.json"))) {
-        config <- jsonlite::fromJSON(file.path(path, "settings.json"))
-      } else if (inherits(data, "PM_final")) { # file not there, and already PM_final
+      # --- Obtain settings/config ---
+      if (!is.null(json) && !is.null(json$settings)) {
+        config <- json$settings
+      } else if (inherits(data, "PM_final")) {
         class(data$data) <- c("PM_final_data", "data.frame")
         return(data$data)
       } else {
         cli::cli_warn(c(
           "!" = "Unable to generate final cycle information.",
-          "i" = "{.file {file.path(path, 'settings.json')}} does not exist, and result does not have valid {.code PM_final} object."
+          "i" = "No JSON settings and no valid {.code PM_final} object."
         ))
         return(NULL)
       }