(***************************************************
* *
* MATHEMATICA PROGRAM BRINKHUISTRIPLES.M *
* *
* CONTENT: *
* This program contains definitions to *
* check generalised Brinkhuis triples. *
* It accompanies the article "Improved *
* bounds on the number of ternary *
* square-free words" by Uwe Grimm. *
* The Brinkhuis triples derived in the *
* paper are explicitly contained. *
* *
* The program provides two main routines, *
* BrinkhuisTripleCheck and *
* BrinkhuisSpecialTripleCheck. The latter *
* exploits the structure of a special *
* Brinkhuis triple to reduce the number *
* of words that have to be checked for *
* square-freeness. *
* *
* If the program is executed in the *
* form, it starts to check the special *
* Brinkhuis triples presented in the *
* paper mentioned above. You may have *
* to be patient if you are interested *
* in the result for the largest triples, *
* as it will take quite a while (several *
* days on a Pentium 1GHz machine) to *
* complete all checks. *
* *
* DISCLAIMER: *
* The program has been tested by the *
* author, but no guarantee can be given *
* that results are indeed correct - so *
* use at your own risk! *
* *
* AUTHOR: *
* Uwe Grimm *
* Applied Mathematics Department *
* Faculty of Mathematics and Computing *
* The Open University *
* Walton Hall *
* Milton Keynes MK7 6AA *
* UK *
* *
* Please send any comments, bug reports, *
* etc. to: u.g.grimm@open.ac.uk *
* *
* Version 1.0 *
* August 1, 2001 *
* *
***************************************************)
(* DEFINITIONS *)
Clear[ReverseWord,PermuteWord];
ReverseWord[w_String] :=
StringReverse[w];
PermuteWord[w_String] :=
StringReplace[w, {"0"->"1","1"->"2","2"->"0"}];
Clear[SubWords,NoSquare,SquareFree];
SubWords[w_String,len_Integer] :=
Union[Table[StringTake[w,{i,i+len-1}],
{i,StringLength[w]-len+1}]];
NoSquare[w_String] /; Mod[StringLength[w],2]==0 :=
(StringTake[#,StringLength[#]/2]=!=
StringTake[#,-StringLength[#]/2])&[w];
SquareFree[w_String] :=
Apply[And,Table[Apply[And,Map[NoSquare,SubWords[w,k]]],
{k,2,StringLength[w],2}]];
Clear[BrinkhuisSpecialTriple];
BrinkhuisSpecialTriple[www_List] :=
NestList[Map[PermuteWord,#]&,Union[www,Map[ReverseWord,www]],2];
Clear[BrinkhuisTripleCheck];
BrinkhuisTripleCheck[www_List] :=
Module[{threewords={"010","012","020","021",
"101","102","120","121",
"201","202","210","212"},
ww,wl1,wl2,wl3,lw1,lw2,lw3,
i,j,k,n,nn,tn=0,sqfree=True,sqf},
If[Length[Union[Flatten[www]]]=!=Length[Flatten[www]],
Print["triple contains identical words"];
Return[False]];
If[Length[Union[Map[StringLength,Flatten[www]]]]=!=1,
Print["triple contains words of different lengths"];
Return[False]];
Print["checking a triple consisting of (",
Length[www[[1]]],",",Length[www[[2]]],",",
Length[www[[3]]],") words of length ",
Union[Map[StringLength,Flatten[www]]][[1]]];
Do[ww=threewords[[n]];
wl1 = www[[1+ToExpression[StringTake[ww,{1,1}]]]];
wl2 = www[[1+ToExpression[StringTake[ww,{2,2}]]]];
wl3 = www[[1+ToExpression[StringTake[ww,{3,3}]]]];
lw1 = Length[wl1];
lw2 = Length[wl2];
lw3 = Length[wl3];
nn = lw1*lw2*lw3;
tn += nn;
sqf = Apply[And,Map[SquareFree,
Flatten[Table[StringJoin[wl1[[i]],
wl2[[j]],
wl3[[k]]],
{i,lw1},
{j,lw2},
{k,lw3}]]]];
Print[" - checked ",lw1*lw2*lw3," words of type ",
ww,": ",sqf];
sqfree = And[sqfree,sqf],
{n,Length[threewords]}];
Print["all checks completed, a total of ",tn,
" words were checked"];
If[sqfree,
Print["no squares found - this is indeed a ",
"Brinkhuis triple!"],
Print["squares detected - this is not a ",
"Brinkhuis triple!"]];
sqfree];
Clear[BrinkhuisSpecialTripleCheck];
BrinkhuisSpecialTripleCheck[wws_List] :=
Module[{threewords={"010","012","020"},
ww,wl1,wl2,wl3,lw1,lw2,lw3,
i,j,k,m,n,nn,tn=0,sqfree=True,sqf,diffword,
www=BrinkhuisSpecialTriple[wws],
npal=0,nword=Length[wws]},
npal=Count[Map[ReverseWord[#]===#&,wws],True];
If[Length[Union[Flatten[www]]]=!=Length[Flatten[www]],
Print["triple contains identical words"];
Return[False]];
If[Length[Union[Map[StringLength,Flatten[www]]]]=!=1,
Print["triple contains words of different lengths"];
Return[False]];
Print["checking a special triple consisting of (",
Length[www[[1]]],",",Length[www[[2]]],",",
Length[www[[3]]],") words of length ",
Union[Map[StringLength,Flatten[www]]][[1]]];
Print["signature of triple is (",
npal,",",nword-npal,")"];
Do[ww=threewords[[n]];
wl1 = www[[1+ToExpression[StringTake[ww,{1,1}]]]];
wl2 = www[[1+ToExpression[StringTake[ww,{2,2}]]]];
wl3 = www[[1+ToExpression[StringTake[ww,{3,3}]]]];
lw1 = Length[wl1];
lw2 = Length[wl2];
lw3 = Length[wl3];
nn = lw1*lw2*lw3;
sqf = Union[Flatten[Table[StringJoin[wl1[[i]],
wl2[[j]],
wl3[[k]]],
{i,lw1},
{j,lw2},
{k,lw3}]]];
If[Length[sqf]=!=nn,
Print["Error detected - not all words replacing ",
ww," are different from each other"];];
(* we don't need to check words that are mirror images *)
Do[If[ReverseWord[sqf[[m]]]=!=sqf[[m]],
If[MemberQ[sqf,ReverseWord[sqf[[m]]]],
sqf=Delete[sqf,m]]],
{m,Length[sqf],2,-1}];
diffword = Length[sqf];
tn += diffword;
sqf = Apply[And,Map[SquareFree,sqf]];
Print[" - checked ",diffword,
" non-equivalent words among ",
nn," words of type ",ww,": ",sqf];
sqfree = And[sqfree,sqf],
{n,Length[threewords]}];
Print["all checks completed, a total of ",tn,
" words were checked"];
If[sqfree,
Print["no squares found - this is indeed a ",
"Brinkhuis triple!"],
Print["squares detected - this is not a ",
"Brinkhuis triple!"]];
sqfree];
(* CHECKS OF SPECIAL BRINKHUIS TRIPLES PRESENTED IN THE PAPER *)
(* n=13 *)
Clear[specialbrinktrip13,brinktrip13];
specialbrinktrip13 = {"0121021201210"};
brinktrip13 = BrinkhuisSpecialTriple[specialbrinktrip13];
Print["checking special Brinkhuis 1-triple of length 13:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip13];
Print[" "];
(* n=18 *)
Clear[specialbrinktrip18,brinktrip18];
specialbrinktrip18 = {"012021020102120210"};
brinktrip18 = BrinkhuisSpecialTriple[specialbrinktrip18];
Print["checking special Brinkhuis 2-triple of length 18:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip18];
Print[" "];
(* n=23 *)
Clear[specialbrinktrip23,brinktrip23];
specialbrinktrip23 = {"01210201021012021201210",
"01210212021012021201210"};
brinktrip23 = BrinkhuisSpecialTriple[specialbrinktrip23];
Print["checking special Brinkhuis 3-triple of length 23:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip23];
Print[" "];
(* n=25 *)
Clear[specialbrinktrip25,brinktrip25];
specialbrinktrip25 = {"0121020102101201021201210",
"0121021201021012021201210",
"0121021202102012021201210"};
brinktrip25 = BrinkhuisSpecialTriple[specialbrinktrip25];
Print["checking special Brinkhuis 5-triple of length 25:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip25];
Print[" "];
(* n=29, case 1 *)
Clear[specialbrinktrip29a,brinktrip29a];
specialbrinktrip29a = {"01202102012101202120102120210",
"01202120102012021012102120210",
"01202120102012021020102120210",
"01202120121012021012102120210"};
brinktrip29a = BrinkhuisSpecialTriple[specialbrinktrip29a];
Print["checking special Brinkhuis 6-triple of length 29:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip29a];
Print[" "];
(* n=29, case 2 *)
Clear[specialbrinktrip29b,brinktrip29b];
specialbrinktrip29b = {"01210201021201020121021201210",
"01210201021202101201021201210",
"01210201021202102012021201210"};
brinktrip29b = BrinkhuisSpecialTriple[specialbrinktrip29b];
Print["checking special Brinkhuis 6-triple of length 29:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip29b];
Print[" "];
(* n=30 *)
Clear[specialbrinktrip30,brinktrip30];
specialbrinktrip30 = {"012102010210120102012021201210",
"012102010212012102012021201210",
"012102010212021020121021201210",
"012102120210120102012021201210"};
brinktrip30 = BrinkhuisSpecialTriple[specialbrinktrip30];
Print["checking special Brinkhuis 8-triple of length 30:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip30];
Print[" "];
(* n=33 *)
Clear[specialbrinktrip33,brinktrip33];
specialbrinktrip33 = {"012021020121012010212012102120210",
"012021020121021201021012102120210",
"012021020121021201210120102120210",
"012021201020120210121020102120210",
"012021201020121012021012102120210",
"012021201021012010212012102120210"};
brinktrip33 = BrinkhuisSpecialTriple[specialbrinktrip33];
Print["checking special Brinkhuis 12-triple of length 33:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip33];
Print[" "];
(* n=35 *)
Clear[specialbrinktrip35,brinktrip35];
specialbrinktrip35 = {"01202102010212010201202120102120210",
"01202102010212010201210120102120210",
"01202102012101201020121020102120210",
"01202102012101202120121020102120210",
"01202102012102120210121020102120210",
"01202120102012101201021012102120210",
"01202120102012102010210120102120210",
"01202120102120210201021012102120210",
"01202120102012102120121020102120210",
"01202120102101210201210120102120210"};
brinktrip35 = BrinkhuisSpecialTriple[specialbrinktrip35];
Print["checking special Brinkhuis 18-triple of length 35:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip35];
Print[" "];
(* n=36 *)
Clear[specialbrinktrip36,brinktrip36];
specialbrinktrip36 = {"012102010210120212010210121021201210",
"012102010210120212012101201021201210",
"012102010210121021201020121021201210",
"012102010210121021201021012021201210",
"012102010210121021202101201021201210",
"012102010212012101201020121021201210",
"012102010212012101201021012021201210",
"012102010212012102120210121021201210",
"012102010212021012010210121021201210",
"012102010212021020102101201021201210",
"012102120102101202120102012021201210",
"012102120102101210201021012021201210",
"012102120102101210212021012021201210",
"012102120121012010212021012021201210",
"012102120121012021201021012021201210",
"012102120121020102120102012021201210"};
brinktrip36 = BrinkhuisSpecialTriple[specialbrinktrip36];
Print["checking special Brinkhuis 32-triple of length 36:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip36];
Print[" "];
(* n=40 *)
Clear[specialbrinktrip40,brinktrip40];
specialbrinktrip40 = {"0120210201210120102120210121020102120210",
"0120210201210120212010210121020102120210",
"0120210201210212010210120212012102120210",
"0120210201210212012101201021012102120210",
"0120210201210212012101202120121020120210",
"0120210201210212012102010210120102120210",
"0120210201210212012102010212012102120210",
"0120210201210212012102012021012102120210",
"0120210201210212012102012021020102120210",
"0120210201210212021020120212012102120210",
"0120212010201202101210201021012102120210",
"0120212010201210120102012021012102120210",
"0120212010201210120102101202120102120210",
"0120212010201210120102120121020102120210",
"0120212010201210120210201021012102120210",
"0120212010201210120210201202120102120210",
"0120212010201210120212010210120102120210",
"0120212010201210212010201202120102120210",
"0120212010201210212012101202120102120210",
"0120212010210120102012101202120102120210",
"0120212010212021012021201021012102120210",
"0120212010212021012102010212012102120210",
"0120212010212021012102120102012102120210",
"0120212010212021020102120102012102120210"};
brinktrip40 = BrinkhuisSpecialTriple[specialbrinktrip40];
Print["checking special Brinkhuis 48-triple of length 40:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip40];
Print[" "];
(* n=41 *)
Clear[specialbrinktrip41,brinktrip41];
specialbrinktrip41 = {"01202102012101201021202101202120102120210",
"01202102012101202120102012021012102120210",
"01202102012101202120102012021020102120210",
"01202102012102120102012101202120102120210",
"01202102012102120121012010212012102120210",
"01202102012102120121020120212012102120210",
"01202120102012021012010210121020102120210",
"01202120102012021012102010210120102120210",
"01202120102012021012102010212012102120210",
"01202120102012021012102012021020102120210",
"01202120102012021012102120102012102120210",
"01202120102012021012102120121020102120210",
"01202120102012021020102120102012102120210",
"01202120102012021020102120121020102120210",
"01202120102012101201020120212012102120210",
"01202120102012101202102010210120102120210",
"01202120102012101202102010212012102120210",
"01202120102012101202102012021012102120210",
"01202120102012102120102012021012102120210",
"01202120102012102120102101202120102120210",
"01202120102012102120121012021012102120210",
"01202120102012102120210201021012102120210",
"01202120102012102120210201202120102120210",
"01202120102101201020121012021012102120210",
"01202120102101201021202101202120102120210",
"01202120102120210121021201021012102120210",
"01202120102120210201202120102012102120210",
"01202120121012010201202120102012102120210",
"01202120121012021012102010212012102120210",
"01202120121012021012102120102012102120210",
"01202120121012021020102120102012102120210",
"01202102012102120210201202120121020120210",
"01202120121012010201210201021012102120210",
"01202120121021201021012010212012102120210"};
brinktrip41 = BrinkhuisSpecialTriple[specialbrinktrip41];
Print["checking special Brinkhuis 65-triple of length 41:"];
BrinkhuisSpecialTripleCheck[specialbrinktrip41];
Print[" "];
(* END OF PROGRAM BRINKHUISTRIPLES.M *)
Quit[];