Условное изменение на основе порядка переменных

Попытка, основанная на большем количестве ручных правил, чем я надеялся справиться с разрешенным дублированием B, но не A или C:

result <- lapply(s.list, \(x) {
    ox <- ordered(x, levels=c("A","B","C"))
    os <- is.unsorted(ox)
    out <- rep(0, length(ox))
    if (!os) {
        out[ox == "A" & (!duplicated(ox, fromLast=TRUE))] <- 1
        out[ox == "C" & (!duplicated(ox))] <- 1
        out[ox == "B"] <- 1
    }
    out
})
result
#[[1]]
#[1] 1 1 1
#
#[[2]]
#[1] 0 1 1 1 1
#
#[[3]]
#[1] 0 0 0
#
#[[4]]
#[1] 0 0 0

Выезд:

identical(result, s.indexed)
#[1] TRUE

Базовая логика заключается в использовании фактора ordered с желаемым порядком ABC, который позволяет сначала идентифицировать неотсортированные векторы. Тогда только последний A и первый C помечаются как 1 с использованием флага duplicated.

При этом используется str_locate для поиска нужных персонажей/событий. Это работает для одного возникновения события на запись. Это можно расширить для работы с любым количеством случаев (используя str_locate_all), но это добавит несколько уровней сложности.

library(stringr)

lapply(s.list, \(x){
  strng <- paste0(x, collapse = "")
  loc <- str_locate(strng, "AB+C")
  zeros <- rep(0, nchar(strng))
  if (!is.na(loc[1])){ 
    zeros[seq(loc[1], loc[2])] <- 1
  }
  zeros
})
[[1]]
[1] 1 1 1

[[2]]
[1] 0 1 1 1 1

[[3]]
[1] 0 0 0

[[4]]
[1] 0 0 0

[[5]]
[1] 1 1 1 1 0

Используя список ввода L, показанный в примечании в конце, он, как и другой ответ, преобразует входные векторы в строки и воздействует на них, используя обычный выражение, но использует другие функции и упорядочивает их в конвейер.

Строка sapply преобразует каждый вектор в строку символов; следующий строка заменяет целевые строки тем же количеством единиц; следующий строка заменяет все остальные символы нулями, а последние две строки преобразуются из вектора символов в список числовых векторов.

Если результат вектора символов c("111", "01111", ...) в порядке, то последний две строки можно опустить.

library(gsubfn)

L |>
  sapply(paste, collapse = "") |>
  gsubfn("(AB+C)", ~ strrep("1",nchar(x)), x = _) |>
  gsub("[^1]", "0", x = _) |>
  strsplit("") |>
  lapply(as.numeric)

Примечание

Используемый вход

L <- list(
  c("A", "B", "C") ,
  c("A", "A", "B", "B", "C") ,
  c("B", "A", "C") ,
  c("C", "B", "A"),
  c("A", "B", "B", "C", "A")
)

is_next_legal <- function(cur, next_elem) {
  (cur == "A" && next_elem == "B") || (cur == "B" && next_elem %in% c("B", "C"))
}

foo <- function(x) {
  n <- length(x)
  out <- integer(n)
  i <- 1L
  p <- 1L
  while (i <= (n-2L)) {
    if (x[i] == "A") {
      p <- i
      while (p <= (n-1L) && is_next_legal(x[p], x[p+1])) {
        p <- p + 1L
      }
      if (x[p] == "C") out[i:p] <- 1L
    }
    i <- max(i, p) + 1L
  }
  out
}

lapply(s.list, foo)
[[1]]
[1] 1 1 1

[[2]]
[1] 0 1 1 1 1

[[3]]
[1] 0 0 0

[[4]]
[1] 0 0 0

[[5]]
[1] 1 1 1 1 0