Home > infos > A merry wolfram xmas!

A merry wolfram xmas!

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.

Advertisements
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: