self-avoiding closed loops (2)

[Wouter Meeussen]

Sorry,

error in programming, it should be

0,0,1,0,5,4,28,48 excluding mirroring. (not in EIS)





program :
-------

selfavoidingQ[k_Integer]:=
Module[{ le,n=1,nogo={0},argu=0.,elem=0.},
bin=IntegerDigits[k,2];le=Length[bin];nocross=True;
While[ nocross && n<=le,
elem=Chop[elem+10. N at Exp[argu+=I Pi/3 (2 bin[[n]]-1)]];
rel=Round[elem];
nocross=FreeQ[nogo,rel];
nogo={nogo,rel}; n++];
 rel===0&&le+1===n && Round[E^argu]===1]

plotting tools :
--------------

nice[a_]:=If[a==={},a,Partition[Join[a, Table[Graphics[Point[{0, 0}]], 
     { Mod[Ceiling[Sqrt[#]]-Mod[#,(Ceiling[Sqrt[#]] )],Ceiling[Sqrt[#]]] & @ 
   Length[a]}]], Ceiling[Sqrt[Length[a]]] ] ]

pad=FoldList[Chop[#1+ N at Exp[argu+=I Pi/3 (2 #2-1)]]&,argu=0.;0,
IntegerDigits[#,2]]&;

plotpad[k_Integer]:= Graphics[{Line[{Re[#],Im[#]}&/@pad[k]],Hue[0],Line[{{0,
0},{1/2,Sqrt[3]/2}}]},DisplayFunction->Identity,Axes->False,AspectRatio->
Automatic]


Checking:
--------


Timing[w11=Cases[Range[2^11,2^(11+1)-1],_?selfavoidingQ]]

Show[GraphicsArray[nice[plotpad /@ (w11)]],DisplayFunction->$DisplayFunction]

mir11=Fold[2#1+#2&,0,Prepend[1-Rest at IntegerDigits[#,2],1]]&/@w11

rolw11=Fold[2#1+#2&,0,FixedPoint[RotateLeft,IntegerDigits[#,2],
       SameTest->(First[#2]===1&)]]& /@w11

Sort@%==Sort at rolw11==Sort at w11

Ordering at rolw11

mytocycles@%

****************************************************************
Dr. Wouter L. J. MEEUSSEN
w.meeussen.vdmcc at vandemoortele.be
eu000949 at pophost.eunet.be