Geteilte Zeichenfolge basierend auf dem alternierenden Zeichen in R.

Question 1

Ich versuche einen effizienten Weg zu finden, um eine Zeichenfolge wie zu teilen

"111110000011110000111000"

in einen Vektor

[1] "11111" "00000" "1111" "0000" "111" "000"

Dabei können "0" und "1" beliebige abwechselnde Zeichen sein.

Question 2

Versuchen

strsplit(str1, '(?<=1)(?=0)|(?<=0)(?=1)', perl=TRUE)[[1]]
#[1] "11111" "00000" "1111"  "0000"  "111"   "000"

Aktualisieren

Eine Modifikation der Lösung von @ rawr mit 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"

Benchmarks

library(stringi) 
set.seed(24)
x3 <- stri_rand_strings(1, 1e4)

akrun <- function() stri_extract_all_regex(x3, '(?:(\\w))\\1*')[[1]]
#modified @thelatemail's 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

Auf einer etwas größeren Saite,

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

HINWEIS: Es wurde versucht, die anderen Methoden auszuführen, dies dauert jedoch lange

Daten

str1 <- "111110000011110000111000"
x1 <- "1111100000222000333300011110000111000"
x2 <- "aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"

Question 3

Variation zu einem Thema:

x <- "111110000011110000111000"
regmatches(x,gregexpr("1+|0+",x))[[1]]
#[1] "11111" "00000" "1111"  "0000"  "111"   "000"

Question 4

Sie könnten wahrscheinlich substroder read.fwfzusammen mit verwenden rle(obwohl es unwahrscheinlich ist, dass es so effizient ist wie jede Regex-basierte Lösung):

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"

Ein Vorteil dieses Ansatzes ist, dass er sogar mit beispielsweise funktioniert:

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"

Question 5

Eine andere Möglichkeit wäre, Leerzeichen zwischen den abwechselnden Ziffern einzufügen. Dies würde für zwei beliebige funktionieren, nicht nur für Einsen und Nullen. Verwenden Sie dann strsplitdas Leerzeichen:

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"

Oder prägnanter, wie @akrun hervorhebt:

strsplit(x, '(?<=(\\d))(?!\\1)', perl=TRUE)[[1]]
# [1] "11111" "00000" "1111"  "0000"  "111"   "000"

auch \\dzu arbeiten \\wfunktioniert auch

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"

Sie könnten auch verwenden \K(anstatt die Erfassungsgruppen explizit zu verwenden, \\1und \\2), die meiner Meinung nach nicht häufig verwendet werden, und ich weiß auch nicht, wie ich sie erklären soll:}

AFAIK \\Ksetzt den Startpunkt der gemeldeten Übereinstimmung zurück und alle zuvor verbrauchten Zeichen sind nicht mehr enthalten, wodurch im Grunde alles weggeworfen wird, was bis zu diesem Punkt übereinstimmt.

x <- "1111100000222000333300011110000111000"
(z <- gsub('(\\d)\\K(?!\\1)', ' ', x, perl = TRUE))
# [1] "11111 00000 222 000 3333 000 1111 0000 111 000 "

Question 6

Ursprünglicher Ansatz: Hier ist ein Stringi- Ansatz, der beinhaltet 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"

Oder Sie können das lengthArgument in verwendenstri_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"

Aus Effizienzgründen aktualisiert: Nachdem ich festgestellt habe, dass dies base::strsplit()schneller ist als stringi::stri_split_boundaries(), finden Sie hier eine effizientere Version meiner vorherigen Antwort, die nur Basisfunktionen verwendet.

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

Question 7

Ein anderer Ansatz für den Fall, mit 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"

Question 8

Es ist nicht wirklich das, wonach das OP gesucht hat (prägnanter R-Code), aber ich dachte, ich würde es versuchen Rcpp, und es stellte sich als relativ einfach und ungefähr 5x schneller heraus als die schnellsten R-basierten Antworten.

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;

  }')

Und diese zu testen

str1 <- "111110000011110000111000"
x1 <- "1111100000222000333300011110000111000"
x2 <- "aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"

Gibt die folgende Ausgabe

> 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"

Und ein Benchmark zeigt, dass er etwa 5-10x schneller ist als R-Lösungen.

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)

Vergleich:

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

Question 9

Einfache forSchleifenlösung

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"

Oder vielleicht ein bisschen schneller mit einem vorab zugewiesenen Ergebnisvektor

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

Question 10

Wie wäre es damit:

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"

Answer 1

75

Ich versuche einen effizienten Weg zu finden, um eine Zeichenfolge wie zu teilen

"111110000011110000111000"

in einen Vektor

[1] "11111" "00000" "1111" "0000" "111" "000"

Dabei können "0" und "1" beliebige abwechselnde Zeichen sein.

r CodeShaman
quelle

3

Meinen Sie Leistungseffizienz oder Code (Lesbarkeit) effizient?

freekvd

1

@freekvd Sorry, bedeutete Lesbarkeit effizient.

CodeShaman

Answer 2

3

Meinen Sie Leistungseffizienz oder Code (Lesbarkeit) effizient?

freekvd

Answer 3

1

@freekvd Sorry, bedeutete Lesbarkeit effizient.

CodeShaman

Answer 4

Versuchen

strsplit(str1, '(?<=1)(?=0)|(?<=0)(?=1)', perl=TRUE)[[1]]
#[1] "11111" "00000" "1111"  "0000"  "111"   "000"

Aktualisieren

Eine Modifikation der Lösung von @ rawr mit 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"

Benchmarks

library(stringi) 
set.seed(24)
x3 <- stri_rand_strings(1, 1e4)

akrun <- function() stri_extract_all_regex(x3, '(?:(\\w))\\1*')[[1]]
#modified @thelatemail's 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

Auf einer etwas größeren Saite,

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

HINWEIS: Es wurde versucht, die anderen Methoden auszuführen, dies dauert jedoch lange

Daten

str1 <- "111110000011110000111000"
x1 <- "1111100000222000333300011110000111000"
x2 <- "aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"

Answer 5

27

Variation zu einem Thema:

x <- "111110000011110000111000"
regmatches(x,gregexpr("1+|0+",x))[[1]]
#[1] "11111" "00000" "1111"  "0000"  "111"   "000"

die E-Mail
quelle

Answer 6

Sie könnten wahrscheinlich substroder read.fwfzusammen mit verwenden rle(obwohl es unwahrscheinlich ist, dass es so effizient ist wie jede Regex-basierte Lösung):

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"

Ein Vorteil dieses Ansatzes ist, dass er sogar mit beispielsweise funktioniert:

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"

Answer 7

Eine andere Möglichkeit wäre, Leerzeichen zwischen den abwechselnden Ziffern einzufügen. Dies würde für zwei beliebige funktionieren, nicht nur für Einsen und Nullen. Verwenden Sie dann strsplitdas Leerzeichen:

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"

Oder prägnanter, wie @akrun hervorhebt:

strsplit(x, '(?<=(\\d))(?!\\1)', perl=TRUE)[[1]]
# [1] "11111" "00000" "1111"  "0000"  "111"   "000"

auch \\dzu arbeiten \\wfunktioniert auch

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"

Sie könnten auch verwenden \K(anstatt die Erfassungsgruppen explizit zu verwenden, \\1und \\2), die meiner Meinung nach nicht häufig verwendet werden, und ich weiß auch nicht, wie ich sie erklären soll:}

AFAIK \\Ksetzt den Startpunkt der gemeldeten Übereinstimmung zurück und alle zuvor verbrauchten Zeichen sind nicht mehr enthalten, wodurch im Grunde alles weggeworfen wird, was bis zu diesem Punkt übereinstimmt.

x <- "1111100000222000333300011110000111000"
(z <- gsub('(\\d)\\K(?!\\1)', ' ', x, perl = TRUE))
# [1] "11111 00000 222 000 3333 000 1111 0000 111 000 "

Answer 8

Sie können den Code auf verkürzen strsplit(x, '(?<=(\\d))(?!\\1)', perl=TRUE)[[1]] (haben ihn aber in vielen Fällen nicht getestet :-)

akrun

Answer 9

@akrun Ich weiß, ich habe mich nur gefragt, ob Sie wissen, was dieses \\KDing in einem

regulären Ausdruck

Answer 10

Ich denke, der \\wAnsatz sollte in beiden Fällen funktionieren. Ich benutze nicht \\Kso viel, aber ich denke, Sie haben es in Ihrem Beitrag darüber erklärt.

Akrun

Answer 11

1

@akrun, wollte gerade den gleichen Kommentar abgeben.

A5C1D2H2I1M1N2O1R2T1

Answer 12

Ursprünglicher Ansatz: Hier ist ein Stringi- Ansatz, der beinhaltet 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"

Oder Sie können das lengthArgument in verwendenstri_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"

Aus Effizienzgründen aktualisiert: Nachdem ich festgestellt habe, dass dies base::strsplit()schneller ist als stringi::stri_split_boundaries(), finden Sie hier eine effizientere Version meiner vorherigen Antwort, die nur Basisfunktionen verwendet.

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

Answer 13

11

Ein anderer Ansatz für den Fall, mit 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"

Oberst Beauvel
quelle

Ihre Funktion ist schneller als die meisten Lösungen mit Ausnahme der stringi

akrun

Oh schön, ich hätte geglaubt, ohne zu testen, dass regmatchesschneller war! Irrglaube aufgrund der Tatsache, dass ich nicht weiß, was sich unter dieser Funktion verbirgt!

Oberst Beauvel

regmatchesist in der Regel schneller, kann aber auch von der regexverwendeten abhängen . Hier habe ich auf einen allgemeineren Fall getestet. Die Timings können unterschiedlich sein, wenn wir den gleichen regulären Ausdruck in @ thelatemails Post für eine binäre Zeichenfolge

testen

Answer 14

Ihre Funktion ist schneller als die meisten Lösungen mit Ausnahme der stringi

akrun

Answer 15

Oh schön, ich hätte geglaubt, ohne zu testen, dass regmatchesschneller war! Irrglaube aufgrund der Tatsache, dass ich nicht weiß, was sich unter dieser Funktion verbirgt!

Oberst Beauvel

Answer 16

regmatchesist in der Regel schneller, kann aber auch von der regexverwendeten abhängen . Hier habe ich auf einen allgemeineren Fall getestet. Die Timings können unterschiedlich sein, wenn wir den gleichen regulären Ausdruck in @ thelatemails Post für eine binäre Zeichenfolge

testen

Answer 17

Es ist nicht wirklich das, wonach das OP gesucht hat (prägnanter R-Code), aber ich dachte, ich würde es versuchen Rcpp, und es stellte sich als relativ einfach und ungefähr 5x schneller heraus als die schnellsten R-basierten Antworten.

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;

  }')

Und diese zu testen

str1 <- "111110000011110000111000"
x1 <- "1111100000222000333300011110000111000"
x2 <- "aaaaabbcccccccbbbad1111100000222aaabbccd11DaaBB"

Gibt die folgende Ausgabe

> 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"

Und ein Benchmark zeigt, dass er etwa 5-10x schneller ist als R-Lösungen.

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)

Vergleich:

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

Answer 18

2

Warten Sie, also ist meine Antwort schneller als die von Akrun? Interessant

Rich Scriven

Answer 19

2

Einfache forSchleifenlösung

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"

Oder vielleicht ein bisschen schneller mit einem vorab zugewiesenen Ergebnisvektor

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

cryo111
quelle

Ihre zweite Funktion ist schneller, aber immer noch hinter dem Ansatz von Colonel. +1

akrun

Ich werde eine weitere Modifikation hinzufügen, die es ein bisschen schneller macht. :)

cryo111

Ich versuche, Ihre Funktion mit einer 1e6-Zeichenfolge auszuführen. Es braucht eine lange Zeit.

Akrun

Ja, scheint nicht so gut zu skalieren.

cryo111

Nur ein bisschen schneller für den 1e4-Vektor. Aber immer noch langsam für den 1e6-Vektor.

cryo111

Answer 20

Ihre zweite Funktion ist schneller, aber immer noch hinter dem Ansatz von Colonel. +1

akrun

Answer 21

Ich werde eine weitere Modifikation hinzufügen, die es ein bisschen schneller macht. :)

cryo111

Answer 22

Ich versuche, Ihre Funktion mit einer 1e6-Zeichenfolge auszuführen. Es braucht eine lange Zeit.

Akrun

Answer 23

Ja, scheint nicht so gut zu skalieren.

cryo111

Answer 24

Nur ein bisschen schneller für den 1e4-Vektor. Aber immer noch langsam für den 1e6-Vektor.

cryo111

Answer 25

1

Wie wäre es damit:

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"

989
quelle

1

Zu Ihrer Information, typisch, um nur zu tun, sapply(seq_along(spl), ...)anstatt sich die Mühe zu machen, seine Länge als separate Var zu extrahieren.

Frank

Answer 26

1

Zu Ihrer Information, typisch, um nur zu tun, sapply(seq_along(spl), ...)anstatt sich die Mühe zu machen, seine Länge als separate Var zu extrahieren.

Frank

Geteilte Zeichenfolge basierend auf dem alternierenden Zeichen in R.

Antworten:

Aktualisieren

Benchmarks

Daten