Fill w ramce danych z wierszy z wartościami powyżej

Question

że mam ramki danych tak:

ID, ID_2, FIRST, VALUE 
----------------------- 
'a', 'aa', TRUE, 2 
'a', 'ab', FALSE, NA 
'a', 'ac', FALSE, NA 
'b', 'aa', TRUE, 5 
'b', 'ab', FALSE, NA 

więc wartość jest ustawiana tylko dla FIRST = true raz na ID. ID_2 może być duplikatem między identyfikatorami, ale nie musi.

Jak umieścić numery z pierwszych wierszy każdego identyfikatora we wszystkich wierszach tego identyfikatora, tak aby kolumna WARTOŚĆ stała się 2, 2, 2, 5, 5?

Wiem, że mógłbym po prostu zapętlić wszystkie identyfikatory za pomocą pętli for, ale szukam bardziej wydajnego sposobu.

Answer 1

Jeśli trzeba tylko przenieść wartości z kolumny VALUE, to myślę, że można korzystać z funkcji na.lofc()zoo pakietu. Oto przykład:

a<-c(1,NA,NA,2,NA) 
na.locf(a) 
[1] 1 1 1 2 2 

Answer 2

Jeśli wartość dla określonego ID pojawia się zawsze w pierwszym rekordzie, który wydaje się być w przypadku danych, można użyć match znaleźć ten rekord:

df <- read.csv(textConnection(" 

ID, ID_2, FIRST, VALUE 
'a', 'aa', TRUE, 2 
'a', 'ab', FALSE, NA 
'a', 'ac', FALSE, NA 
'b', 'aa', TRUE, 5 
'b', 'ab', FALSE, NA 

")) 

df$VALUE <- df$VALUE[match(df$ID, df$ID)] 
df 
# ID ID_2 FIRST VALUE 
# 1 'a' 'aa' TRUE  2 
# 2 'a' 'ab' FALSE  2 
# 3 'a' 'ac' FALSE  2 
# 4 'b' 'aa' TRUE  5 
# 5 'b' 'ab' FALSE  5 

Answer 3

Pytanie wymaga wydajności w porównaniu z pętlą. Tutaj jest porównanie czterech rozwiązań:

1. zoo::na.locf, który wprowadza zależność pakiet, a mimo to obsługuje wiele przypadków krawędzi, wymaga, że ​​wartości są „puste” NA. Pozostałe rozwiązania są łatwo dostosowane do spacji bez znaków NA.

2. prosty pętli podstawy R.

3. funkcji rekurencyjnej bazy R.

4. swój własny wektoryzowane roztwór w bazie R.

5. Nowy fill() funkcyjnych w wersji 0.3 tidyr .0., Który działa na data.frames.

Należy zauważyć, że większość z tych rozwiązań dotyczy wektorów, a nie ramek danych, więc nie sprawdza żadnej kolumny identyfikatora. Jeśli ramka danych nie są pogrupowane według ID, z wartością, którą należy wypełnić w dół jest w górnej części każdej grupy, a następnie można wypróbować funkcję okienkowy w dplyr lub data.table

# A popular solution 
f1 <- zoo::na.locf 

# A loop, adapted from https://stat.ethz.ch/pipermail/r-help/2008-July/169199.html 
f2 <- function(x) { 
    for(i in seq_along(x)[-1]) if(is.na(x[i])) x[i] <- x[i-1] 
    x 
} 

# Recursion, also from https://stat.ethz.ch/pipermail/r-help/2008-July/169199.html 
f3 <- function(z) { 
    y <- c(NA, head(z, -1)) 
    z <- ifelse(is.na(z), y, z) 
    if (any(is.na(z))) Recall(z) else z } 

# My own effort 
f4 <- function(x, blank = is.na) { 
    # Find the values 
    if (is.function(blank)) { 
    isnotblank <- !blank(x) 
    } else { 
    isnotblank <- x != blank 
    } 
    # Fill down 
    x[which(isnotblank)][cumsum(isnotblank)] 
} 

# fill() from the `tidyr` version 0.3.0 
library(tidyr) 
f5 <- function(y) { 
    fill(y, column) 
} 
# Test data, 2600 values, ~58% blanks 
x <- rep(LETTERS, 100) 
set.seed(2015-09-12) 
x[sample(1:2600, 1500)] <- NA 
x <- c("A", x) # Ensure the first element is not blank 
y <- data.frame(column = x, stringsAsFactors = FALSE) # data.frame version of x for tidyr 

# Check that they all work (they do) 
identical(f1(x), f2(x)) 
identical(f1(x), f3(x)) 
identical(f1(x), f4(x)) 
identical(f1(x), f5(y)$column) 

library(microbenchmark) 
microbenchmark(f1(x), f2(x), f3(x), f4(x), f5(y)) 

Wyniki:

Unit: microseconds 
    expr  min  lq  mean median  uq  max neval 
f1(x) 422.762 466.6355 508.57284 505.6760 527.2540 837.626 100 
f2(x) 2118.914 2206.7370 2501.04597 2312.8000 2497.2285 5377.018 100 
f3(x) 7800.509 7832.0130 8127.06761 7882.7010 8395.3725 14128.107 100 
f4(x) 52.841 58.7645 63.98657 62.1410 65.2655 104.886 100 
f5(y) 183.494 225.9380 305.21337 331.0035 350.4040 529.064 100 

Answer 4

+1 dla @nacnudus Uchwyty spacjami

f4 <- function(x, blank = is.na) { 

    # Find the values 
    if (is.function(blank)) { 
    isnotblank <- !blank(x) 
    } else { 
    isnotblank <- x != blank 
    } 

    # Fill down 
    xfill <- cumsum(isnotblank) 
    xfill[ xfill == 0 ] <- NA 

    # Replace Blanks 
    xnew <- x[ which(isnotblank) ][ xfill ] 
    xnew[is.na(xnew)] <- blank 
    return(xnew) 
}