Ответ 1
Если вам нужно только переносить значения из столбца VALUE, я думаю, вы можете использовать na.lofc()
из пакета zoo. Вот пример:
a<-c(1,NA,NA,2,NA)
na.locf(a)
[1] 1 1 1 2 2
Скажем, у меня есть такой кадр данных:
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
Таким образом, VALUE устанавливается только для FIRST = TRUE один раз для ID. ID_2 может быть дубликат между идентификаторами, но не обязательно.
Как поместить числа из первых строк каждого ID во все строки этого идентификатора, чтобы столбец VALUE стал 2, 2, 2, 5, 5?
Я знаю, что могу просто перебрать все идентификаторы с циклом for, но я ищу более эффективный способ.
Если вам нужно только переносить значения из столбца VALUE, я думаю, вы можете использовать na.lofc()
из пакета zoo. Вот пример:
a<-c(1,NA,NA,2,NA)
na.locf(a)
[1] 1 1 1 2 2
Вопрос требует эффективности по сравнению с циклом. Ниже приведено сравнение четырех решений:
zoo::na.locf
, который вводит зависимость пакета, и, хотя он обрабатывает многие случаи zoo::na.locf
, требуется, чтобы "пустые" значения были равны NA. Другие решения легко адаптируются к заготовкам без NA.
Простая петля в базе R.
Рекурсивная функция в базе R.
Мое собственное векторное решение в базе R.
Новая функция fill()
в версии tidyr
0.3.0., Которая работает с data.frames.
Обратите внимание, что большинство из этих решений предназначено для векторов, а не для фреймов данных, поэтому они не проверяют столбец идентификаторов. Если кадр данных не сгруппирован по идентификатору, а значение, которое должно быть заполнено вверху, находится в верхней части каждой группы, тогда вы можете попробовать функцию окна в dplyr
или 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))
Результаты:
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
Если VALUE для определенного идентификатора всегда отображается в первой записи, что, как представляется, относится к вашим данным, вы можете использовать match
чтобы найти эту запись:
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
+1 для @nacnudus Ручки ведущих заготовок
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)
}