Как использовать функцию which в сочетании с grep или stringr в R?

Этот вопрос основан на ответе на мой предыдущий вопрос a-specific-row-what-fulfi">здесь.

На самом деле у меня есть этот фрейм данных:

   activity_type     leg_mode route_distance
1           home  access_walk      239.83275
2 pt interaction           pt    15802.78756
3 pt interaction transit_walk       71.92245
4 pt interaction           pt     2958.24598
5 pt interaction transit_walk        0.00000
6 pt interaction           pt     9555.56836

Поскольку моя функция работает на векторной основе, я склеиваю столбцы вместе и работаю со следующим df, чтобы не потерять информацию:

     activity_type__leg_mode__route_distance
1             home@[email protected]
2            pt interaction@[email protected]
3  pt interaction@[email protected]
4            pt interaction@[email protected]
5                 pt interaction@transit_walk@0
6            pt interaction@[email protected]

Я пытаюсь применить эту строку кода к новому df:

r = rle(df$activity_type)
ix = c(
  which(head(r$values, -1) == "pt interaction" & tail(r$values, -1) == "outside"), # p before o
  which(head(r$values, -1) == "outside" & tail(r$values, -1) == "pt interaction") + 1) # o before p

Поэтому теперь мне нужна некоторая гибкость, так как новый df имеет не только pt interaction или outside, но и другие символы. Однако он должен проверять только начало строки. Я думал об использовании grep или strong, но я не уверен, как это сделать успешно.

В основном я хочу найти способ сделать это условие более гибким which(head(r$values, -1) == "pt interaction" & tail(r$values, -1) == "outside"), т.е. оно должно искать не "pt interaction", а "pt interaction<some varying, but irrelevant stuff>".

Вот некоторые данные для вас, чтобы попробовать

c("home@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@transit_walk@0", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "outside@outside@0", 
"outside@[email protected]", "outside@[email protected]", 
"pt interaction@[email protected]", "pt interaction@transit_walk@0", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"home@[email protected]", "leisure@[email protected]", 
"other@[email protected]", "leisure@[email protected]", 
"leisure@[email protected]", "other@[email protected]", 
"leisure@[email protected]", "other@[email protected]", 
"leisure@[email protected]", "home@[email protected]", 
"adpt interaction@adpt@NaN", "leisure@[email protected]", 
"adpt interaction@[email protected]", "home@adpt@NaN", "@[email protected]", 
"home@@NA", "outside@transit_walk@0", "outside@[email protected]", 
"outside@[email protected]", "outside@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"outside@outside@0", "outside@[email protected]", 
"outside@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@transit_walk@0", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "outside@@NA", 
"outside@[email protected]", "leisure@[email protected]", 
"work@[email protected]", "outside@@NA", "outside@[email protected]", 
"outside@[email protected]", "outside@[email protected]", 
"leisure@[email protected]", "outside@@NA", "outside@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"outside@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"work@[email protected]", "outside@@NA", "outside@[email protected]", 
"other@[email protected]", "outside@@NA", "outside@[email protected]", 
"pt interaction@[email protected]", "pt interaction@transit_walk@0", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"outside@[email protected]", "pt interaction@[email protected]", 
"pt interaction@transit_walk@0", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "work@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"outside@@NA", "outside@[email protected]", "pt interaction@[email protected]", 
"pt interaction@transit_walk@0", "pt interaction@[email protected]", 
"pt interaction@[email protected]", "outside@[email protected]", 
"pt interaction@[email protected]", "pt interaction@[email protected]", 
"pt interaction@[email protected]")

r stringr
person Yves    schedule 19.06.2020    source источник
comment
Мне непонятно, что вы пытаетесь сделать и каков ожидаемый результат.   -  person Chris Ruehlemann    schedule 19.06.2020
comment
@ChrisRuehlemann спасибо за комментарий. Пожалуйста, взгляните на обновленный вопрос.   -  person Yves    schedule 19.06.2020

Ответы (2)


arrow_upward
0
arrow_downward

Это метод грубой силы. Создайте пары всех значений activity_type, используя expand.grid. Затем используйте apply, чтобы просмотреть все эти пары и применить код обнаружения изменений, используя rle. В результате появится список всех точек изменения. Затем вы можете обрезать там, где это необходимо.

r = rle(data$activity_type)
combinations <- expand.grid(unique(r$values), unique(r$values))
names(combinations) <- c("first", "second")
combinations <- combinations %>% 
  mutate_if(is.factor, as.character) %>%
  mutate(labels = paste0(first, " <-> ",  second))

ix_list <- apply(combinations, 1, function(x) c(
  which(head(r$values, -1) == x[1] & tail(r$values, -1) == x[2]), # first before last
  which(head(r$values, -1) == x[2] & tail(r$values, -1) == x[1]) + 1)) # last before first
names(ix_list) <-combinations$labels
# remove empty list elements
ix_list <- Filter(length, ix_list)

С этим результатом:

> glimpse(ix_list)
List of 26
 $ pt interaction <-> home     : num [1:2] 4 2
 $ outside <-> home            : num 20
 $ leisure <-> home            : num [1:2] 12 6
 $ adpt interaction <-> home   : num [1:2] 16 14
 $  <-> home                   : num [1:2] 18 18
 $ home <-> pt interaction     : num [1:2] 1 5
 $ outside <-> pt interaction  : num [1:16] 3 20 22 29 31 36 38 42 44 3 ...
person Paul van Oppen    schedule 19.06.2020
comment
большое спасибо! Я просто не уверен, что это дает ожидаемый результат, или я неправильно понимаю вывод: D pt interaction <-> home : num [1:2] 4 2означает ли это, что в строке 4 и 2 есть изменение с pt interactoin на home? Потому что в данных это не совсем так. - person Yves; 19.06.2020
comment
ваш код также генерирует 4, 2 для пары pt_interaction и home. Мой код просто автоматически проходит через все возможные пары. - person Paul van Oppen; 21.06.2020

arrow_upward
0
arrow_downward

Вы ищете что-то подобное?

r = rle(df$activity_type)

ix = c(which(grepl("pt interaction", head(r$values, -1)) & 
             grepl('outside', tail(r$values, -1))), 
       which(grepl("outside", head(r$values, -1)) & 
             grepl('pt interaction', tail(r$values, -1))) + 1)
person Ronak Shah    schedule 19.06.2020