Mazzola, Guerino / Noll, Thomas / Lluis-Puebla, Emilio: Perspectives in Mathematical and Computational Music Theory

Appendix : Implementation of Swenson’s Algorithm

Below I display the MathematicaTM code. The principle is as follows: Given A,B in direct sum, take the smallest integer $g$ not in $A o+ B$ (closest to origin on either side).

Example: $A = {0,1,4},B = {0,2,7},A o+ B = {0,1,2,3,4,6,7,8,11},g = -1$ .

Now find by iteration the smallest $m$ such that $A o+ {m}$ and $B o+ {g- m}$ is a direct sum again. We may try first $m$ to be the smallest gap in $A$ and increment if it does not fit. When it does, we have expanded the direct sum (as $g$ will now be in it, it goes farther from origin) and so the process will eventually reach every integer, which is a constructive proof of Swenson’s theorem.

oPlus[a_,b_] := Union[Flatten[Outer[Plus,a,b]]]
oPlusCheck[a_,b_] := Module[{op = oPlus[a,b]},
If [Length[a]*Length[a]== Length[op],op, {}]]

firstGap[mySet_] := Module[{m=0},
         While[MemberQ[mySet,m],
            If[m<=0,m=1-m,m=-m]]
          ;m]

enlargeCanon[A_, B_]:=
Module[{g=firstGap[oPlus[A,B]], m, Anew, Bnew, op},
(* declaring local variables *)

m = firstGap[Union[A, g-B] ];
op = {};

(* now we try different m until it fits *)

While[op=={},
Anew = Append[A,m];
Bnew = Append[B, g-m];
op = oPlusCheck[Anew, Bnew];
;  m++
];
(* should be OK by now,
we list the solutions after sorting them
*)
Sort /@ {Anew, Bnew }
]

References

AMIOT, E. (1991). Pour en finir avec le désir. Revue d’Analyse Musicale, 22:41-45.