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

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

1 голос
/ 19 июня 2020

Этот вопрос основан на ответе на мой предыдущий вопрос здесь .

У меня действительно есть этот фрейм данных: 

   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@access_walk@239.832753247906
2            pt interaction@pt@15802.7875589648
3  pt interaction@transit_walk@71.9224502466834
4            pt interaction@pt@2958.24597970046
5                 pt interaction@transit_walk@0
6            pt interaction@pt@9555.56835806127

Я пытаюсь применить эту строку кода к новому 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 или более сильного, но я не уверен, как это сделать успешно.

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

Вот некоторые данные, которые вы можете попробовать 

c("home@access_walk@239.832753247906", "pt interaction@pt@15802.7875589648", 
"pt interaction@transit_walk@71.9224502466834", "pt interaction@pt@2958.24597970046", 
"pt interaction@transit_walk@0", "pt interaction@pt@9555.56835806127", 
"pt interaction@egress_walk@30.3179179069699", "outside@outside@0", 
"outside@transit_walk@1297.99350659659", "outside@access_walk@1276.63861815233", 
"pt interaction@pt@9742.20104372851", "pt interaction@transit_walk@0", 
"pt interaction@pt@2803.34183955275", "pt interaction@transit_walk@71.9224502466834", 
"pt interaction@pt@15771.4329240409", "pt interaction@egress_walk@239.832753247906", 
"home@car@1394.67082361688", "leisure@car@5821.64140177716", 
"other@car@7108.69818469563", "leisure@car@907.045868908635", 
"leisure@car@3745.78146465346", "other@car@4881.29027890954", 
"leisure@car@8608.59413379034", "other@car@2432.06879749157", 
"leisure@car@29495.3012946273", "home@walk@829.310724400574", 
"adpt interaction@adpt@NaN", "leisure@walk@349.426767872144", 
"adpt interaction@walk@349.426767872144", "home@adpt@NaN", "@walk@829.310724400574", 
"home@@NA", "outside@transit_walk@0", "outside@outside@2685.10848634168", 
"outside@transit_walk@1579.84069059055", "outside@access_walk@497.391306877403", 
"pt interaction@pt@16279.2324932242", "pt interaction@transit_walk@73.4575925301006", 
"pt interaction@pt@8378.18725510985", "pt interaction@egress_walk@82.9679691920702", 
"outside@outside@0", "outside@transit_walk@7401.03799340123", 
"outside@access_walk@2415.26847612599", "pt interaction@pt@3166.7707680546", 
"pt interaction@transit_walk@25.9599226522074", "pt interaction@pt@9742.20104372851", 
"pt interaction@transit_walk@0", "pt interaction@pt@3304.51684567956", 
"pt interaction@transit_walk@71.9224502466834", "pt interaction@pt@15771.4329240409", 
"pt interaction@egress_walk@1130.06898457632", "outside@@NA", 
"outside@car@12190.0484515128", "leisure@car@919.846708794504", 
"work@car@10856.016347145", "outside@@NA", "outside@car@21256.0166718921", 
"outside@outside@22.0252073075135", "outside@car@9762.76940959566", 
"leisure@car@18444.2491869679", "outside@@NA", "outside@access_walk@70.6132834491933", 
"pt interaction@pt@17218.6538939194", "pt interaction@transit_walk@23.6581790256904", 
"pt interaction@pt@1110.88993757668", "pt interaction@egress_walk@491.921224376535", 
"outside@access_walk@491.921224376535", "pt interaction@pt@996.28558692335", 
"pt interaction@transit_walk@23.6581790256904", "pt interaction@pt@8771.85928231322", 
"pt interaction@pt@10781.2168842582", "pt interaction@egress_walk@354.239348504684", 
"work@car_passenger@16604.1760089938", "outside@@NA", "outside@car@18242.0048943686", 
"other@car@17894.6970194158", "outside@@NA", "outside@access_walk@94.1024618021142", 
"pt interaction@pt@9894.30679886176", "pt interaction@transit_walk@0", 
"pt interaction@pt@8526.8187238386", "pt interaction@egress_walk@466.471389116105", 
"outside@access_walk@466.471389116105", "pt interaction@pt@7848.87749922433", 
"pt interaction@transit_walk@0", "pt interaction@pt@9356.36178170144", 
"pt interaction@egress_walk@296.224378913027", "work@access_walk@319.056167403868", 
"pt interaction@pt@1575.85855224964", "pt interaction@egress_walk@94.1024618021142", 
"outside@@NA", "outside@access_walk@94.1024618021142", "pt interaction@pt@9894.30679886176", 
"pt interaction@transit_walk@0", "pt interaction@pt@5432.39422808365", 
"pt interaction@egress_walk@449.125425814038", "outside@access_walk@449.125425814038", 
"pt interaction@pt@1005.87429745582", "pt interaction@transit_walk@23.6581790256904", 
"pt interaction@pt@5290.54733650491")

Ответы [ 2 ]

0 голосов
/ 19 июня 2020

Это метод грубой силы. Создайте пары всех значений 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 ...
0 голосов
/ 19 июня 2020

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

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)
...