Registered: Oct 2003
Posts: 13

There's a certain complexity to many of the characteristic forms used in Christmas images: snowflakes, Christmas trees, frost patterns, etc.

And as in so many other cases, it's rather easy to capture the essence of these forms using very simple cellular automaton rules.

So that means it's easy to use cellular automaton rules to make Christmas-like images.

Well, going through some of my archives recently, I was reminded that I did that almost exactly twenty years ago---for Christmas 1983. (The actual file date is November 22, 1983.)

I printed up four types of cards for Christmas 1983:

elementary rule 126, starting from a single black cell

k=3 totalistic code 357, with random initial conditions

k=5 totalistic code 44885, with random initial conditions

k=5 totalistic code 67020, with random initial conditions

or, in modern terms:

CellularAutomaton[126, {{1}, 0}, 150]

CellularAutomaton[{357, {3, 1}}, Table[Random[Integer, {0, 2}], {200}], 150]

CellularAutomaton[{44885, {5, 1}}, Table[Random[Integer, {0, 4}], {200}], 150]

CellularAutomaton[{67020, {5, 1}}, Table[Random[Integer, {0, 4}], {200}], 150]

Attached are scans of the original 1983 cards, together with modern versions made with the same rules (though with slightly different choices of random initial conditions).

It's of course inevitable, but I always find it pleasing that whatever year one makes a cellular automaton image, it always has the same fresh look. Somehow it reminds me of polyhedra from antiquity---that of course look just the same as polyhedra today.

Since 1983 lots of cellular automaton images have been used for Christmas cards---by me and others. And it'd certainly be great to see some of them posted to the Forum. But I thought members of the Forum might be amused to see my original 1983 efforts.

Note the absence in these efforts of rule 30 or anything like it. It wasn't until 1984 that I fully realized that simple initial conditions could still produce highly complex behavior. (See the NKS book, page 881, http://www.wolframscience.com/reference/notes/880b)

Report this post to a moderator | IP: Logged

Registered: Aug 2003
Posts: 712

Here are the card images...

Attachment: xmascards.zip
This has been downloaded 2374 time(s).

Report this post to a moderator | IP: Logged

Registered: Oct 2003
Posts: 2

I created these pictures for holiday cards.

I was trying to make them look like glass ornaments with CA patterns.
You judge if I succeeded. I think they still look good on their own.

I could not attach file to this post.
You can try downloading it here:
http://barecode.com/files/XMaSphere.zip
or here
https://dam.digash.com/~dig/XMaSphere.zip

You could easily recreate all of them with this code.

code:

<<Graphics`Shapes`

FlattenPosition[e_?MatrixQ,rc_:Automatic]:=
  Module[{r=rc},
         If[r===Automatic,r=Max[e[[All,2]]]];
         (#[[1]]-1)r+#[[2]]&/@e]

SphereMatrix[m_?MatrixQ]:=
  Module[{s,h,w,pos},
         {h,w}=Dimensions[m,2];
         s=Sphere[1,h,w+2];
         pos=FlattenPosition[Position[m,1]];
         s[[pos]]];

Show[Graphics3D[{FaceForm[RGBColor[1,0,0],RGBColor[0,1,0]],
                SphereMatrix[Transpose[CellularAutomaton[60,{{1},0},40,{All,All}]]]},
                ViewPoint->{-1.656, 2.170, 2.000},Lighting->False]];

PaddNumber[n_,p_]:=PaddedForm[n,p,NumberPadding->{"0","0"}]

SetDirectory[ToFileName[{$HomeDirectory,"doc","NKS","XmaTranSphere"}]];

With[{s=32},
  Do[Export["SpheresTranspose-"<>ToString[PaddNumber[i,2]]<>".gif",
            GraphicsArray[Partition[Table[Graphics3D[
              SphereMatrix[Transpose[CellularAutomaton[j,{{1},0},40,{All,All}]]],
              {Boxed->False,PlotLabel->j,ViewPoint->{2.6, 1.6, 2.0}}],
{j,s*i,s(i+1)-1}],3,3,1,Graphics3D[]]],ImageSize->1024],{i,0,Quotient[255,s]}]];

Do[Export["XMaTranSphere-"<>ToString[PaddNumber[i,3]]<>".gif",
          Graphics3D[{FaceForm[RGBColor[1,0,0],RGBColor[0,1,0]],
                     SphereMatrix[Transpose[CellularAutomaton[i,{{1},0},50,{All,All}]]]},
                     {Lighting->False,Boxed->False,ViewPoint->{2.6, 1.6, 2.0}}],
          ImageSize->640],{i,0,255}];

Do[Export["XMaSphere-"<>ToString[PaddNumber[i,3]]<>".gif",
      Graphics3D[{FaceForm[RGBColor[1,0,0],RGBColor[0,1,0]],
                 SphereMatrix[CellularAutomaton[i,{{1},0},50,{All,All}]]},
                 {Lighting->False,Boxed->False,ViewPoint->{2.6, 1.6, 2.0}}],
      ImageSize->640],{i,0,255}];

Last edited by Dimitry Gashinsky on 12-27-2003 at 04:48 PM

Report this post to a moderator | IP: Logged