R: добавить пропорциональные строки и процент отсутствия выделения в качестве новых переменных в df - PullRequest
Новая
       45

R: добавить пропорциональные строки и процент отсутствия выделения в качестве новых переменных в df

0 голосов
/ 01 мая 2020

Это немного сложная проблема ...

Я хочу вычислить пропорциональное среднее для выбора переменных. Я также хочу рассчитать процент пропущенных переменных для того же выбора. То есть, если бы bhs_1:bhs4 было 1 2 3 NA, я бы ожидал увидеть пропорциональное среднее m = 2, а процент отсутствия = 0,25. Я знаю, NCOL(x) и length(x) дадут мне длину x, но я не уверен, как все это обернуть, чтобы получить мой результат. Я хочу связать это с моим DF для последующего анализа. У меня есть решение, которое работает, а именно: Тем не менее, я хочу, чтобы это было неоднократно, так было после более эффективного решения, чем повторять это снова и снова. Кроме того, мне нужно рассчитать значение строки на основе различных переменных, основанных на времени введения (protocol - это переменная времени в df ниже). В частности, у меня есть данные из двух разных протоколов, где во время протокола 1 были собраны переменные bhs_1:bhs_4, однако во время протокола 2 были собраны переменные bhsSF_1:bhsSF_4.

И, еще один поворот, у меня есть мера, которая является частью обязательной, а часть необязательной. В частности, msssi_1:mssi_4 являются обязательными пунктами, тогда как mssi_5:mssi8 являются необязательными, в зависимости от ответов первого. То есть, если участник набирает определенное число по первому, то продолжить администрирование второго, иначе прекратить. Таким образом, баллы действительно для этих являются средним значением длины выбора (т.е. 8 переменных), а не пропорциональным средним. Так что NA важны, но иногда они более или менее эквивалентны нулю, но не всегда, как это может быть на самом деле NA! Надеюсь, в этом есть смысл ...

Было бы предпочтительнее аккуратное решение, однако с базовой версией тоже все в порядке, так как я хотел бы однажды сделать это функцией, потому что мне нужно делать это регулярно. 

df <- df %>%
    select(bhs_1:bhs_4) %>%
    rowMeans(., na.rm = TRUE) %>%
    round(., digits = 2) %>%
    bind_cols(my_data, bhs_mean = .)


## this works to calculate the number missing from the selected variables
df %>%
    select(bhs_1:bhs_4) %>%
    apply(., MARGIN = 1, function(x) sum(is.na(x)))
## just not sure how to bind this as a new variables based on the number of NAs
## divided by length of selection
## I now that NCOL(x) and length(x) will give me the number of rows in the selection, but how
## do I use this to calculate the percentage?

Минимальный набор данных. 

structure(list(protocol = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, NA
), uci = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, NA), pa_1 = c(NA,
2L, NA, 5L, NA, 2L, NA, 5L, NA), pa_2 = c(NA, 4L, NA, 5L, NA,
4L, NA, 5L, NA), pa_3 = c(NA, 2L, NA, 5L, NA, NA, NA, 5L, NA),
    pa_4 = c(NA, 5L, NA, 5L, NA, 5L, NA, 5L, NA), dass_1 = c(1L,
    1L, 2L, 3L, NA, 1L, 2L, 3L, NA), dass_2 = c(1L, 1L, 2L, 2L,
    1L, 1L, 2L, NA, NA), dass_3 = c(2L, 2L, NA, 3L, 2L, 2L, NA,
    NA, NA), dass_4 = c(1L, 3L, 0L, 3L, 1L, 3L, NA, NA, NA),
    bhsSF_1 = c(NA, 1L, NA, 5L, NA, 1L, NA, 5L, NA), bhsSF_2 = c(NA,
    3L, NA, 6L, NA, 3L, NA, NA, NA), bhsSF_3 = c(NA, 3L, NA,
    6L, NA, 3L, NA, 6L, NA), bhsSF_4 = c(NA, 3L, NA, 5L, NA,
    3L, NA, 5L, NA), bhs_1 = c(5L, NA, 1L, NA, 5L, NA, 5L, NA,
    NA), bhs_2 = c(5L, NA, 1L, NA, 0L, NA, 5L, NA, NA), bhs_3 = c(6L,
    NA, 0L, NA, 1L, NA, 0L, NA, NA), bhs_4 = c(5L, NA, 1L, NA,
    0L, NA, 1L, NA, NA), mssi_1 = c(0L, 0L, 3L, 2L, 0L, 0L, 3L,
    2L, NA), mssi_2 = c(0L, 1L, 2L, 1L, 0L, 1L, 2L, 1L, NA),
    mssi_3 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, NA, NA), mssi_4 = c(0L,
    0L, 0L, 0L, 0L, 0L, 0L, 0L, NA), mssi_5 = c(NA, NA, 3L, 2L,
    NA, NA, 3L, 2L, NA), mssi_6 = c(NA, NA, 3L, 2L, NA, NA, 3L,
    2L, NA), mssi_7 = c(NA, NA, 3L, 2L, NA, NA, NA, NA, NA),
    mssi_8 = c(NA, NA, 1L, 1L, NA, NA, 1L, 1L, NA)), class = "data.frame", row.names = c(NA,
-9L))

БОНУСНЫЙ ТУР

Как я уже говорил, я буду делать это неоднократно, поэтому оборачивать это в функцию было бы идеально. Я никогда не писал функции, так что если бы вы могли показать мне, если и как это можно сделать, это было бы здорово!

1 Ответ

0 голосов
/ 03 мая 2020

Не смог понять ваш второй параграф, не могли бы вы описать его с выводом. Для первого запроса вы можете использовать нижеприведенную функцию, которая будет вычислять среднее значение, счетчик заполнения: 

CalculatorFun1<- function(df,protocol_Type){

  # protocol_Type: can take values 1/2 , based on your data
  varList<-c()
  df<-cbind("Row_number"=row.names(df),df) # adding row_number for merging the datasets
  df$Row_number<- as.character(df$Row_number)

  if(protocol_Type==1){
    varList= names(df)[grepl("bhs_",names(df))]
  } else if(protocol_Type==2){
    varList= names(df)[grepl("bhsSF_",names(df))]
  } else {
    stop("Enter correct value for protocol_Type")
  }

  temp<- df %>%
    select(varList) %>%
    mutate(Row_number=row.names(df),
           NAcnt=apply(., 1, function(x) sum(is.na(x))),
           cnt=apply(., 1, function(x) length(x)),
           Fill_Prop=1-(NAcnt/cnt),
           Avrg=round(rowMeans(.,na.rm = T),2)
    ) %>% select(Row_number,NAcnt,cnt,Fill_Prop,Avrg)

  Final_df<-df %>% left_join(temp, by =c("Row_number"="Row_number"))

  return(Final_df)

}

#call function for a protocal type
df_out<-CalculatorFun1(df,protocol_Type = 2)
...