Different function outcome based on nested structure

Dasr 0
Viewed 32

I'm trying to apply a function which looks at the structure of a nested tibble, then depending on which group the row belongs different outcomes are sought, for instance:

library(tidyverse)

df <- data.frame(
  species = c(
    "setosa",
    "virginica",
    "versicolor"
  ),
  detection_timestamp_utc = as.POSIXct("2018-03-22 23:59:59", tz = "UTC")
) %>%
  group_by(species) %>%
  nest()


# idea of function is that if the group == "virginica" then a specific rule is applied whereby if the date
# within the data falls within the interval "summer_2018" should be assigned to the newly created season column
# for all other groups further rules will be applied (in my case it will be a different set of dates but I simplified it here)
# in the case of the actual function I have, there are a number of intervals per group and a number of outcomes

fun1 <- function(nested_list) {
  if (nested_list$species == "virginica") {
    nested_list %>% mutate(data = map(data, ~ mutate(.x, season = case_when(
      detection_timestamp_utc %within% interval(
        ymd_hms("2018-02-01 00:00:00"),
        ymd_hms("2018-09-30 23:59:59")
      ) ~ "summer_2018",
      "winter_2018"
    ))))
  } else {
    nested_list %>% mutate(data = map(data, ~ mutate(.x, season = "not_applicable_wrong_group")))
  }
}


# from the above I would want the nested tibble row which == "virginica" to be assigned summer_2018, but all the rest
# should be assigned "not_applicable_wrong_group" as the test which looks at group should return false.

# however, it all fails to work
df2 = fun1(df)
#> Warning in if (nested_list$species == "virginica") {: the condition has length >
#> 1 and only the first element will be used

I'm not sure this is the best structure, but in theory I'll have a number of groups and slightly different rules will need to be applied to each group.

purrr nested r
1 Answers

I think its probably a mistake to nest the table and then transform it different ways; I would think it would easier to simply transform it unnested. Putting that aside for a moment ...

I think you can make the following changes to your starting df and to your function

  1. for your df , add a final step of dplyr::group_split() this will then allow you to
  2. purrr::map over each group and as it will have a single species value per group your existing code will likely work as you intend it.

ok here is that :

library(tidyverse)
library(lubridate)
df <- data.frame(
  species = c(
    "setosa",
    "virginica",
    "versicolor"
  ),
  detection_timestamp_utc = as.POSIXct("2018-03-22 23:59:59", tz = "UTC")
) %>%group_by(species) %>% nest() %>% group_split()


fun1 <- function(nested_list) {
  map(nested_list,~{
  if (.x$species == "virginica") {
    .x %>% mutate(data = map(data, ~ mutate(.x, season = case_when(
      detection_timestamp_utc %within% interval(
        ymd_hms("2018-02-01 00:00:00"),
        ymd_hms("2018-09-30 23:59:59")
      ) ~ "summer_2018",
      TRUE ~ "winter_2018"
    ))))
  } else {
    .x %>% mutate(data = map(data, ~ mutate(.x, season = "not_applicable_wrong_group")))
  }
  }) %>% bind_rows()
}
fun1(df)

but again, my advice would be to not overcomplicate by nesting; it doesnt seem particularly natural here. already you have mutate with maps inside them and other mutates... overcomplicated for the sort of scenario you are indicating

Therefore consider the relative simplicity of a non nested approach; instead of adding group_split on your df, make your df unnested. then you might do

library(tidyverse)
library(lubridate)
df <- data.frame(
  species = c(
    "setosa",
    "virginica",
    "versicolor"
  ),
  detection_timestamp_utc = as.POSIXct("2018-03-22 23:59:59", tz = "UTC")
)

fun1 <- function(normal_df) {
  normal_df %>% mutate(season = case_when(
    species == "virginica" ~
      case_when(
        detection_timestamp_utc %within% interval(
          ymd_hms("2018-02-01 00:00:00"),
          ymd_hms("2018-09-30 23:59:59")
        ) ~ "summer_2018",
        TRUE ~ "winter_2018"
      ),
    TRUE ~ "not_applicable_wrong_group"
  ))
}

fun1(df) 

#or if you must 
fun1(df) %>% group_by(species) %>% nest()
Nir Graham0
Related