# Split a string at specific positions

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. Commented Mar 16, 2012 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. Commented Mar 16, 2012 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). Commented Mar 16, 2012 at 12:47

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

• 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. Commented Mar 17, 2012 at 11:21
• Even more optimized, amazing! Commented Mar 17, 2012 at 11:30
• Since it gives the fastest and clearest solution (praising myself as well), I've accepted this answer. Commented Mar 19, 2012 at 11:23
• @István thanks :-) Commented Mar 19, 2012 at 13:06

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

• This has some problems: for example it splits "000xx00xxx" into {"0", "0", "0x", "x0", "0x", "xx"} instead of {"0", "0", "0x", "x0", "0xxx"}. Commented Mar 16, 2012 at 17:38
• @IstvánZachar In that case I misunderstood your splitting rules. Commented Mar 16, 2012 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! Commented Mar 16, 2012 at 17:49
• @IstvánZachar I've updated my solution. Commented Mar 16, 2012 at 17:53
• Interesting alternative - +1. Commented Mar 16, 2012 at 18:07

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

• +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. Commented Mar 16, 2012 at 17:03
• I did the same kind of testing :-). Your algorithm scales exceptionally well. Commented Mar 16, 2012 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. Commented Mar 16, 2012 at 17:09

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. Commented Mar 16, 2012 at 17:43 • Excellent solution: it will be difficult to improve on its performance or brevity. Commented Mar 16, 2012 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. Commented Mar 16, 2012 at 17:50 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. Commented Mar 16, 2012 at 16:58 • I have some problems when run on strings of length 10000: $IterationLimit::itlim: Iteration limit of 4096 exceeded. >> Commented Mar 16, 2012 at 17:23
• @Istvan Just wrap the code into Block[{\$IterationLimit = Infinity}, splitString[...]]. This is safe. Commented Mar 16, 2012 at 17:41
• Indeed, and now it qualifies as the second fastest. Nice recursive solution. Commented Mar 16, 2012 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) :-) Commented Mar 16, 2012 at 18:09

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. Commented Mar 16, 2012 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. Commented Mar 16, 2012 at 18:40
• You're right. There is something wrong with the code (I mixed up code from two different attempts.) Commented Mar 16, 2012 at 18:47
• @István The updated version works better, I believe. Commented Mar 16, 2012 at 22:13