Использование shift с mutate и case_when в dplyr в R: не работает должным образом

Question

Мои данные показывают изменения в размере зрачка. Когда значение равно -1 означает, что мигание. Я написал некоторый код для обнаружения появления и смещения мерцания, но у меня возникают проблемы с использованием функции shift.

Образец моих данных:

library(dplyr)
DataFrame<-structure(list(Pupil_Avg = c(7.174, 6.6910005, 6.518, 2.461, 
                                    2.182, 1.942, 1.942, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
                                    -1, -1, -1, -1, -1, -1, -1, 1.487, -1, -1, -1, -1, 2.202, 2.202, 
                                    2.281, 2.344)), row.names = c(NA, -481L), class = c("tbl_df", 
                                                                                        "tbl", "data.frame"))

Операции, которые я выполняю с этими данными:

DataFrame$BLINK_IDENTIFICATION <- ""

# set an arbitrary decrease value in pupil size
Pupil_Constriction = 3

DataFrame<-DataFrame %>%
  # removed the columns below as they're not necessary to work on the problem.
  #group_by(StimulusName, Name, StimuliBlock) %>%
  # if there is a reduction in pupil size of the value in Pupil_Constriction in the current row add "Blink Onset"
  mutate(BLINK_IDENTIFICATION = case_when((DataFrame$Pupil_Avg <= (shift(DataFrame$Pupil_Avg, 1L, type="lag")-Pupil_Constriction)) ~ "Blink Onset",
                                          # The next line of code is supposed to check the last row and if "Blink Onset" is contained in the previous row in BLINK_IDENTIFICATION AND the current Pupil_Avg value is NOT equal to -1, then the write "Blink Onset" to the current BLINK_IDENTIFICATION row 
                                          ( (shift(DataFrame$BLINK_IDENTIFICATION, 1L, type="lag")=="Blink Onset") & (DataFrame$Pupil_Avg != -1) ) ~ "Blink Onset",
# the next line of code write "Blink Offset" if previous row was -1, current is greater than -1, and the next row is NOT -1
                                          ( (shift(DataFrame$Pupil_Avg, 1L, type="lag")==-1) & (DataFrame$Pupil_Avg >-1) & (shift(DataFrame$Pupil_Avg, 1L, type="lead")!=-1)) ~ "Blink Offset",
# the next line write "Eye Closed" if current row equals -1
                                          (DataFrame$Pupil_Avg==-1) ~ "Eye Closed"))

Я пытаюсь определить начало и смещение мерцания, основываясь на изменениях значений в Pupil_Avg. Моя основная проблема связана со строкой кода ( (shift(DataFrame$BLINK_IDENTIFICATION, 1L, type="lag")=="Blink Onset") & (DataFrame$Pupil_Avg != -1) ) ~ "Blink Onset",

Эта строка должна проверять предыдущее значение строки BLINK_IDENTIFICATION, и если оно равно «Blink Onset», а текущее значение Pupil_Avg НЕ равно -1: записать «Blink Onset» в BLINK_IDENTIFICATION в текущей строке.

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

Спасибо за ваше время.

Answer 1

3 варианта вашего оператора case можно выполнить с помощью dplyr:

DataFrame <- DataFrame %>% 
  mutate(BLINK_IDENTIFICATION = case_when(Pupil_Avg == -1 ~ "Eye Closed",
                                          Pupil_Avg <= lag(Pupil_Avg) - Pupil_Constriction ~ "Blink Onset",
                                          lag(Pupil_Avg) == -1 & Pupil_Avg > -1 & lead(Pupil_Avg) != -1 ~ "Blink Offset",
                                          TRUE ~ ""))

# A tibble: 481 x 2
   Pupil_Avg BLINK_IDENTIFICATION
       <dbl> <chr>               
 1      7.17 ""                  
 2      6.69 ""                  
 3      6.52 ""                  
 4      2.46 Blink Onset         
 5      2.18 ""                  
 6      1.94 ""                  
 7      1.94 ""                  
 8     -1    Eye Closed          
 9     -1    Eye Closed          
10     -1    Eye Closed          
# ... with 471 more rows

Но условие lag(BLINK_IDENTIFICATION) == "Blink Onset" & Pupil_Avg != -1 рекурсивно зависит от предыдущего значения (см. Строки 5, 6, 7). Для этого вам понадобится петля.

for(i in 2:nrow(DataFrame)) {
  DataFrame$BLINK_IDENTIFICATION[i] = ifelse(DataFrame$BLINK_IDENTIFICATION[i-1]  == "Blink Onset" & DataFrame$Pupil_Avg[i] != -1, "Blink Onset", DataFrame$BLINK_IDENTIFICATION[i])
}

DataFrame
# A tibble: 481 x 2
   Pupil_Avg BLINK_IDENTIFICATION
       <dbl> <chr>               
 1      7.17 ""                  
 2      6.69 ""                  
 3      6.52 ""                  
 4      2.46 Blink Onset         
 5      2.18 Blink Onset         
 6      1.94 Blink Onset         
 7      1.94 Blink Onset         
 8     -1    Eye Closed          
 9     -1    Eye Closed          
10     -1    Eye Closed     

tail(DataFrame, 10)
# A tibble: 10 x 2
   Pupil_Avg BLINK_IDENTIFICATION
       <dbl> <chr>               
 1     -1    Eye Closed          
 2      1.49 ""                  
 3     -1    Eye Closed          
 4     -1    Eye Closed          
 5     -1    Eye Closed          
 6     -1    Eye Closed          
 7      2.20 Blink Offset        
 8      2.20 ""                  
 9      2.28 ""                  
10      2.34 ""       

Но вы также можете делать все в цикле for. Как вы можете видеть в конце данных некоторые не заполнены пробелы. Там вам нужно определить, что вы хотите с ними делать. Оставьте их как есть или заполните их.