自動修改複雜的字符向量

Question

我有一個複雜的字符向量，其中向量的每個元素由數字和字母組成。我想簡化這個向量，以便將數字和/或字母序列放入範圍中。下面是一個例子，輸入和輸出向量看起來應該像：

# Input vector 
input_vec <- c("1,2,3,4,5", "1,2,3,5,6,7,8", "2,3,4,5", "A,B,C", "1,2,3,4,5,A,B,8,9,10,11") 

# Here some function should be applied, to create the desired output vector automatically 

# Desired output vector 
output_vec <- c("1-5", "1-3,5-8", "2-5", "A-C", "1-5,A-B,8-11") 

我相信必須有一個方法來建立一個功能或使用包，爲此在一個自動化的方式，但不幸的是我正在努力尋找解決方案。任何幫助，高度讚賞！

更新：增加了一個更復雜的矢量

input_vec2 <- c("1,2,3,4,5", "1,2,3,5,6,7,8", "2,3,4,5", "A,B,C", "1,2,3,4,5,A,B,8,9,10,11", 
"1", "1,2,3,-4", "lala,3") # This part is new 

output_vec2 <- c("1-5", "1-3,5-8", "2-5", "A-C", "1-5,A-B,8-11", 
"1", "1-3,-4", "lala,3") # This part is new 

Answer 1

這也許是有點臃腫依舊，但我想下來把問題分解成更小的函數。他們來了。首先是一些一般的輔助功能

# Is value numeric? 
is_numeric <- function(x) suppressWarnings(!is.na(as.numeric(x))) 
# Greate IDs for sequences of values using run-length encoding 
rleg <- function(x) { 
    r <- rle(x); 
    val <- list(group_value = r$values) 
    r$values <- seq_along(r$values); 
    val$group_id <- inverse.rle(r) 
    val 
} 

而現在的問題

collapse_sequence <- function(x) { 
    if (length(x)>1) { 
    paste0(x[1],"-", x[length(x)]) 
    } else { 
    x 
    } 
} 

find_runs <- function(x, key=x) { 
    nona <- function(x) {x[is.na(x)]<-0; x} 
    run <- cumsum(nona(c(1,diff(key)))!=1) 
    Map(collapse_sequence, split(x, run)) 
} 

collapse_numeric <- function(x) { 
    paste(sapply(find_runs(x, as.numeric(x)), collapse_sequence), collapse=",") 
} 

collapse_character <- function(x) { 
    key <- sapply(x, function(z) ifelse(nchar(z)==1, utf8ToInt(z), NA)) 
    paste(sapply(find_runs(x, key), collapse_sequence), collapse=",") 
} 

collapse_runs <- Vectorize(function(x) { 
    x <- strsplit(x, ",")[[1]] 
    type <- ifelse(is_numeric(x), 1, ifelse(nchar(x)==1, 2, 3)) 
    group <- rleg(type) 
    runs <- Map(function(v, type) { 
    if(type==1) { 
     collapse_numeric(v) 
    } else { 
     collapse_character(v) 
    } 
    },split(x, group$group_id), group$group_value) 
    paste(runs, collapse=",") 
}) 

最後，我們與您輸入測試一些更具體的助手

input_vec <- c("1,2,3,4,5", "1,2,3,5,6,7,8", "2,3,4,5", "A,B,C", "1,2,3,4,5,A,B,8,9,10,11") 
unname(collapse_runs(input_vec)) 
# [1] "1-5"   "1-3,5-8"  "2-5"   "A-C"   "1-5,A-B,8-11" 
input_vec2 <- c("1,2,3,4,5", "1,2,3,5,6,7,8", "2,3,4,5", "A,B,C", "1,2,3,4,5,A,B,8,9,10,11", "1", 
      "1,2,3,-4", "lala,3") 
unname(collapse_runs(input_vec2)) 
# [1] "1-5"   "1-3,5-8"  "2-5"   "A-C"   "1-5,A-B,8-11" 
# [6] "1"   "1-3,-4"  "lala,3"