update cea_extract to work with data.frames

R/cea_extract.R

@@ -42,53 +42,112 @@ cea_extract <- function(dat, dr_sel = NULL, vc_sel = NULL, cumul_fun = "none") {
   # Apply relevant aggregations, if applicable
   dat <- aggr(dat, cumul_fun)
 
+  # Transform to stars if data.frame 
+  if ("data.frame" %in% class(dat)) {
+    if ("drivers" %in% colnames(dat)) {
+      dat <- stars::st_as_stars(dat, dims = c("x","y","drivers"))
+    } else {
+      dat <- stars::st_as_stars(dat, coords = c("x","y"))
+    }
+  }
+
   # Return
   dat
 }
 
+
 select_attr <- function(dat, dr_sel = NULL, vc_sel = NULL) {
   # Select drivers, if applicable
   if (!is.null(dr_sel)) {
-    if ("drivers" %in% names(stars::st_dimensions(dat))) {
-      dat <- dat[,,,dr_sel]      
+    if ("stars" %in% class(dat)) {
+      if ("drivers" %in% names(stars::st_dimensions(dat))) {
+        dat <- dat[,,,dr_sel]      
+      } else {
+        dat <- dat[dr_sel]
+      }
     } else {
-      dat <- dat[dr_sel]
+      if ("drivers" %in% colnames(dat)) {
+        dat <- dplyr::filter(dat, drivers %in% dr_sel)
+      } else {
+        dat <- dplyr::select(dat, x, y, dplyr::all_of(dr_sel))
+      }
     }
   }
 
   # Select valued components, if applicable
-  if (!is.null(vc_sel)) dat <- dat[vc_sel]
+  if (!is.null(vc_sel)) {
+    if ("stars" %in% class(dat)) {
+      dat <- dat[vc_sel]
+    } else {
+      dat <- dplyr::select(dat, x, y, dplyr::any_of("drivers"), dplyr::all_of(vc_sel))
+    }
+  }
 
   # Return
   dat
 }
 
 cumul <- function(dat) {
-  stars::st_apply(dat, c("x","y"), sum, na.rm = TRUE)
+    stars::st_apply(dat, c("x","y"), sum, na.rm = TRUE)    
 }
 
 cumul_vc <- function(dat) {
-  cumul(dat)
+  if ("stars" %in% class(dat)) {
+    cumul(dat)
+  } else {
+    dat |>
+    dplyr::select(-drivers) |>
+    dplyr::group_by(x,y) |>
+    dplyr::summarise(
+      dplyr::across(
+        dplyr::everything(),
+        \(x) sum(x, na.rm = TRUE)
+      )
+    ) |>
+    dplyr::ungroup()
+  }
 }
 
 cumul_drivers <- function(dat) {
-  merge(dat, name = "vc") |>
-  split("drivers") |>
-  cumul()
+  if ("stars" %in% class(dat)) {
+    merge(dat, name = "vc") |>
+    split("drivers") |>
+    cumul()
+  } else {
+    dat |>
+    dplyr::mutate(value = rowSums(dplyr::pick(-x,-y,-drivers), na.rm = TRUE)) |>
+    dplyr::select(x,y,drivers,value) |>
+    tidyr::pivot_wider(names_from = "drivers", values_from = "value")
+  }
 }
 
 cumul_full <- function(dat) {
-  dat |>
-  cumul() |>
-  merge() |>
-  cumul() |>
-  setNames("cumulative_effects")
+  if ("stars" %in% class(dat)) {
+    dat |>
+    cumul() |>
+    merge() |>
+    cumul() |>
+    setNames("cumulative_effects")
+  } else {
+    dat |>
+    dplyr::mutate(value = rowSums(dplyr::pick(-x,-y,-drivers), na.rm = TRUE)) |>
+    dplyr::select(x,y,drivers,value) |>
+    tidyr::pivot_wider(names_from = "drivers", values_from = "value") |>
+    dplyr::mutate(cumulative_effects = rowSums(dplyr::pick(-x,-y), na.rm = TRUE)) |>
+    dplyr::select(x,y,cumulative_effects)
+  }
 }
 
 cumul_footprint <- function(dat) {
-  merge(dat) |>
-  cumul() |>
-  setNames("cumulative_footprint")
+  if ("stars" %in% class(dat)) {
+    merge(dat) |>
+    cumul() |>
+    setNames("cumulative_footprint")
+  } else {
+    dat |>
+    dplyr::mutate(cumulative_footprint = rowSums(dplyr::pick(-x,-y), na.rm = TRUE)) |>
+    dplyr::select(x,y,cumulative_footprint) 
+  }
 }
 
 aggr <- function(dat, cumul_fun) {