пропозиції роботи
Acg N. .
Temat: Odpowiednik SAS First i Last w R - może się komuś przyda.
Niby drobna rzecz, a jaka przydatna.Funkcje:
FirstRowsBy <- function(dataFrame, byColumns) {
DT <- data.table(dataFrame, key=byColumns)
as.data.frame(DT[unique(DT[, key(DT), with = FALSE]), mult = 'first'])
}
LastRowsBy <- function(dataFrame, byColumns) {
DT <- data.table(dataFrame, key=byColumns)
as.data.frame(DT[unique(DT[, key(DT), with = FALSE]), mult = 'last'])
}
MarkFirstLastBy <- function(dataFrame, byColumns) {
idName <- paste0("ID", paste0(sample(c(LETTERS, letters, 0:9), size=5), collapse=""))
dataFrame[, idName] <- seq_len(nrow(dataFrame))
firstIDs <- FirstRowsBy(dataFrame = dataFrame, byColumns = byColumns)[, idName]
lastIDs <- LastRowsBy(dataFrame = dataFrame, byColumns = byColumns)[, idName]
dataFrame$FIRST <- dataFrame[, idName] %in% firstIDs
dataFrame$LAST <- dataFrame[, idName] %in% lastIDs
dataFrame[, idName] <- NULL
return(dataFrame)
}Przykład:
> df #dane źródłowe
col1 col2 col3 val
1 A X M -0.1
2 A X M -0.3
3 A X M -0.2
4 A X N -0.6
5 A X N -3.2
6 A Y M -0.7
7 A Y M 0.4
8 A Y M 0.8
9 A Y M -0.8
10 B X M 1.2
11 B X N 0.6
12 B X N 0.6
13 B X N 1.4
14 B X N 0.3
15 B X O 0.8
16 B X O 0.3
17 B X O 0.0
18 B X O -0.7
19 B Y P -0.7
20 C V P 0.7
21 C V Q -0.1
22 C V Q -0.6
23 C V Q 1.0
24 C V R -0.8
25 C V R 1.5
26 C V R 0.2
27 C V S -0.1
28 C V T -1.3
29 D X U -1.1
30 D X U 1.4
31 D X U 1.5
32 D Y U -0.5
33 D Y U 0.4
34 D Z W 0.0
35 D Z W -0.8
> MarkFirstLastBy(df, c("col1", "col2", "col3"))
col1 col2 col3 val FIRST LAST
1 A X M -0.1 TRUE FALSE
2 A X M -0.3 FALSE FALSE
3 A X M -0.2 FALSE TRUE
4 A X N -0.6 TRUE FALSE
5 A X N -3.2 FALSE TRUE
6 A Y M -0.7 TRUE FALSE
7 A Y M 0.4 FALSE FALSE
8 A Y M 0.8 FALSE FALSE
9 A Y M -0.8 FALSE TRUE
10 B X M 1.2 TRUE TRUE
11 B X N 0.6 TRUE FALSE
12 B X N 0.6 FALSE FALSE
13 B X N 1.4 FALSE FALSE
14 B X N 0.3 FALSE TRUE
15 B X O 0.8 TRUE FALSE
16 B X O 0.3 FALSE FALSE
17 B X O 0.0 FALSE FALSE
18 B X O -0.7 FALSE TRUE
19 B Y P -0.7 TRUE TRUE
20 C V P 0.7 TRUE TRUE
21 C V Q -0.1 TRUE FALSE
22 C V Q -0.6 FALSE FALSE
23 C V Q 1.0 FALSE TRUE
24 C V R -0.8 TRUE FALSE
25 C V R 1.5 FALSE FALSE
26 C V R 0.2 FALSE TRUE
27 C V S -0.1 TRUE TRUE
28 C V T -1.3 TRUE TRUE
29 D X U -1.1 TRUE FALSE
30 D X U 1.4 FALSE FALSE
31 D X U 1.5 FALSE TRUE
32 D Y U -0.5 TRUE FALSE
33 D Y U 0.4 FALSE TRUE
34 D Z W 0.0 TRUE FALSE
35 D Z W -0.8 FALSE TRUE
Plus mały bonus - dwie przydatne, bliźniaczo podobne funkcje, generujące sekwencję dla grup oraz zmienną grupującą, po której można potem np. "przejechać" *apply
GenerateSequenceBy <- function(dataFrame, byColumns) {
idName <- paste0("ID", paste0(sample(c(LETTERS, letters, 0:9), size=5), collapse=""))
dataFrame[, idName] <- seq_len(nrow(dataFrame))
firstIDs <- FirstRowsBy(dataFrame = dataFrame, byColumns = byColumns)[, idName]
lastIDs <- LastRowsBy(dataFrame = dataFrame, byColumns = byColumns)[, idName]
deltas <- (lastIDs - firstIDs) + 1
do.call(c, lapply(deltas, FUN=function(x) 1:x))
}
GenerateGroupingVariableBy <- function(dataFrame, byColumns) {
idName <- paste0("ID", paste0(sample(c(LETTERS, letters, 0:9), size=5), collapse=""))
dataFrame[, idName] <- seq_len(nrow(dataFrame))
firstIDs <- FirstRowsBy(dataFrame = dataFrame, byColumns = byColumns)[, idName]
lastIDs <- LastRowsBy(dataFrame = dataFrame, byColumns = byColumns)[, idName]
deltas <- (lastIDs - firstIDs) + 1
var <- 0
do.call(c, lapply(deltas, FUN=function(x) rep((var <<- var+1), x)))
}Przykład:
> (df$SEQ <- GenerateSequenceBy(df, c("col1","col2","col3")))
col1 col2 col3 val SEQ
1 A X M -0.1 1
2 A X M -0.3 2
3 A X M -0.2 3
4 A X N -0.6 1
5 A X N -3.2 2
6 A Y M -0.7 1
7 A Y M 0.4 2
8 A Y M 0.8 3
9 A Y M -0.8 4
10 B X M 1.2 1
11 B X N 0.6 1
12 B X N 0.6 2
13 B X N 1.4 3
14 B X N 0.3 4
...itd
> (df$GR <- GenerateGroupingVariableBy(df, c("col1","col2","col3")))
col1 col2 col3 val SEQ GR
1 A X M -0.1 1 1
2 A X M -0.3 2 1
3 A X M -0.2 3 1
4 A X N -0.6 1 2
5 A X N -3.2 2 2
6 A Y M -0.7 1 3
7 A Y M 0.4 2 3
8 A Y M 0.8 3 3
9 A Y M -0.8 4 3
10 B X M 1.2 1 4
11 B X N 0.6 1 5
12 B X N 0.6 2 5
13 B X N 1.4 3 5
14 B X N 0.3 4 5
...itd
> tapply(df$val, df$GR, FUN=function(x) (mean(x)))
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
-0.200 -1.900 -0.075 1.200 0.725 0.100 -0.700 0.700 0.100 0.300 -0.100 -1.300 0.600 -0.050 -0.400
Ten post został edytowany przez Autora dnia 11.02.15 o godzinie 03:16
