3

I am trying to write a mathematica code to accomplish the following:

For a given $n$, consider $(ab)^n$, which is a string of the form $\underbrace{ababab...ab}_{n\text{ times}}$.

I want to replace $ba$ with $ab+1$, and then expand. For instance, if $n=2$, then we get abab->a(ab+1)b=aabb+ab

I have been having a very hard time writing code for this. Especially, manipulating strings using Mathematica has proved to be extremely difficult.

Any ideas how I could write this code?

Ryan Hendricks
  • 133
  • 4

2 Answers2

3

Define 2 functions. This one turns strings like "a^3" to "aaa":

replacePower[str_String]:=
StringReplace[str,c_~~"^"~~n:DigitCharacter..:>StringRepeat[c,ToExpression[n]]]

Test it:

In[]:= replacePower["a^11"]
Out[]= aaaaaaaaaaa

This one does the job:

f[n_Integer]:=
replacePower[StringReplace[ToString[Expand[ToExpression[StringReplace[
StringJoin[Table["ab",n]],"ba"->"(a*b+1)"]]],InputForm],{" "->"","*"->""}]]

Test it:

In[]:= f[2]
Out[]= ab+aabb

In[]:= f[5]
Out[]= ab+4aabb+6aaabbb+4aaaabbbb+aaaaabbbbb

You can apply similar methods to other cases you might have.

Vitaliy Kaurov
  • 73,078
  • 9
  • 204
  • 355
  • This alsmost does the trick, but there seem to be some errors. For example, $f[3]$ should be $aaabbb+3aabb+ab$. However, this program gives us $aaabbb+2aabb+ab$. – Ryan Hendricks Feb 09 '24 at 11:22
3

Following might help, based on the expected result so far :

n = 2 -> aabb+ab

n = 3 -> aaabbb+3aabb+ab

Clear[f, g, h]
SetAttributes[f, {Flat, Listable}]
g[args___] := Fold[Distribute[f@##] &, 
  f @@ SequenceReplace[DeleteElements[List@args, {1}] , {b, a} -> f[a, b] + 1]]

h[p_] := Module[{l = Flatten@Array[{a, b} &, p]}, 
  Simplify[g @@ l //. f -> g] /. f[args__] :> StringJoin@Map[ToString, {args}]]


-> h@# & /@ Range[6] // TableForm

1->ab

2->aabb+ab

3->aaabbb+3 aabb+ab

4->aaaabbbb+6 aaabbb+7 aabb+ab

5->aaaaabbbbb+10 aaaabbbb+25 aaabbb+15 aabb+ab

6->aaaaaabbbbbb+15 aaaaabbbbb+65 aaaabbbb+90 aaabbb+31 aabb+ab

Alternatively, using a more direct way (https://oeis.org/A008278)

h[p_] := Plus @@ Table[StirlingS2[p, k]  StringJoin@
     Flatten@Map[x |-> Array[ToString@x &, k], {a, b}], {k, p, 1, -1}]

-> h@# & /@ Range[6] // TableForm

Same result

vindobona
  • 3,241
  • 1
  • 11
  • 19
  • For some reason Mathematica is taking forever to execute this code. Did it also take long for you to run this? – Ryan Hendricks Feb 11 '24 at 03:48
  • @RyanHendricks Did you try it with a fresh kernel? For a small n (n=6), RepeatedTiming[# -> h@# & /@ Range[6]] gives on my machine 0.0390404 for the first version (using substitution) and 0.000184193 for the second one (using StirlingS2). – vindobona Feb 11 '24 at 09:25