Verwenden von rle zum Eliminieren der ersten und letzten Sequenz

Ich würde eine Funktion mit cumsum schreiben, in der wir überprüfen, wie viele der ersten aufeinander folgenden Werte mit first_position beginnen und wie viele der letzten aufeinander folgenden Werte mit last_position beginnen, und sie entfernen.

get_reduced_data <- function(dat, first_position, last_position) {
    dat[cumsum(dat != first_position) != 0 &
   rev(cumsum(rev(dat) != last_position) != 0)]
 }

get_reduced_data(foo, first_position, last_position)
#[1] "B" "B" "A" "B" "A"

get_reduced_data(bar, first_position, last_position)
#[1] "B" "A" "B" "A"

get_reduced_data(baz, first_position, last_position)
#character(0)

get_reduced_data(qux, first_position, last_position)
#[1] "C" "A" "C" "A"

Daten

foo <- c("A", "A","A", "B", "B", "A", "B", "A", "C")
bar <- c("A", "B","A", "B", "A", "C", "C", "C", "C", "C")
baz <- c(rep("A", 5), rep("C", 5))
qux <- c("A", "C", "A", "C", "A", "C")
first_position <- "A"
last_position <- "C"

Ein data.table Ansatz könnte sein ,

library(data.table)

setDT(df)[, grp := rleid(position)][
  !(grp == 1 & position == 'A' | grp == max(grp) & position == 'C'), ][
    , grp := NULL][]

Was gibt,

   position
1:        B
2:        B
3:        A
4:        B
5:        A

Eine andere mögliche Lösung ohne rle durch Erstellen eines Index und Unterteilen von Zeilen zwischen dem ersten Auftreten von Nicht-A und dem letzten Auftreten von Nicht-C:

library(data.table)
output <- function(DT) {
    DT[, rn:=.I][,{
            mn <- min(which(position!="A"))
            mx <- max(which(position!="C"))
            if (mn > mx) return(NULL)
            .SD[mn:mx]
        }]
}

output(setDT(foo))
#   position rn
#1:        B  4
#2:        B  5
#3:        A  6
#4:        B  7
#5:        A  8

output(setDT(baz))
#NULL

Daten:

foo <- fread("position
A
A
A
B
B
A
B
A
C
C")

baz <- fread("position
A
A
A
A
A
C
C
C
C
C")

Das Problem scheint zweifach zu sein. Trimmen von "ersten" und "letzten" Elementen und Identifizieren von "ersten" und "letzten" Elementen. Ich mag Ihren rle() Ansatz, weil er viele Möglichkeiten in einer gemeinsamen Struktur abbildet. Die Aufgabe besteht also darin, eine Funktion zu schreiben, um das erste und das letzte Element eines Vektors beliebiger Länge zu maskieren

mask_end = function(x) {
    n = length(x)
    mask = !logical(n)
    mask[c(min(1, n), max(0, n))] = FALSE  # allow for 0-length x
    mask
}

Dies ist sehr einfach umfassend zu testen

> mask_end(integer(0))
logical(0)
> mask_end(integer(1))
[1] FALSE
> mask_end(integer(2))
[1] FALSE FALSE
> mask_end(integer(3))
[1] FALSE  TRUE FALSE
> mask_end(integer(4))
[1] FALSE  TRUE  TRUE FALSE

Die Lösung (Rückgabe der Maske; einfach zu ändern, um die tatsächlichen Werte zurückzugeben, x[inverse.rle(r)]) lautet dann

mask_end_runs = function(x) {
    r = rle(x)
    r$values = mask_end(r$values)
    inverse.rle(r)
}