Заменить строку, если она отличается от последней и следующей в векторе - PullRequest
Новая
       25

Заменить строку, если она отличается от последней и следующей в векторе

0 голосов
/ 09 марта 2019

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

agent_id<-c("1","1","1","2","2","2","2")
date<-c("2007-02-01","2007-02-02","2007-02-05","2000-05-01","2000-05-02","2000-05-10","2000-05-20")
office<-c("A","A","B","C","D","C","C")
mydata<-data.frame(agent_id,date,office)

Я хочу заменить выброс в офисном векторе, если он отличается от последнего наблюдения и следующего наблюдения в каждом agent_id. Например, для agent_id = 1 я не хочу ничего заменять. Для agent_id = 2 я хочу заменить «D» на «C» в офисе, потому что я наблюдаю C как до, так и после. Есть ли способы сделать это с помощью dplyr? Кроме того, было бы лучше, если бы я мог определить отсечку для замены внешнего вида, т. Е. Если бы я наблюдал n одинаковых значений до и n одинаковых значений после.

1 Ответ

0 голосов
/ 09 марта 2019

Вы можете сделать: 

library(dplyr)

mydata %>%
  group_by(agent_id) %>%
  mutate(
    office = replaceOutliers(x = office, window = 1)
  )

Где replaceOutliers - это пользовательская функция: 

replaceOutliers <- function(x, window = 1, fixed_wind = FALSE) {

  x <- as.character(x)

  flag_Outl <- c(FALSE, sapply(2:(length(x) - 1), function(y) length(setdiff(x[pmax(1, y - window):pmax(1, y - 1)],
                                                     x[pmin(length(x) - 1, y + 1):pmin(length(x) - 1, y + window)])) == 0), FALSE)

  if (fixed_wind) {

  len_Lag <- sapply(1:length(x), function(y) length(office[pmax(1, y - window):pmax(1, y - 1)]))
  len_Lead <- sapply(1:length(x), function(y) length(office[pmin(length(x), y + 1):pmin(length(x), y + window)]))

  x <- sapply(1:length(flag_Outl), function(y) ifelse(flag_Outl[y] & len_Lag[y] == window & len_Lead[y] == window, x[y - 1], x[y]))

  }

  else x <- sapply(1:length(flag_Outl), function(y) ifelse(flag_Outl[y], x[y - 1], x[y]))

  return(x)

}

Вывод: 

# A tibble: 7 x 3
# Groups:   agent_id [2]
  agent_id date       office
  <fct>    <fct>      <chr> 
1 1        2007-02-01 A     
2 1        2007-02-02 A     
3 1        2007-02-05 C     
4 2        2000-05-01 C     
5 2        2000-05-02 C     
6 2        2000-05-10 C     
7 2        2000-05-20 C

Как вы увидите, яВы включили параметр fixed_wind - в основном вы можете решить, нужно ли вам всегда иметь точное количество наблюдений до и после, чтобы считать что-то выбросом.

По умолчанию это FALSE, и когда выувеличьте window до 2 в вашем примере, он все равно заменит D, но если вы установите его на TRUE, он останется таким, как есть (так как в группе есть только одно наблюдение перед ним): 

mydata %>%
  group_by(agent_id) %>%
  mutate(
    office2 = replaceOutliers(x = office, window = 2),
    office3 = replaceOutliers(x = office, window = 2, fixed_wind = TRUE)
  )

Вывод: 

# A tibble: 7 x 5
# Groups:   agent_id [2]
  agent_id date       office office2 office3
  <fct>    <fct>      <fct>  <chr>   <chr>  
1 1        2007-02-01 A      A       A      
2 1        2007-02-02 A      A       A      
3 1        2007-02-05 C      C       C      
4 2        2000-05-01 C      C       C      
5 2        2000-05-02 D      C       D      
6 2        2000-05-10 C      C       C      
7 2        2000-05-20 C      C       C
...