Изменить порядок нескольких необязательных подстрок

Question

Это бит, похожий на этот вопрос , но у меня есть несколько подстрок, которые могут появиться, а могут и не появиться.

Код подстроки для двух разных измерений, в моем примере «test» и « глаз ». Они могут происходить в любом мыслимом порядке. Переменные могут быть закодированы по-разному - в моем примере «method | test» будет двумя способами кодирования для «test», а также «r | re | l | le» разными способами кодирования для глаз.

Я нашел запутанное решение, использующее цепочку из семи (!) gsub вызовов, и мне стало интересно, есть ли более краткий способ.

x <- c("id", "r_test", "l_method", "test_re", "method_le", "test_r_old", 
       "test_l_old", "re_test_new","new_le_method", "new_r_test")
x
#>  [1] "id"            "r_test"        "l_method"      "test_re"      
#>  [5] "method_le"     "test_r_old"    "test_l_old"    "re_test_new"  
#>  [9] "new_le_method" "new_r_test"

Желаемый результат

#>  [1] "id"         "r_test"     "l_test"     "r_test"     "l_test"    
#>  [6] "r_test_old" "l_test_old" "r_test_new" "l_test_new" "r_test_new"

Как я туда попал (запутанный)

## Unify codes for variables, I use the underscores to make it more unique for future regex 
clean_test<- gsub("(?<![a-z])(test|method)(?![a-z])", "_test_", tolower(x), perl = TRUE)
clean_r <- gsub("(?<![a-z])(r|re)(?![a-z])", "_r_", tolower(clean_test), perl = TRUE)
clean_l <- gsub("(?<![a-z])(l|le)(?![a-z])", "_l_", tolower(clean_r), perl = TRUE)

## Now sort, one after the other
sort_eye <- gsub("(.*)(_r_|_l_)(.*)", "\\2\\1\\3", clean_l, perl = TRUE)
sort_test <- gsub("(_r_|_l_)(.*)(_test_)(.*)", "\\1\\3\\2\\4", sort_eye, perl = TRUE)

## Remove underscores
clean_underscore_mult <- gsub("_{2,}", "_", sort_test)
clean_underscore_ends <- gsub("^_|_$", "", clean_underscore_mult)

clean_underscore_ends
#>  [1] "id"         "r_test"     "l_test"     "r_test"     "l_test"    
#>  [6] "r_test_old" "l_test_old" "r_test_new" "l_test_new" "r_test_new"

Я был бы уже очень признателен за предложение, как лучше двигаться от ## Now sort, one after the other вниз ...

Answer 1

Как насчет токенизации строки и использования вместо нее таблиц поиска? Я буду использовать data.table, чтобы помочь, но эта идея естественно сочетается с другими грамматиками данных.

library(data.table)
# build into a table, keeping track of an ID 
#   to say which element it came from originally
l = strsplit(x, '_', fixed=TRUE)
DT = data.table(id = rep(seq_along(l), lengths(l)), token = unlist(l))

Теперь создайте таблицу поиска:

# defined using fread to make it easier to see
#   token & match side-by-side; only define tokens
#   that actually need to be changed here
lookups = fread('
token,match
le,l
re,r
method,test
')

Теперь объедините:

# default value is the token itself
DT[ , match := token]
# replace anything matched
DT[lookups, match := i.match, on = 'token']

Затем используйте порядок factor, чтобы получить токены в правильном порядке:

# the more general [where you don't have an exact list of all the possible
#   tokens ready at hand] is a bit messier -- you might do something
#   similar to setdiff(unique(match), lookups$match)
DT[ , match := factor(match, levels = c('id', 'r', 'l', 'test', 'old', 'new'))]
# sort to this new order
setorder(DT, id, match)

Наконец, снова объедините ( агрегация ), чтобы получить результат:

DT[ , paste(match, collapse='_'), by = id]$V1
#  [1] "id"         "r_test"     "l_test"     "r_test"     "l_test" 
#  [6] "r_test_old" "l_test_old" "r_test_new" "l_test_new" "r_test_new"

Answer 2

Вот однострочник с вложенным sub, который преобразует x без каких-либо промежуточных шагов:

sub("^(\\w+)_(r|re|l|le)", "\\2_\\1", 
     sub("method", "test", 
          sub("(l|r)e", "\\1", 
               sub("(^new)_(\\w+_\\w+)$", "\\2_\\1", x))))

# [1] "id"  "r_test"  "l_test"  "r_test"  "l_test"  "r_test_old" 
# [7] "l_test_old"  "r_test_new"  "l_test_new" "r_test_new"

Данные:

x <- c("id", "r_test", "l_method", "test_re", "method_le", "test_r_old", 
       "test_l_old", "re_test_new","new_le_method", "new_r_test")

Answer 3

Сильно вдохновлено и построено на ответе пользователя MichaelChirico , это функция, использующая только базовый R, которая (теоретически) должна работать с любым количеством подстрок для сортировки. Список определяет сортировку (по ее элементам) и указывает все способы кодирования токенов по умолчанию (имена списков).

## I've added some more ways to code for right and left eyes, as well as different further strings that are not known. 

x <- c("id", "r_random_test_old", "r_test", "r_test_else", "l_method", "test_re", "method_le", "test_od_old", 
       "test_os_old", "re_mth_new","new_le_method", "new_r_test_random")
x
#>  [1] "id"                "r_random_test_old" "r_test"           
#>  [4] "r_test_else"       "l_method"          "test_re"          
#>  [7] "method_le"         "test_od_old"       "test_os_old"      
#> [10] "re_mth_new"        "new_le_method"     "new_r_test_random"

sort_substr(x, list(r = c("od","re"), l = c("os","le"), test = c("method", "mth"), time = c("old","new")))
#>  [1] "id"                 "r_test_time_random" "r_test"            
#>  [4] "r_test_else"        "l_test"             "r_test"            
#>  [7] "l_test"             "r_test_time"        "l_test_time"       
#> [10] "r_test_time"        "l_test_time"        "r_test_time_random"

sort_substr

sort_substr <- function(x, list_substr) {
  lookups <- data.frame(match = rep(names(list_substr), lengths(list_substr)), 
                        token = unlist(list_substr))
  l <- strsplit(x, "_", fixed = TRUE)
  DF <- data.frame(id = rep(seq_along(l), lengths(l)), token = unlist(l))
  match_token <- lookups$match[match(DF$token, lookups$token)]
  DF$match <- ifelse(is.na(match_token), DF$token, match_token)
  rest_token <- base::setdiff(DF$match, names(list_substr))
  DF$match <- factor(DF$match, levels = c(names(list_substr), rest_token))
  DF <- DF[with(DF, order(id, match)), ]
  out <- vapply(split(DF$match, DF$id), 
         paste, collapse = "_", 
         FUN.VALUE = character(1), 
         USE.NAMES = FALSE)
  out
}