5

There is already a thread on how to split a string into equal sized chunks. I'm wanting to split a string into sets of substrings of length 1 and 2. For example, if I have the string "123456", my list would include elements such as {12,3,4,56}, {1,2,3,45,6}, and {1,2,34,56}.

I found this little bit of Python code, but 1) I don't know how to translate it into Mathematica code and 2) it gives you strings with a bunch of extra commas (because it's basically just distributing n commas through the string in different ways).

I suspect there is a very simple way of doing this in Mathematica.

Community
  • 1
pygin0
  • 61
  • 2

4 Answers4

6

I am seeking a more elegant approach but this gets the job done:

stringChunk[str_String, ch : {_Integer?Positive ..}] :=
 Module[{dynP, n = StringLength@str},
  dynP[l_, p_] := MapThread[l ~StringTake~ {#, #2} &, {{0} ~Join~ Most@# + 1, #} &@Accumulate@p];
  dynP[str, #] & /@ Join @@ Permutations /@ IntegerPartitions[n, n, ch]
 ]

Test:

stringChunk["123456", {1, 2}]

{{"12", "34", "56"}, {"12", "34", "5", "6"}, {"12", "3", "45", "6"}, {"12", "3", "4", "56"},
 {"1", "23", "45", "6"}, {"1", "23", "4", "56"}, {"1", "2", "34", "56"},
 {"12", "3", "4", "5", "6"}, {"1", "23", "4", "5", "6"}, {"1", "2", "34", "5", "6"},
 {"1", "2", "3", "45", "6"}, {"1", "2", "3", "4", "56"}, {"1", "2", "3", "4", "5", "6"}}

Explanation

Igor Rivin comments that my code is "difficult to parse" so here is an explanation:

  • dynP is just a modified version of the function with the same name from Partitioning with varying partition size operating on strings rather than lists. It splits a string into the lengths given by its second parameter.

  • IntegerPartitions[n, n, ch] gives a list of all splits of n into segments given by list ch, e.g.:

    IntegerPartitions[6, 6, {1, 2}]

    {{2, 2, 2}, {2, 2, 1, 1}, {2, 1, 1, 1, 1}, {1, 1, 1, 1, 1, 1}}

  • These are permuted, joined, and given to dynP to split the string str accordingly.

Community
  • 1
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • What is the complexity of this method? – Igor Rivin Sep 11 '14 at 01:13
  • @Igor Complexity over what variable? String length? I believe it is exponential, but so is the length of the result so I am not sure that can be avoided. That is to say it is roughly constant time with regard to the length of the output list. – Mr.Wizard Sep 11 '14 at 02:49
  • @Mr.Wizard I think Igor asked about the code complexity over the number of infixes. Ups! I did it again! – Dr. belisarius Sep 11 '14 at 05:08
  • 1
    @Mr.Wizard Actually, my comment about difficulty to parse was literal: you use all of Mathematica's syntactic feature, which leads to much more compact code, but is more difficult to read to those who are not used to it (like me). I did not mean it in a bad way at all, just as a statement of fact. – Igor Rivin Sep 11 '14 at 12:20
5

I find it difficult to parse the runes in Mr.Wizard's answer, but here is a simple functional way:

substrs[str_] := substrs[str] = 
 If[StringLength[str] == 2, {Characters[str], {str}},  
  If[StringLength[str] == 1, {{str}},  
   Join[Map[Prepend[#, StringTake[str, 1]] &, substrs[StringDrop[str, 1]]],
    Map[Prepend[#, StringTake[str, 2]] &, substrs[StringDrop[str, 2]]]]]]

Here is the general version (where the chunks are of arbitrary bounded length. If you want to not bound the length, just call allsubstrs[str, StringLength[str]]

allsubstrs["", n_] := {{}}

prepsubstrs[oldlist_, prefix_] := Map[Prepend[#, prefix] &, oldlist]

allsubstrs[str_, n_] := 
  allsubstrs[str, n] = 
    Apply[Join,  
      Map[prepsubstrs[allsubstrs[StringDrop[str, #], n], 
         StringTake[str, #]] &, Range[Min[n, StringLength[str]]]]]
Igor Rivin
  • 5,094
  • 20
  • 19
  • And I still haven't figured out how to typeset code properly :( – Igor Rivin Sep 11 '14 at 01:57
  • @Karsten7. I did look, but the four line feeds do not seem to work. I then looked at other people's postings, but they did not seem to do anything special either. Anyway, thanks! I am sure I will catch on eventually... – Igor Rivin Sep 11 '14 at 02:13
  • @Karsten7. Ah, so! – Igor Rivin Sep 11 '14 at 02:22
  • This appears to be an order of magnitude faster than my code. (+1) However as written it is not as general. (Mine will work with any given segment lengths.) Will you consider posting a generalized version? If not I may use your code as a basis for my own generalization. – Mr.Wizard Sep 11 '14 at 04:39
  • @Mr.Wizard I will certainly consider it, but am a little swamped at the moment, so it might take a little while, in the meanwhile, please feel free... – Igor Rivin Sep 11 '14 at 12:56
  • 1
    @Mr.Wizard OK, I have added the more general version. – Igor Rivin Sep 11 '14 at 21:26
3

Here is a reasonably fast approach using the nice SatisfiabilityInstances[]:

ClearAll[stringSets];
stringSets[str_String] := Module[{x, len},
                          len = StringLength@str - 1;
                          StringSplit[StringJoin /@ (Riffle[Characters@str, #] & /@ 
                         (SatisfiabilityInstances[And @@ Table[Or[x[n], x[n + 1]], {n, 1, len - 1}], 
                                 Array[x, len], All] /. {True -> " ", False -> ""}))]
  ]

Timing[stringSets["12345678901234567890"];]
(* {1.078125, Null} *)

Length[stringSets["12345678901234567890"]]
(* 10946 *)
Dr. belisarius
  • 115,881
  • 13
  • 203
  • 453
1
 stringbreak[str_] := (
        StringJoin[#[[All, 1]]] & /@
            GatherBy[Transpose[{Characters[str],
                 Accumulate@#}], #[[2]] & ] & /@
         Nest[ Flatten[ If[Last@# == 0, {Append[#, 1]},
              {Append[#, 0], Append[#, 1]}] & /@ # , 1] &, {{1}},# -1]) &@
                             StringLength[str]
  stringbreak["123456" ]

{{"12", "34", "56"}, {"12", "34", "5", "6"}, {"12", "3", "45", "6"}, {"12", "3", "4", "56"}, {"12", "3", "4", "5", "6"}, {"1", "23", "45", "6"}, {"1", "23", "4", "56"}, {"1", "23", "4", "5", "6"}, {"1", "2", "34", "56"}, {"1", "2", "34", "5", "6"}, {"1", "2", "3", "45", "6"}, {"1", "2", "3", "4", "56"}, {"1", "2", "3", "4", "5", "6"}}

 stringbreak["12345678901234567890" ] // Timing // First
 stringbreak["12345678901234567890" ] // Length

0.546

10946

Extension to arbitraty max run length:

    stringbreak[str_, runlen_] :=
       StringJoin[#[[All, 1]]] & /@
            GatherBy[Transpose@{Characters@str, #}, Last ] & /@
               Nest[Flatten[ {Append[#, Last@# + 1],
                   If[Length@# > runlen - 1 && Length@Union@#[[-runlen ;;]] == 1 ,
                       Sequence @@ {}, Append[#, Last@#]]} & /@ #, 1] &, {{0}},
                           StringLength[str] - 1]  

    stringbreak["123456", 10]

{{"123456"}, {"12345", "6"}, {"1234", "56"}, {"1234", "5", "6"}, {"123", "456"}, {"123", "45", "6"}, {"123", "4", "56"}, {"123", "4", "5", "6"}, {"12", "3456"}, {"12", "345", "6"}, {"12", "34", "56"}, {"12", "34", "5", "6"}, {"12", "3", "456"}, {"12", "3", "45", "6"}, {"12", "3", "4", "56"}, {"12", "3", "4", "5", "6"}, {"1", "23456"}, {"1", "2345", "6"}, {"1", "234", "56"}, {"1", "234", "5", "6"}, {"1", "23", "456"}, {"1", "23", "45", "6"}, {"1", "23", "4", "56"}, {"1", "23", "4", "5", "6"}, {"1", "2", "3456"}, {"1", "2", "345", "6"}, {"1", "2", "34", "56"}, {"1", "2", "34", "5", "6"}, {"1", "2", "3", "456"}, {"1", "2", "3", "45", "6"}, {"1", "2", "3", "4", "56"}, {"1", "2", "3", "4", "5", "6"}}

brute force just for fun..

 Function[str, Select[ Permutations[
        Join[ StringJoin /@ Partition[ # , 2, 1]  , #] &@Characters[str] ,
        StringLength[str]] , StringJoin@# == str & ]]@"123456"

same, way slower.

george2079
  • 38,913
  • 1
  • 43
  • 110