Я пытаюсь найти эффективный способ разделить строку, например
"111110000011110000111000"
в вектор
[1] "11111" "00000" "1111" "0000" "111" "000"
где "0" и "1" могут быть любыми чередующимися символами.
Разделить строку на основе переменного символа в R
Ответ 1
Try
strsplit(str1, '(?<=1)(?=0)|(?<=0)(?=1)', perl=TRUE)[[1]]
#[1] "11111" "00000" "1111" "0000" "111" "000"
Update
Модификация решения @rawr с stri_extract_all_regex
library(stringi)
stri_extract_all_regex(str1, '(?:(\\w))\\1*')[[1]]
#[1] "11111" "00000" "1111" "0000" "111" "000"
stri_extract_all_regex(x1, '(?:(\\w))\\1*')[[1]]
#[1] "11111" "00000" "222" "000" "3333" "000" "1111" "0000" "111"
#[10] "000"
stri_extract_all_regex(x2, '(?:(\\w))\\1*')[[1]]
#[1] "aaaaa" "bb" "ccccccc" "bbb" "a" "d" "11111"
#[8] "00000" "222" "aaa" "bb" "cc" "d" "11"
#[15] "D" "aa" "BB"
Бенчмарки
library(stringi)
set.seed(24)
x3 <- stri_rand_strings(1, 1e4)
akrun <- function() stri_extract_all_regex(x3, '(?:(\\w))\\1*')[[1]]
#modified @thelatemail function to make it bit more general
thelate <- function() regmatches(x3,gregexpr("(?:(\\w))\\1*", x3,
perl=TRUE))[[1]]
rawr <- function() strsplit(x3, '(?<=(\\w))(?!\\1)', perl=TRUE)[[1]]
ananda <- function() unlist(read.fwf(textConnection(x3),
rle(strsplit(x3, "")[[1]])$lengths,
colClasses = "character"))
Colonel <- function() with(rle(strsplit(x3,'')[[1]]),
mapply(function(u,v) paste0(rep(v,u), collapse=''), lengths, values))
Cryo <- function(){
res_vector=rep(NA_character_,nchar(x3))
res_vector[1]=substr(x3,1,1)
counter=1
old_tmp=''
for (i in 2:nchar(x3)) {
tmp=substr(x3,i,i)
if (tmp==old_tmp) {
res_vector[counter]=paste0(res_vector[counter],tmp)
} else {
res_vector[counter+1]=tmp
counter=counter+1
}
old_tmp=tmp
}
res_vector[!is.na(res_vector)]
}
richard <- function(){
cs <- cumsum(
rle(stri_split_boundaries(x3, type = "character")[[1L]])$lengths
)
stri_sub(x3, c(1, head(cs + 1, -1)), cs)
}
nicola<-function(x) {
indices<-c(0,which(diff(as.integer(charToRaw(x)))!=0),nchar(x))
substring(x,indices[-length(indices)]+1,indices[-1])
}
richard2 <- function() {
cs <- cumsum(rle(strsplit(x3, NULL)[[1L]])[[1L]])
stri_sub(x3, c(1, head(cs + 1, -1)), cs)
}
system.time(akrun())
# user system elapsed
# 0.003 0.000 0.003
system.time(thelate())
# user system elapsed
# 0.272 0.001 0.274
system.time(rawr())
# user system elapsed
# 0.397 0.001 0.398
system.time(ananda())
# user system elapsed
# 3.744 0.204 3.949
system.time(Colonel())
# user system elapsed
# 0.154 0.001 0.154
system.time(Cryo())
# user system elapsed
# 0.220 0.005 0.226
system.time(richard())
# user system elapsed
# 0.007 0.000 0.006
system.time(nicola(x3))
# user system elapsed
# 0.190 0.001 0.191
На немного большей строке
set.seed(24)
x3 <- stri_rand_strings(1, 1e6)
system.time(akrun())
#user system elapsed
#0.166 0.000 0.155
system.time(richard())
# user system elapsed
# 0.606 0.000 0.569
system.time(richard2())
# user system elapsed
# 0.518 0.000 0.487
system.time(Colonel())
# user system elapsed
# 9.631 0.000 9.358
library(microbenchmark)
microbenchmark(richard(), richard2(), akrun(), times=20L, unit='relative')
#Unit: relative
# expr min lq mean median uq max neval cld
# richard() 2.438570 2.633896 2.365686 2.315503 2.368917 2.124581 20 b
#richard2() 2.389131 2.533301 2.223521 2.143112 2.153633 2.157861 20 b
# akrun() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 20 a
ПРИМЕЧАНИЕ: Пытался запустить другие методы, но требуется много времени
данные
str1 <- "111110000011110000111000"
x1 <- "1111100000222000333300011110000111000"
x2 <- "aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"
Ответ 2
Изменение темы:
x <- "111110000011110000111000"
regmatches(x,gregexpr("1+|0+",x))[[1]]
#[1] "11111" "00000" "1111" "0000" "111" "000"
Ответ 3
Возможно, вы можете использовать substr или read.fwf вместе с rle (хотя это вряд ли будет столь же эффективным, как любое решение на основе регулярных выражений):
x <- "111110000011110000111000"
unlist(read.fwf(textConnection(x),
rle(strsplit(x, "")[[1]])$lengths,
colClasses = "character"))
# V1 V2 V3 V4 V5 V6
# "11111" "00000" "1111" "0000" "111" "000"
Одним из преимуществ этого подхода является то, что он будет работать даже с, скажем:
x <- paste(c(rep("a", 5), rep("b", 2), rep("c", 7),
rep("b", 3), rep("a", 1), rep("d", 1)), collapse = "")
x
# [1] "aaaaabbcccccccbbbad"
unlist(read.fwf(textConnection(x),
rle(strsplit(x, "")[[1]])$lengths,
colClasses = "character"))
# V1 V2 V3 V4 V5 V6
# "aaaaa" "bb" "ccccccc" "bbb" "a" "d"
Ответ 4
Другой способ - добавить пробел между чередующимися цифрами. Это будет работать для любых двух, а не только 1 и 0. Затем используйте strsplit в пробеле:
x <- "111110000011110000111000"
(y <- gsub('(\\d)(?!\\1)', '\\1 \\2', x, perl = TRUE))
# [1] "11111 00000 1111 0000 111 000 "
strsplit(y, ' ')[[1]]
# [1] "11111" "00000" "1111" "0000" "111" "000"
Или более лаконично, как указывает @akrun:
strsplit(x, '(?<=(\\d))(?!\\1)', perl=TRUE)[[1]]
# [1] "11111" "00000" "1111" "0000" "111" "000"
также меняется \\d на \\w работает также
x <- "aaaaabbcccccccbbbad"
strsplit(x, '(?<=(\\w))(?!\\1)', perl=TRUE)[[1]]
# [1] "aaaaa" "bb" "ccccccc" "bbb" "a" "d"
x <- "111110000011110000111000"
strsplit(x, '(?<=(\\w))(?!\\1)', perl=TRUE)[[1]]
# [1] "11111" "00000" "1111" "0000" "111" "000"
Вы также можете использовать \K (а не явно использовать группы захвата, \\1 и \\2), которые я не вижу много, и не знаю, как это объяснить:}
AFAIK \\K сбрасывает начальную точку сообщенного соответствия, и все ранее используемые символы больше не включаются, в основном отбрасывая все, что соответствует этой точке.
x <- "1111100000222000333300011110000111000"
(z <- gsub('(\\d)\\K(?!\\1)', ' ', x, perl = TRUE))
# [1] "11111 00000 222 000 3333 000 1111 0000 111 000 "
Ответ 5
Оригинальный подход: Ниже приведен подход stringi, включающий rle().
x <- "111110000011110000111000"
library(stringi)
cs <- cumsum(
rle(stri_split_boundaries(x, type = "character")[[1L]])$lengths
)
stri_sub(x, c(1L, head(cs + 1L, -1L)), cs)
# [1] "11111" "00000" "1111" "0000" "111" "000"
Или вы можете использовать аргумент length в stri_sub()
rl <- rle(stri_split_boundaries(x, type = "character")[[1L]])
with(rl, {
stri_sub(x, c(1L, head(cumsum(lengths) + 1L, -1L)), length = lengths)
})
# [1] "11111" "00000" "1111" "0000" "111" "000"
Обновлено для эффективности:. Поняв, что base::strsplit() быстрее, чем stringi::stri_split_boundaries(), вот более эффективная версия моего предыдущего ответа, использующая только базовые функции.
set.seed(24)
x3 <- stri_rand_strings(1L, 1e6L)
system.time({
cs <- cumsum(rle(strsplit(x3, NULL)[[1L]])[[1L]])
substring(x3, c(1L, head(cs + 1L, -1L)), cs)
})
# user system elapsed
# 0.686 0.012 0.697
Ответ 6
Другой подход в случае использования mapply:
x="111110000011110000111000"
with(rle(strsplit(x,'')[[1]]),
mapply(function(u,v) paste0(rep(v,u), collapse=''), lengths, values))
#[1] "11111" "00000" "1111" "0000" "111" "000"
Ответ 7
Это не то, что искали OP (краткий код R), но подумал, что я попробую его в Rcpp, и оказался относительно простым и примерно в 5 раз быстрее, чем самые быстрые ответы на основе R.
library(Rcpp)
cppFunction(
'std::vector<std::string> split_str_cpp(std::string x) {
std::vector<std::string> parts;
int start = 0;
for(int i = 1; i <= x.length(); i++) {
if(x[i] != x[i-1]) {
parts.push_back(x.substr(start, i-start));
start = i;
}
}
return parts;
}')
И тестирование этих
str1 <- "111110000011110000111000"
x1 <- "1111100000222000333300011110000111000"
x2 <- "aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"
Дает следующий выход
> split_str_cpp(str1)
[1] "11111" "00000" "1111" "0000" "111" "000"
> split_str_cpp(x1)
[1] "11111" "00000" "222" "000" "3333" "000" "1111" "0000" "111" "000"
> split_str_cpp(x2)
[1] "aaaaa" "bb" "ccccccc" "bbb" "a" "d" "11111" "00000" "222" "aaa" "bb" "cc" "d" "11"
[15] "D" "aa" "BB"
И эталон показывает это примерно в 5-10 раз быстрее, чем R-решения.
akrun <- function(str1) strsplit(str1, '(?<=1)(?=0)|(?<=0)(?=1)', perl=TRUE)[[1]]
richard1 <- function(x3){
cs <- cumsum(
rle(stri_split_boundaries(x3, type = "character")[[1L]])$lengths
)
stri_sub(x3, c(1, head(cs + 1, -1)), cs)
}
richard2 <- function(x3) {
cs <- cumsum(rle(strsplit(x3, NULL)[[1L]])[[1L]])
stri_sub(x3, c(1, head(cs + 1, -1)), cs)
}
library(microbenchmark)
library(stringi)
set.seed(24)
x3 <- stri_rand_strings(1, 1e6)
microbenchmark(split_str_cpp(x3), akrun(x3), richard1(x3), richard2(x3), unit = 'relative', times=20L)
Сравнение:
Unit: relative
expr min lq mean median uq max neval
split_str_cpp(x3) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 20
akrun(x3) 9.675613 8.952997 8.241750 8.689001 8.403634 4.423134 20
richard1(x3) 5.355620 5.226103 5.483171 5.947053 5.982943 3.379446 20
richard2(x3) 4.842398 4.756086 5.046077 5.389570 5.389193 3.669680 20
Ответ 8
Простое решение for loop
x="aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"
res_vector=substr(x,1,1)
for (i in 2:nchar(x)) {
tmp=substr(x,i,i)
if (tmp==substr(x,i-1,i-1)) {
res_vector[length(res_vector)]=paste0(res_vector[length(res_vector)],tmp)
} else {
res_vector[length(res_vector)+1]=tmp
}
}
res_vector
#[1] "aaaaa" "bb" "ccccccc" "bbb" "a" "d" "11111" "00000" "222" "aaa" "bb" "cc" "d" "11" "D" "aa" "BB"
Или, может быть, немного быстрее с заранее выделенным вектором результатов
x="aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"
res_vector=rep(NA_character_,nchar(x))
res_vector[1]=substr(x,1,1)
counter=1
old_tmp=''
for (i in 2:nchar(x)) {
tmp=substr(x,i,i)
if (tmp==old_tmp) {
res_vector[counter]=paste0(res_vector[counter],tmp)
} else {
res_vector[counter+1]=tmp
counter=counter+1
}
old_tmp=tmp
}
res_vector[!is.na(res_vector)]
Ответ 9
Как насчет этого:
s <- "111110000011110000111000"
spl <- strsplit(s,"10|01")[[1]]
l <- length(spl)
sapply(1:l, function(i) paste0(spl[i],i%%2,ifelse(i==1 | i==l, "",i%%2)))
# [1] "11111" "00000" "1111" "0000" "111" "000"