Geteilte Zeichenfolge basierend auf dem alternierenden Zeichen in R.

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

Antworten:

95

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"
— akrun
quelle
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
22

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"
— A5C1D2H2I1M1N2O1R2T1
quelle
20

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 "
— rawr
quelle
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
@akrun Ich weiß, ich habe mich nur gefragt, ob Sie wissen, was dieses \\KDing in einem
— regulären Ausdruck
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
1
@akrun, wollte gerade den gleichen Kommentar abgeben.
— A5C1D2H2I1M1N2O1R2T1
14

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
— Rich Scriven
quelle
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
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
— Tommy O'Dell
quelle
2
Warten Sie, also ist meine Antwort schneller als die von Akrun? Interessant
— Rich Scriven
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
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
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.