Split a string at specific positions

Question

Given a string of alphanumerical characters, how to split it simply and quickly at the center of continuous letter-substrings? Is there an elegant and fast solutions out there in the "computational universe"?

The splitter should create "syllables" with one digit as a nucleus for each syllable, that is, at the end there should be only one digit per sublist. When there are more letter characters between digits, letters should be shared by the bordering digits (here I simulated a half share, distributing towards the right bordering digit in case of an odd number of letters), and starting and ending letter-sequences should be just attached to the closest digit.

"xxx00xxx000x0xx0xxxx000xx0xx" (* original string *)

"xxx0 | 0x | xx0 | 0 | 0 | x0x | x0xx | xx0 | 0 | 0x | x0xx" (* intermediate *)

{"xxx0", "0x", "xx0", "0", "0", "x0x", "x0xx", "xx0", "0", "0x", "x0xx"} (* end *)

Note that the string never contains spaces by default.

Sorry @Mr.Wizard, you're not slow at all, I purposefully edited out my own lame solution to prevent any bias, and with it the specification (unpurposefully). Please see edit. — István Zachar, Mar 16 '12 at 12:34
@Mr.Wizard Take each continuous sequence, such as xxxx or 00 and put a separator in the middle. Then split at the separators. I'd implement that but it's not elegant. — Szabolcs, Mar 16 '12 at 12:35
@Szabolcs: Almost, with the minor addition, that continuous digit sequences should be split at each digit (now of course this is not really the issue here). — István Zachar, Mar 16 '12 at 12:47

Heike · Answer 1 · 2012-03-16T17:52:22.523

11

This basically uses the method as outlined in the question:

split[str_] := Module[{pos, str1},
  pos = Ceiling[Mean /@ StringPosition[str, 
      Repeated[LetterCharacter, {2, Infinity}], Overlaps -> False]];
  str1 = StringInsert[str, " ", pos];
  pos = StringPosition[str1, Repeated[DigitCharacter, {2}], 
      Overlaps -> True][[All, 2]];
  StringSplit[StringInsert[str1, " ", pos]]]

split["000xxxx0000xxx00x0"]

{"0", "0", "0xx", "xx0", "0", "0", "0x", "xx0", "0x0"}

Edit

Apparently I misunderstood the splitting rules. Hopefully I got it right this time

split[str_] := 
 Module[{pos, str1}, 
  pos = Ceiling[
    Mean /@ StringPosition[str, 
      DigitCharacter ~~ Repeated[LetterCharacter] ~~ DigitCharacter]];
  str1 = StringInsert[str, " ", pos];
  pos = StringPosition[str1, Repeated[DigitCharacter, {2}], 
     Overlaps -> True][[All, 2]];
  StringSplit[StringInsert[str1, " ", pos]]]

Testing the solution of the string in the question:

split["xxx00xxx000x0xx0xxxx000xx0xx"]

{"xxx0", "0x", "xx0", "0", "0", "x0x", "x0xx", "xx0", "0", "0x", "x0xx"}

edited Mar 16 '12 at 17:52

answered Mar 16 '12 at 17:17

Heike

35,858
3
108
157

This has some problems: for example it splits "000xx00xxx" into {"0", "0", "0x", "x0", "0x", "xx"} instead of {"0", "0", "0x", "x0", "0xxx"}. – István Zachar Mar 16 '12 at 17:38
@IstvánZachar In that case I misunderstood your splitting rules. – Heike Mar 16 '12 at 17:45
I have updated my question to reflect the rules more correctly. If you could update your solution, I would gladly run it against the others again, as I see that it has potential! – István Zachar Mar 16 '12 at 17:49
@IstvánZachar I've updated my solution. – Heike Mar 16 '12 at 17:53
Interesting alternative - +1. – Leonid Shifrin Mar 16 '12 at 18:07

whuber · Answer 2 · 2012-03-16T16:54:02.550

9

This is a Euclidean Allocation operation on a one-dimensional grid. That immediately suggests use of Nearest:

Clear[midsplit];
midsplit[s_String] := Module[
   {digits = First[#] & /@  StringPosition[s, DigitCharacter], runs},
   runs = Accumulate[
     Length[#] & /@  
      Split[Last[#] & /@ ( 
         Nearest[digits, #] & /@ Range[StringLength[s]])]];
   MapThread[
    StringTake[s, {#1, #2}] &, {Most[Prepend[runs + 1, 1]], runs}] 
   ];
midsplit[s_String] /; 
   Length[StringCases[s, DigitCharacter]] == 0 := {s};

(The last line takes care of cases where no digit appears at all; Nearest chokes on an empty list for the first argument.) Most of the code is devoted to reformatting the input into a binary raster representation (the computation of digits) and then using the results of Nearest to extract the associated substrings (the computation of runs and subsequent application of StringTake).

edited Mar 16 '12 at 16:54

answered Mar 16 '12 at 16:48

whuber

20,544
2
59
111

+1 for brevity and interesting idea / link. Mine is faster for large strings, but yours is shorter and reveals interesting techniques/algorithm. I actually tested on random strings of length several thousands and our results agree. – Leonid Shifrin Mar 16 '12 at 17:03
I did the same kind of testing :-). Your algorithm scales exceptionally well. – whuber Mar 16 '12 at 17:03
Thanks :-). I tried hard to both make it linear time and avoid imperative style with assignments etc. For very large lists, one has to lift the $IterationLimit. I could have used less rules, but then ff would not be tail-recursive in M sense (it would affect $RecursionLimit then, which I normally try to avoid at all costs). Also, pattern-matcher can be nicely utilized here to implement look-ahead behavior in a clear fashion, which I exploited as well. I actually think that linked lists are under-used in Mathematica programming. – Leonid Shifrin Mar 16 '12 at 17:09

István Zachar · Answer 3 · 2012-03-16T17:57:37.227

In the meantime, I figured out a quite simple way, and I was amazed, that it turned out quite fast - the same reason why Heike's solution is fast: using the string pattern matcher is perhaps the best option here.

splitIstvan[s_String] := StringSplit@StringReplace[s, {
     StartOfString ~~ l : LetterCharacter .. :> l,
     l : LetterCharacter .. ~~ EndOfString :> l,
     l : LetterCharacter .. :> (StringTake[l, 
         Floor[StringLength@l/2]] <> " " <> 
        StringTake[l, -Ceiling[StringLength@l/2]]),
     d : DigitCharacter .. :> StringJoin@Riffle[Characters@d, " "]
     }];


str = StringJoin @@ (RandomInteger[{0, 1}, {10000}] /. {0 -> "0", 
  1 -> "x"});

{
 First@AbsoluteTiming[whuber = splitWhuber@str;],
 First@AbsoluteTiming[
   leonid = Block[{$IterationLimit = Infinity}, splitLeonid@str];],
 First@AbsoluteTiming[heike = splitHeike@str;],
 First@AbsoluteTiming[istvan = splitIstvan@str;]
 }

{istvan === whuber, istvan === leonid, istvan === heike}

{12.0120211, 0.0624001, 0.1092002, 0.0312001}
{True, True, True}

Interesting. I somehow had a hunch that string-based operations won't be enough here, and you just proved me wrong. +1. — Leonid Shifrin, Mar 16 '12 at 17:43
Excellent solution: it will be difficult to improve on its performance or brevity. — whuber, Mar 16 '12 at 17:43
Well I actually gave up on the string patternmatcher and went on to do some algorithmic trial-and-error, that is why I posted the question. And then came this idea. — István Zachar, Mar 16 '12 at 17:50

Leonid Shifrin · Answer 4 · 2012-03-16T21:55:11.950

Linked lists seem to be a good data structure to implement matching with some look-ahead behavior - which is what is needed here. Here is a linear-time solution based on linked lists:

ClearAll[toLinkedList];
toLinkedList[l_] := Fold[{#2, #1} &, {}, Reverse@l]

This computes the distance to the next zero in the linked list:

Clear[nzl];
nzl[{}, _] := 0;
nzl[{Except["0"], tail_}, len_] := nzl[tail, len + 1];
nzl[{"0", _}, len_] := len;

This is a main recursive "engine"

ClearAll[ff];
ff[accum_, current_, {}, _, _] := ll[accum, Flatten@current];

ff[accum_, current_, {h : Except["0"], tail_}, nextZeroFullLength_, nextZeroLength_] /;  
     nextZeroLength == IntegerPart[(nextZeroFullLength + 1)/2] :=
  ff[ll[accum, Flatten@{current, h}], {}, tail, nextZeroFullLength, nextZeroLength - 1];

ff[accum_, current_, {h : Except["0"], tail_}, nextZeroFullLength_, nextZeroLength_] :=
  ff[accum, {current, h}, tail, nextZeroFullLength, nextZeroLength - 1];

ff[accum_, current_, {"0", t : {"0", tail_}}, _, _] :=
  ff[ll[accum, Flatten@{current, {"0", {}}}], {}, t, 1, 1];

ff[accum_, current_, {"0", t : {_, {"0", _}}}, _, _] :=
  ff[ll[accum, Flatten@{current, "0"}], {}, t, nzl[t, 0], nzl[t, 0] - 1];

ff[accum_, current_, {"0", tail_}, _, _] :=
  ff[accum, {current, "0"}, tail, nzl[tail, 0], nzl[tail, 0] - 1];

and the final function:

ClearAll[splitString];
splitString[str_String] :=
  Block[{ll, result},
    SetAttributes[ll, HoldAllComplete];
    Map[StringJoin, List @@ Flatten[#, Infinity, ll]] &@
      ff[ll[], {}, #, nzl[#, 0], 0] &@toLinkedList@Characters[str]
];

You use this as

splitString["xxx00xxx000x0xx0xxxx000xx0xx"]

Not sure if this is elegant though, it's clearly not too brief.

+1 It might not be brief, but it's quick! (And scales well.) It is noteworthy, though, that splitString["xxx"] returns {"x", "xx"}. Not necessarily wrong: the behavior for an input with no digits was not specified. — whuber, Mar 16 '12 at 16:58
I have some problems when run on strings of length 10000: $IterationLimit::itlim: Iteration limit of 4096 exceeded. >> — István Zachar, Mar 16 '12 at 17:23
@Istvan Just wrap the code into Block[{$IterationLimit = Infinity}, splitString[...]]. This is safe. — Leonid Shifrin, Mar 16 '12 at 17:41
Indeed, and now it qualifies as the second fastest. Nice recursive solution. — István Zachar, Mar 16 '12 at 18:00
@Istvan Thanks. So far, it looks like you've got to accept your own solution, unless someone comes up with something yet shorter and faster (which I doubt) :-) — Leonid Shifrin, Mar 16 '12 at 18:09

DavidC · Answer 5 · 2012-03-16T22:43:08.403

Edit

I fixed two shortcomings in my earlier submission:

f[str_] :=
   Module[{r1},
       r1 = StringReplace[
            str, {d : NumberString /; StringLength[d] > 1 :>  
            StringInsert[d, " ", Range[2, StringLength[d]]]}];
  StringSplit@
    FixedPoint[
       StringReplace[#, (d1 : DigitCharacter) ~~ (w : 
       LetterCharacter ..) ~~ (d2 : DigitCharacter) :> 
       d1 ~~ StringInsert[w, " ", Floor[StringLength[w]/2] + 1] ~~ 
       d2] &, r1]
       ]

The first StringReplace inserts a break between all adjacent digits. The second StringReplace places a break in any run of letters. These two breaks are sufficient to parse all the cases.

FixedPoint is needed because the second instance of StringReplace is not always able to find all the relevant cases to replace on the first pass.

There was also a second rule in the first StringReplace that was a sloppy (and faulty) hack.

Examples:

f["xxx00xxx000x0xx0xxxx000xx0xx"]

(* Out *) 
{"xxx0", "0x", "xx0", "0", "0", "x0x", "x0xx", "xx0", "0", "0x", \
  "x0xx"}

f["x0xxx00x00"]

(*Out *) 
{"x0x", "xx0", "0", "x0", "0"}

Speed check using István's metric:

str = StringJoin @@ (RandomInteger[{0, 1}, {10000}] /. {0 -> "0", 
  1 -> "x"});
First[f[str] // AbsoluteTiming]

(* Out*)
0.037927

While it's pretty fast, it fails on e.g. this: "x0xxx00x00", and returns {"x0x", "xx00", "x00"} where not all the digits are split. BTW, you can use space instead of " | " as a dummy, which simplifies cases. — István Zachar, Mar 16 '12 at 18:37
I'll check the failing condition. Regarding " | ", anything can be a separator; I simply matched the separator to produce output like yours. — DavidC, Mar 16 '12 at 18:40
You're right. There is something wrong with the code (I mixed up code from two different attempts.) — DavidC, Mar 16 '12 at 18:47

score 7 · Accepted Answer · answered Mar 17 '12 at 10:52

7

Here is a faster version of István's function:

split[s_String] :=
  StringReplace[s, {
    StartOfString ~~ l : LetterCharacter .. :> l,
    l : LetterCharacter .. ~~ EndOfString   :> l,
    l : LetterCharacter .. :>
          StringInsert[l, " ", 1 + Quotient[StringLength@l, 2] ],
    d : Repeated[DigitCharacter, {2, ∞}] :>
          StringJoin @ Riffle[Characters@d, " "]
  }] // StringSplit

Timings:

str = StringJoin @@ (RandomInteger[{0, 1}, {500000}] /. {0 -> "0", 1 -> "x"});

First@AbsoluteTiming[istvan = splitIstvan@str;]
First@AbsoluteTiming[mrwizard = split@str;]
istvan === mrwizard

0.7710441
0.4260243
True

answered Mar 17 '12 at 10:52

Mr.Wizard

271,378
34
587
1,371

Good point, the longer list the better speed up +1! The relative timings 0.7 for 5 10^4, 0.57 for 5 10^5 and 0,56 for 2.5 10^6. – Artes Mar 17 '12 at 11:21
Even more optimized, amazing! – István Zachar Mar 17 '12 at 11:30
Since it gives the fastest and clearest solution (praising myself as well), I've accepted this answer. – István Zachar Mar 19 '12 at 11:23
@István thanks :-) – Mr.Wizard Mar 19 '12 at 13:06

Split a string at specific positions

6 Answers6

Linked