Цикл for не будет проходить мимо первой переменной в последовательности при использовании в функции - PullRequest
0 голосов
/ 08 февраля 2019

У меня есть дата-фрейм, включающий лабораторные результаты по отдельным предметам.У некоторых субъектов есть повторяющиеся записи, только у дубликатов есть определенные точки данных, отсутствующие в одной записи, но не в другой.

Я пытаюсь написать функцию, которая будет «заполнять» данные NAточки в одной строке от любого дубликата, который может существовать для этого предмета.Вот что я попробовал:

# example data with duplicate IDs, some with missing values

ir<-head(iris)
ir$unique_flower_ID<-1:6
ir<-rbind(ir, ir[c(1,3,5),])
ir[7:9, c(1,3)]<-NA
ir[c(1,3,5), c(2,4)]<-NA
ir<-ir[order(ir$unique_flower_ID),]

# function to run on a given dataframe (df) to 
# replace missing values in certain variables (vars) from duplicates
# as identified by a unique ID
replaceNAs_dupl <- function(df, ID, vars) {
  #identify duplicate IDs and subset the dataframe
  df_dupl<-data.frame(table(df[, ID]))
  df_dupl<-df[df[, ID] %in% df_dupl$Var1[which(df_dupl$Freq > 1)],]

  # loop through specified columns
  for(i in vars) {
    #create a mini-dataframe of ID and value for each column
    df_dupl_uni<-unique(df_dupl[which(!is.na(df_dupl[,i])), c(ID, i)])
    # replace missing data with data from duplicate record
    df[which(df[, ID] %in% df_dupl_uni[, ID]), i] <- df_dupl_uni[match(df[which(df[, ID] %in% df_dupl_uni[, ID]), ID], df_dupl_uni[, ID]), i]

    return(df)
    }      
}

# define the columns to run the function on by name
col_names<-colnames(ir[,1:4])

# pass ir to the function
ir2<-replaceNAs_dupl(ir, "unique_flower_ID", col_names)

Вывод работает, но только для первого столбца;цикл просто не зациклится.

  1. Может кто-нибудь объяснить, что я делаю неправильно?

  2. Есть ли лучший способ полностьюделать то, что я пытаюсь?

Ответы [ 2 ]

0 голосов
/ 08 февраля 2019

Вот простое (но несколько наивное) решение для объединения записей.

library(dplyr)
ir2 <- ir %>% 
  group_by(unique_flower_ID) %>% 
  summarise_if(is.numeric, mean, na.rm=TRUE) %>% 
  ungroup()

Ограничения:

  • Это объединяет записи, то есть больше не будет дубликатов, которые могутнежелательно.
  • Если есть две дубликаты записей, которые не совпадают, то принимается среднее значение.mean можно заменить другой функцией сводки, но может быть предпочтительнее выдать какую-то ошибку, если у вас когда-либо было две записи с одинаковым идентификатором, но разными значениями в данном столбце.
  • Если все записи су данного идентификатора есть NA в столбце, он возвращает NaN.
0 голосов
/ 08 февраля 2019

Как сказал @jdobres, ваша первоначальная проблема заключается в том, что вы return входите в цикл, прежде чем он сможет продолжить итерацию.

Я предлагаю в качестве альтернативной реализации следующий код:

library(dplyr)
ir %>%
  group_by(unique_flower_ID) %>%
  mutate_at(vars(Sepal.Length:Petal.Width), ~ if_else(is.na(.), na.omit(.)[1], .)) %>%
  ungroup()
# # A tibble: 9 x 6
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species unique_flower_ID
#          <dbl>       <dbl>        <dbl>       <dbl> <fct>              <int>
# 1          5.1         3.5          1.4         0.2 setosa                 1
# 2          5.1         3.5          1.4         0.2 setosa                 1
# 3          4.9         3            1.4         0.2 setosa                 2
# 4          4.7         3.2          1.3         0.2 setosa                 3
# 5          4.7         3.2          1.3         0.2 setosa                 3
# 6          4.6         3.1          1.5         0.2 setosa                 4
# 7          5           3.6          1.4         0.2 setosa                 5
# 8          5           3.6          1.4         0.2 setosa                 5
# 9          5.4         3.9          1.7         0.4 setosa                 6

Как это работает:

  1. Группировка по полю ID означает, что приведенный ниже код будет выполнен один раз для каждого уникального идентификатора;Это означает, что при первом вызове функции mutate_at она будет видеть только

       Sepal.Length Sepal.Width Petal.Length Petal.Width Species unique_flower_ID
    1           5.1          NA          1.4          NA  setosa                1
    11           NA         3.5           NA         0.2  setosa                1
    
  2. mutate_at выполняет одну и ту же функцию в одном или нескольких столбцах, в этом случае все столбцы между(включая) Sepal.Length и Petal.Width;

  3. , вызываемая функция использует rlang "нотацию тильды", в которой точка . будет заменена навектор данных в каждом столбце, эффективно выполняющий каждый из

    if_else(is.na(Sepal.Length), na.omit(Sepal.Length)[1], Sepal.Length)
    if_else(is.na(Sepal.Width), na.omit(Sepal.Width)[1], Sepal.Width)
    if_else(is.na(Petal.Length), na.omit(Petal.Length)[1], Petal.Length)
    if_else(is.na(Petal.Width), na.omit(Petal.Width)[1], Petal.Width)
    

    (это могло бы быть просто mutate_at(..., function(a) if_else(is.na(a), na.omit(a)[1], a)), но мне нравятся более компактные обозначения ~)

  4. внутри этой функции для каждого значения в векторе, если оно не равно NA, то оно используется без изменений;если это NA, тогда он заменяет NA на первое не-1039 * значение в кадре («первое» означает первое в кадре, поэтому, если имеется несколько различных значений, вы должны контролировать, кто получает приоритетпо порядку строк);

  5. это защищает от отсутствия доступных данных в столбце с помощью na.omit(.)[1]: если na.omit(.) возвращает ничего (вектордлины 0, как в na.omit(NA)), тогда [1] заставляет его вернуть что-то , что в нашем случае (другое) NA, поэтому мы сохраняем полный вектор.Например:

    ir$Sepal.Length[1:2] <- NA
    ir %>%
      group_by(unique_flower_ID) %>%
      mutate_at(vars(Sepal.Length:Petal.Width), ~ if_else(is.na(.), na.omit(.)[1], .)) %>%
      ungroup()
    # # A tibble: 9 x 6
    #   Sepal.Length Sepal.Width Petal.Length Petal.Width Species unique_flower_ID
    #          <dbl>       <dbl>        <dbl>       <dbl> <fct>              <int>
    # 1         NA           3.5          1.4         0.2 setosa                 1
    # 2         NA           3.5          1.4         0.2 setosa                 1
    # 3          4.9         3            1.4         0.2 setosa                 2
    # 4          4.7         3.2          1.3         0.2 setosa                 3
    # 5          4.7         3.2          1.3         0.2 setosa                 3
    # 6          4.6         3.1          1.5         0.2 setosa                 4
    # 7          5           3.6          1.4         0.2 setosa                 5
    # 8          5           3.6          1.4         0.2 setosa                 5
    # 9          5.4         3.9          1.7         0.4 setosa                 6
    

(PS: поскольку вы новичок в R, я должен уточнить: использование тильды rlang является уникальным для tidyverseпакеты; он не обязательно доступен в других пакетах / функциях, если явно не указано иное. Для них следует использовать более общую анонимную функцию (например, function(a) { ... }) или именованную функцию.)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...