Ich versuche, ein Problem mit R mit rle() (oder einer anderen relevanten Funktion) zu lösen, bin mir aber nicht sicher, wo ich anfangen soll. Das Problem ist wie folgt: foo, bar und baz und qux können sich an einer von drei Positionen befinden: A, B, oder C.

Ihre erste Position ist immer A und ihre letzte Position ist immer C, aber ihre Positionen dazwischen sind zufällig.

Mein Ziel ist es, die erste A oder erste Folge von A und die letzte C oder die letzte Folge von C zu eliminieren. Zum Beispiel:

> foo
   position
1         A
2         A
3         A
4         B
5         B
6         A
7         B
8         A
9         C
10        C

> output(foo)
   position

4         B
5         B
6         A
7         B
8         A


> bar
   position
1         A
2         B
3         A
4         B
5         A
6         C
7         C
8         C
9         C
10        C

> output(bar)
   position

2         B
3         A
4         B
5         A

> baz
   position
1         A
2         A
3         A
4         A
5         A
6         C
7         C
8         C
9         C
10        C

> output(baz)
NULL

> qux
  position
1        A
2        C
3        A
4        C
5        A
6        C

> output(qux)
  position
2        C
3        A
4        C
5        A

Basic rle() informiert mich über die Sequenzen und ihre Längen, behält jedoch keine Zeilenindizes bei. Wie soll man dieses Problem lösen?

> rle(foo$position)
Run Length Encoding
  lengths: int [1:6] 3 2 1 1 1 2
  values : chr [1:6] "A" "B" "A" "B" "A" "C"
4
the_darkside 18 Apr. 2018 im 09:42

5 Antworten

Beste Antwort

Hier ist eine Option mit rle. Die Idee wäre, das erste und letzte values zu unterteilen, zu prüfen, ob es gleich 'A', 'C' ist, es NA zuzuweisen und dies in ein logisches vector für umzuwandeln Teilmenge

i1 <- !is.na(inverse.rle(within.list(rle(foo$position), 
     values[c(1, length(values))][values[c(1, length(values))] == c("A", "C")] <- NA)))
foo[i1, , drop = FALSE]
#    position
#4        B
#5        B
#6        A
#7        B
#8        A
1
akrun 18 Apr. 2018 im 06:58

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"
3
mt1022 18 Apr. 2018 im 07:06

Ein 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
0
Sotos 18 Apr. 2018 im 07:12

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")
0
chinsoon12 18 Apr. 2018 im 08:07

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)
}
0
Martin Morgan 18 Apr. 2018 im 13:51