Điền vào khung dữ liệu với giá trị từ hàng trên

Question

Nói rằng tôi có một khung dữ liệu như thế này:

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 

Vì vậy GIÁ TRỊ chỉ đặt ra cho FIRST = TRUE một lần mỗi ID. ID_2 có thể trùng lặp giữa các ID nhưng không phải.

Làm cách nào để đặt các số từ hàng đầu tiên của từng ID vào tất cả các hàng của ID đó, sao cho cột VALUE trở thành 2, 2, 2, 5, 5?

Tôi biết tôi chỉ có thể lặp qua tất cả các ID bằng vòng lặp for, nhưng tôi đang tìm kiếm một cách hiệu quả hơn.

Answer 1

Nếu bạn chỉ cần chuyển tiếp các giá trị từ cột VALUE, thì tôi nghĩ bạn có thể sử dụng chức năng na.lofc() từ sở thú gói. Dưới đây là một ví dụ:

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

Answer 2

Nếu giá trị cho một ID cụ thể luôn xuất hiện trong bản ghi đầu tiên, mà dường như là trường hợp cho dữ liệu của bạn, bạn có thể sử dụng match để thấy rằng kỷ lục:

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

Câu hỏi yêu cầu hiệu quả so với vòng lặp. Dưới đây là một so sánh bốn giải pháp:

1. zoo::na.locf, trong đó giới thiệu một gói phụ thuộc, và mặc dù nó xử lý nhiều trường hợp cạnh, đòi hỏi rằng các giá trị 'trống' là NA. Các giải pháp khác có thể dễ dàng thích nghi với khoảng trống không NA.

2. Một vòng lặp đơn giản trong R. cơ sở

3. Một hàm đệ quy trong R. cơ sở

4. My giải pháp vectorised riêng trong R. cơ sở

5. mới fill() chức năng trong tidyr phiên bản 0.3 .0., Hoạt động trên data.frames.

Lưu ý rằng hầu hết các giải pháp này là dành cho vec-tơ, không phải khung dữ liệu, vì vậy chúng không kiểm tra bất kỳ cột ID nào. Nếu khung dữ liệu không được nhóm lại theo ID, với giá trị sẽ được điền xuống là ở phía trên cùng của mỗi nhóm, sau đó bạn có thể thử một hàm cửa sổ trong dplyr hoặc 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)) 

Kết quả:

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 cho @nacnudus Xử lý khoảng trống hàng đầu

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) 
}