5
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Do your strings really all consist of digits? Are really string representations of integers? $\endgroup$ – m_goldberg Sep 10 '14 at 23:15
  • $\begingroup$ Very closely related: (5305) $\endgroup$ – Mr.Wizard Sep 10 '14 at 23:53
6
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ What is the complexity of this method? $\endgroup$ – Igor Rivin Sep 11 '14 at 1:13
  • $\begingroup$ @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. $\endgroup$ – Mr.Wizard Sep 11 '14 at 2:49
  • $\begingroup$ @Mr.Wizard I think Igor asked about the code complexity over the number of infixes. Ups! I did it again! $\endgroup$ – Dr. belisarius Sep 11 '14 at 5:08
  • 1
    $\begingroup$ @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. $\endgroup$ – Igor Rivin Sep 11 '14 at 12:20
5
$\begingroup$

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]]]]]
$\endgroup$
  • $\begingroup$ And I still haven't figured out how to typeset code properly :( $\endgroup$ – Igor Rivin Sep 11 '14 at 1:57
  • $\begingroup$ @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... $\endgroup$ – Igor Rivin Sep 11 '14 at 2:13
  • $\begingroup$ @Karsten7. Ah, so! $\endgroup$ – Igor Rivin Sep 11 '14 at 2:22
  • $\begingroup$ 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. $\endgroup$ – Mr.Wizard Sep 11 '14 at 4:39
  • 1
    $\begingroup$ @Mr.Wizard OK, I have added the more general version. $\endgroup$ – Igor Rivin Sep 11 '14 at 21:26
3
$\begingroup$

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 *)
$\endgroup$
1
$\begingroup$
 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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.