Подтвердить что ты не робот

Заполните кадр данных значениями из строк выше

Скажем, у меня есть такой кадр данных:

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, но я ищу более эффективный способ.

4b9b3361

Ответ 1

Если вам нужно только переносить значения из столбца VALUE, я думаю, вы можете использовать na.lofc() из пакета zoo. Вот пример:

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

Ответ 2

Вопрос требует эффективности по сравнению с циклом. Ниже приведено сравнение четырех решений:

  1. zoo::na.locf, который вводит зависимость пакета, и, хотя он обрабатывает многие случаи zoo::na.locf, требуется, чтобы "пустые" значения были равны NA. Другие решения легко адаптируются к заготовкам без NA.

  2. Простая петля в базе R.

  3. Рекурсивная функция в базе R.

  4. Мое собственное векторное решение в базе R.

  5. Новая функция 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

Ответ 3

Если 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

Ответ 4

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