避免 R - dplyr 解决方案中的慢循环？

Question

I've got a problem which I can solve with a slow and clumsy loop in R. However, I'm hoping there's a more elegant (and faster) solution...

The simplest explanation I can think of: each row of data describes an action on a switch. The rows are sorted by switch ID (switch 1, switch 2, etc.) and by the chronological order of the actions. Each switch can either be on or off at any point in time. The action can be "turn on", "turn off" or "leave alone". For each row I want to know the status of the switch (on or off) both before and after the action described by that row.

Each switch starts in the "off" position.

(the data I'm working with actually relates to insurance policy data, but this switch-based analogy works and is probably simpler to understand)

A reproducible example:

df <- data.frame(switch_id = c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3),
                  counter = c(1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4),
                  action = c("on", "off", "on", "off", "on", "same", "same", "same", "on", "same", "same", "same", "off", "off", "off", "on", "off", "same", "on"))

I can get to where I want to be using a not-particularly-elegant loop:

df$status_before <- NA
df$status_after <- NA

for(i in 1:nrow(df)) 
{

  if(df$counter[i] == 1)
  {
    df$status_before[i] <- FALSE # switch always starts in the "off" position
  }
  else
  {
    df$status_before[i] <- df$status_after[i-1]
  }

  if(df$action[i] == "on") {
    df$status_after[i] <- TRUE
  }
  else if(df$action[i] == "off")
  {
    df$status_after[i] <- FALSE  
  }
  else # "same"
  {
    df$status_after[i] <- df$status_before[i] # leave everything alone
  }

}

...but obviously in R loops are best avoided because they run very slowly. Doesn't matter in this tiny data set of course, but the real data I'm working with has ~1M rows so it could be a problem.

Is there a "vectorised" solution to this, perhaps using dplyr type commands?

Thank you.

Answer 1

As far as I understand when I look at your loop, you want in status_before a TRUE / FALSE dependent of the action of the previous counter and in status_after a TRUE / FALSE dependent on the action of the actual counter . Did I get that right? Not quite sure though what you want with the same actions...

To look at values from previous rows, you can use the lag() function from dplyr (and to look "ahead", use lead() instead). This code gives the same output as your loop does:

EDITED:

# change "same" to last value of action (if you don't want to change the actual action column, create a new one)
df <- df %>%
  group_by(switch_id) %>%
  mutate(action = ifelse(action == "same", NA, action)) %>% # mark "same" as NA
  fill(action) # make sure action is a character string!

# do the actual evaluation
df <- df %>%
  group_by(switch_id) %>%
  mutate(status_before = case_when(lag(action) == "on" ~ "TRUE",
                                   lag(action) == "off" ~ "FALSE"),
         status_after = case_when(action == "on" ~ "TRUE",
                                  action == "off" ~ "FALSE"), 
         status_before = replace(status_before, is.na(status_before), "FALSE"))

This should be correct now!

Answer 2

Here is a data.table solution:

Edit : Need to operate by switch_id; as of data.table v.1.12.4, there is a native way to fill in missing values ( nafill ) used in this edit; added some comments

library(data.table)
df <- data.table(switch_id = c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2),
    counter = c(1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7),
    action = c("on", "off", "on", "off", "on", "same", "same", "same", "on", "same", "same", "same", "off", "off", "off"))

# in "status_after", replace "same" by NA and set "off" and "on" to FALSE and TRUE
df[, status_after := as.logical(factor(action, labels=c(FALSE, TRUE, NA)))]

# fill in NA using last observation carried forward, by switch_id
df[, status_after := as.logical(nafill(+(status_after), type = "locf")), by = switch_id]

# status_before: shift status_after (default: lag one), by switch_id
df[, status_before := shift(status_after), by = switch_id]

# set first instance of status_before per switch_id to FALSE
df[, status_before := c(FALSE, status_before[-1]), by = switch_id]

# reorder columns
setcolorder(df, c(1:3, 5, 4))
df
#>     switch_id counter action status_before status_after
#>  1:         1       1     on         FALSE         TRUE
#>  2:         1       2    off          TRUE        FALSE
#>  3:         1       3     on         FALSE         TRUE
#>  4:         1       4    off          TRUE        FALSE
#>  5:         1       5     on         FALSE         TRUE
#>  6:         1       6   same          TRUE         TRUE
#>  7:         1       7   same          TRUE         TRUE
#>  8:         1       8   same          TRUE         TRUE
#>  9:         2       1     on         FALSE         TRUE
#> 10:         2       2   same          TRUE         TRUE
#> 11:         2       3   same          TRUE         TRUE
#> 12:         2       4   same          TRUE         TRUE
#> 13:         2       5    off          TRUE        FALSE
#> 14:         2       6    off         FALSE        FALSE
#> 15:         2       7    off         FALSE        FALSE

^{Created on 2020-03-12 by the reprex package (v0.3.0)}