Stats raving mad

The blog

A merry wolfram xmas!

by M. Parzakonis on December 14, 2009

Christmas coming & time for fun!  Wolfram’s demonstrations give you a sense of the holiday season along some nice demonstrations. I particulary like the “Ornamental Holiday Decoration

Manipulate[
 Module[{level0, level1, level2},
 level0 = C[spikey, 0];
 level1 =
 Flatten[daughterPolyhedra[C[spikey, 0], {d1, ω1, s1}, ρ s1]];
 level2 =
 Flatten[daughterPolyhedra[#, {d2, ω2, s2}, ρ  s1 s2] & /@
 Cases[level1, _C]];
 Graphics3D[{EdgeForm[],
 {Red, egc[level0]}, gg1 = {col1, egc[level1]},
 gg2 = {col2, ControlActive[{}, egc[level2]]},
 Directive[GrayLevel[0.2], Specularity[colc, 12]],
 ecc[{level1, level2}]}, Boxed -> False,
 ImageSize -> {400, 400}]],
 "layer 1:",
 {{d1, 1.5, "distance"}, -3, 3, ImageSize -> Tiny},
 {{ω1, 0, "rotation"}, -Pi, Pi, ImageSize -> Tiny},
 {{s1, 1/2, "size"}, 0, 1, ImageSize -> Tiny},
 {{col1, Yellow, "color"}, Blue, ControlType -> None},
 Delimiter,
 "layer 2:",
 {{d2, 1, "distance"}, -3, 3, ImageSize -> Tiny},
 {{ω2, 0, "rotation"}, -Pi, Pi, ImageSize -> Tiny},
 {{s2, 1/2, "size"}, 0, 1, ImageSize -> Tiny},
 {{col2, Green, "color"}, Green, ControlType -> None},
 Delimiter,
 "connectors:",
 {{ρ, 0.3, "radius"}, 0, 1, ImageSize -> Tiny},
 {{colc, Brown, "color"}, Yellow, ControlType -> None},
 AutorunSequencing -> {1, 3, 5, 7},
 Initialization :> {
 spikey =
 MapAt[Developer`ToPackedArray,
 MapAt[Developer`ToPackedArray, N[PolyhedronData["Spikey"]][[1]],
 1], {2, 1}];
 mirrorRotateAndShift[gc_GraphicsComplex,
 n_, {distance_, angle_, size_}, ρ_] :=
 With[{aux =
 mirrorRotateAndShiftCF[gc[[1]], gc[[1, n]], distance, angle,
 size]}, {C[GraphicsComplex[aux, gc[[2]]], n],
 Cylinder[{gc[[1, n]], aux[[n]]}, ρ]}];
 mirrorRotateAndShiftCF =
 Compile[{{vertices, _Real, 2}, {rPoint, _Real, 1}, distance,
 angle, size},

 Module[{c = Cos[angle], s = Sin[angle], dirx, diry, dirz,
 rPoint1, pCx, pCy,
 V, parallelComponent, normalComponent, mp},
 mp = (Plus @@ vertices)/Length[vertices];
 dirz = #/Sqrt[#.#] &[rPoint - mp];
 dirx = #/Sqrt[#.#] &[RandomReal[{-1, 1}, 3]];
 dirx = #/Sqrt[#.#] &[dirx - dirx.dirz dirz];

 diry = {-dirx[[3]] dirz[[2]] + dirx[[2]] dirz[[3]],

 dirx[[3]] dirz[[1]] - dirx[[1]] dirz[[3]],
 -dirx[[2]] dirz[[1]] +
 dirx[[1]] dirz[[2]]};
 rPoint1 = mp + size (rPoint - mp);
 Table[V = mp + size (vertices[[k]] - mp);

 normalComponent = (V - rPoint1).dirz dirz;     

 parallelComponent = (V - rPoint1) - normalComponent;   
 pCx = parallelComponent.dirx;
 pCy = parallelComponent.diry;

 rPoint + (c pCx + s pCy) dirx + (-s pCx + c pCy) diry +
 distance dirz -
 normalComponent,
 {k, Length[vertices]}]],
 CompileOptimizations -> False];
 daughterPolyhedra[
 C[gc_GraphicsComplex, m_], {distance_, angle_, size_}, ρ_] :=

 Table[If[k === m, Sequence @@ {},
 mirrorRotateAndShift[gc, k, {distance, angle, size}, ρ]], {k,
 13, 32}];
 egc[expr_] :=
 Cases[Flatten[
 Cases[Flatten[{expr}], _C] /. C -> List], _GraphicsComplex];
 ecc[expr_] := Cases[Flatten[expr], _Cylinder];
 }]

Hitting execution we get,Play around with the sliders…

You can dive more into the christmas spirit here.

Leave a Reply

Your email address will not be published. Required fields are marked *

*

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong> <pre lang="" line="" escaped="" highlight="">