квазислучайное назначение в data.frame с использованием алфавитного порядка строковой переменной - PullRequest
Новая
       3

квазислучайное назначение в data.frame с использованием алфавитного порядка строковой переменной

0 голосов
/ 21 декабря 2018

Мои данные выглядят примерно так. 

df <- 
data.frame(ID=rep(c(1:8),each=4),ID_code=rep(c("ab","xy","zz","ee","bl","gr","au","ie"),each=4),Seq=rep(c('A','AM','B','BM')),Group=rep(c('A','B','C','A'),each=4))

У меня есть три группы в моих данных.Для одной группы мне нужно получить случайное назначение.Я хотел бы сделать это в зависимости от переменной ID_code.Я уже нашел процент_ранка, который позволяет разбить данные на четыре подгруппы, взяв 4 раза по 25%.

Этот код работает, но он не очень аккуратный. 

df$TestSeq[df$Group=='C'] <- 'DS'

df$TestSeq[df$Group=='C' & percent_rank(df$ID_code[df$Group=='C'])<0.25 & df$Seq=='A'] <- 'MS'
df$TestSeq[df$Group=='C' & percent_rank(df$ID_code[df$Group=='C'])<0.25 & df$Seq=='AM'] <- 'SS'
df$TestSeq[df$Group=='C' & 0.25<=percent_rank(df$ID_code[df$Group=='C'])& percent_rank(df$ID_code[df$Group=='C'])<0.5 & df$Seq=='B'] <- 'MS'
df$TestSeq[df$Group=='C' & 0.25<=percent_rank(df$ID_code[df$Group=='C'])& percent_rank(df$ID_code[df$Group=='C'])<0.5 & df$Seq=='BM'] <- 'SS'
df$TestSeq[df$Group=='C' & 0.5<=percent_rank(df$ID_code[df$Group=='C'])& percent_rank(df$ID_code[df$Group=='C'])<0.75 & df$Seq=='AM'] <- 'MS'
df$TestSeq[df$Group=='C' & 0.5<=percent_rank(df$ID_code[df$Group=='C'])& percent_rank(df$ID_code[df$Group=='C'])<0.75 & df$Seq=='A'] <- 'SS'
df$TestSeq[df$Group=='C' & 0.75<=percent_rank(df$ID_code[df$Group=='C']) & df$Seq=='B'] <- 'MS'
df$TestSeq[df$Group=='C' & 0.75<=percent_rank(df$ID_code[df$Group=='C']) & df$Seq=='BM'] <- 'SS'

Может бытьесть также более короткий код?Я пытался передать это.Но я не делаю это. 

df %>% 
  filter(Group=='C') %>%
  mutate( TestSeq = case_when(
              percent_rank(ID_code)<0.25 & df$Seq=='A'  ~ 'MS',
              percent_rank(ID_code)<0.25 & df$Seq=='AM' ~ 'SS',
              percent_rank(ID_code)<0.5  &df$Seq=='AM' & 0.25 <= percent_rank(ID_code)  ~ 'MS', 
              TRUE ~ 'DS'
            )
    )

Ответы [ 3 ]

0 голосов
/ 21 декабря 2018

Благодаря @wibeasley я нашел решение, хотя и не короткое, оно довольно хорошо читаемое: 

df1 <- df %>% 
  filter(Group=='C') %>%
  mutate( TestSeq = case_when(
              percent_rank(ID_code)<0.25  & Seq=='A'                                    ~ 'MS',
              percent_rank(ID_code)<0.25  & Seq=='AM'                                   ~ 'SS',
              percent_rank(ID_code)<0.5   & Seq=='AM'  & 0.25 <= percent_rank(ID_code)  ~ 'MS',
              percent_rank(ID_code)<0.5   & Seq=='A'   & 0.25 <= percent_rank(ID_code)  ~ 'SS',
              percent_rank(ID_code)<0.75  & Seq=='B'   & 0.5  <= percent_rank(ID_code)  ~ 'MS',
              percent_rank(ID_code)<0.75  & Seq=='BM'  & 0.5  <= percent_rank(ID_code)  ~ 'SS',
                                            Seq=='BM'  & 0.75 <= percent_rank(ID_code)  ~ 'MS',
                                            Seq=='B'   & 0.75 <= percent_rank(ID_code)  ~ 'SS',
              TRUE ~ 'DS'
            )
    )


full_join(df,df1)

Учитывая все подсказки от wibeasley, я изменил код на это: 

df1a <- df %>% 
  #filter(Group=='C') %>%
  mutate( 
    code_rank = case_when(
      Group=='C' ~ percent_rank(ID_code)
    )
  ) %>%
  mutate(
    TestSeq = case_when(
      is.na(Group) | (Group!='C') ~ '0', # Or whatever

      Seq=='A'  & (code_rank < .25)    ~ 'MS',
      Seq=='A'  & (code_rank < .50)    ~ 'SS',
      Seq=='A'  & (code_rank < Inf)    ~ 'DS',

      Seq=='AM' & (code_rank < .25)    ~ 'SS',
      Seq=='AM' & (code_rank < .50)    ~ 'MS',
      Seq=='AM' & (code_rank < Inf)    ~ 'DS',

      Seq=='B'  & (code_rank < .50)    ~ 'DS',
      Seq=='B'  & (code_rank < .75)    ~ 'MS',
      Seq=='B'  & (code_rank < Inf)    ~ 'SS',

      Seq=='BM' & (code_rank < .50)    ~ 'DS',
      Seq=='BM' & (code_rank < .75)    ~ 'SS',
      Seq=='BM' & (code_rank < Inf)    ~ 'MS'
    )
  ) #%>% 
  dplyr::select(-code_rank)

Однако у этого есть одна проблема.Code_rank рассчитывается по всем идентификаторам, но должно рассчитываться только по группе == 'C'.Есть ли способ поместить фильтр в mutate / into case_when?Я также заметил, что процент_ранка рассчитывается как 4/7, потому что у меня есть дубликаты.Мое новое решение: 

df1a <- df %>% 
  filter(Group=='C') %>%
  filter(!duplicated(ID)) %>%
  mutate( 
    code_rank = percent_rank(ID_code)
    )

df <- left_join(df,df1a)

df <- df %>% group_by(ID) %>% fill(code_rank) #get code_rank in all rows

#View(df)
df1b <- df %>% 
  filter(Group=='C') %>%
  mutate(
    TestSeq = case_when(
      Seq=='A'  & (code_rank < .25)    ~ 'MS',
      Seq=='A'  & (code_rank < .50)    ~ 'SS',
      Seq=='A'  & (code_rank < Inf)    ~ 'DS',

      Seq=='AM' & (code_rank < .25)    ~ 'SS',
      Seq=='AM' & (code_rank < .50)    ~ 'MS',
      Seq=='AM' & (code_rank < Inf)    ~ 'DS',

      Seq=='B'  & (code_rank < .25)    ~ 'DS',
      Seq=='B'  & (code_rank < .75)    ~ 'MS',
      Seq=='B'  & (code_rank < Inf)    ~ 'SS',

      Seq=='BM' & (code_rank < .50)    ~ 'DS',
      Seq=='BM' & (code_rank < .75)    ~ 'SS',
      Seq=='BM' & (code_rank < Inf)    ~ 'MS'
    )
  ) 

df <- select(left_join(df,df1b),-code_rank)
0 голосов
/ 21 декабря 2018

Я лучше понимаю цель и вижу твой ответ.Звучит так, будто вы хотите, чтобы он был более кратким, что возможно, если вы используете свойство водопада dplyr::case_when() (т. Е. Если выполнение достигает k -й строки, вы можете быть уверены, что предыдущий k -1 строки имеют значение false. In позволяет вам опустить нижнюю границу для каждой строки.

Для каждого значения Seq я бы, вероятно, все еще поместил присвоение 'DS'Даже несмотря на то, что он является избыточным с последней строкой, шаблон, вероятно, будет проще поддерживать и отлаживать, если столь неожиданные значения не попадут в трещины. Эта небольшая неэффективность выполнения, вероятно, стоит надежности. 

df1a <- df %>% 
  filter(Group=='C') %>%
  mutate( 
    code_rank   = percent_rank(ID_code),
    TestSeq = case_when(
      Seq=='A'  & (code_rank < .25)    ~ 'MS',
      Seq=='A'  & (code_rank < .50)    ~ 'SS',
      Seq=='A'  & (code_rank < Inf)    ~ 'DS',

      Seq=='AM' & (code_rank < .25)    ~ 'SS',
      Seq=='AM' & (code_rank < .50)    ~ 'MS',
      Seq=='AM' & (code_rank < Inf)    ~ 'DS',

      Seq=='B'  & (code_rank < .25)    ~ 'DS',
      Seq=='B'  & (code_rank < .75)    ~ 'MS',
      Seq=='B'  & (code_rank < Inf)    ~ 'DS',

      Seq=='BM' & (code_rank < .50)    ~ 'DS',
      Seq=='BM' & (code_rank < .75)    ~ 'SS',
      Seq=='BM' & (code_rank < Inf)    ~ 'DS',

      TRUE ~ 'DS'
    )
  ) %>% 
  dplyr::select(-code_rank)

df2 <- full_join(df, df1a)

Наконец, если вы хотите избежать объединения, я думаю, вы можете удалить операторы filter() и full_join() и добавить следующую строку в начало case_when(): 

is.na(Group) | (Group=='C')   ~ '0' # Or whatever

Если вы это сделаетесохраняйте соединение, left_join() может быть более подходящим. И с любым из них я бы явно указывал столбцы, к которым вы присоединяетесь. Поскольку ваша программа со временем растет, вы не хотите, чтобы новые столбцы случайно использовались дляприсоединиться.

0 голосов
/ 21 декабря 2018

Ошибка в вашем третьем фрагменте связана с тем, что df явно указан в операторе mutate().Он имеет 32 строки, в то время как к mutate() подается только 8 строк (поскольку вы фильтровали по Group). 

library(magrittr)
library(rlang)  # For the `.data` pronoun

df %>% 
  filter(Group=='C') %>%
  mutate( 
    TestSeq = case_when(
      percent_rank(ID_code)<0.25 & Seq=='A'  ~ 'MS',
      percent_rank(ID_code)<0.25 & Seq=='AM' ~ 'SS',
      percent_rank(ID_code)<0.5  & Seq=='AM' & 0.25 <= percent_rank(ID_code)  ~ 'MS', 
      TRUE ~ 'DS'
    )
  )

Если вас беспокоит присвоение имен коллизиям с помощью Seq, используйте .data местоимение из пакета rlang. 

df %>% 
  filter(Group=='C') %>%
  mutate( 
    TestSeq = case_when(
      percent_rank(ID_code)<0.25 & .data$Seq=='A'  ~ 'MS',
      percent_rank(ID_code)<0.25 & .data$Seq=='AM' ~ 'SS',
      percent_rank(ID_code)<0.5  & .data$Seq=='AM' & 0.25 <= percent_rank(ID_code)  ~ 'MS', 
      TRUE ~ 'DS'
    )
  )

Результат: 

  ID ID_code Seq Group TestSeq
1  3      zz   A     C      DS
2  3      zz  AM     C      DS
3  3      zz   B     C      DS
4  3      zz  BM     C      DS
5  7      au   A     C      MS
6  7      au  AM     C      SS
7  7      au   B     C      DS
8  7      au  BM     C      DS

Вот еще два источника о .data: (a) виньетка dplyr и (b) «маски данных» в adv-r .

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

Нет похожих вопросов

...