Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Here's some confetti:

Graphics@Table[{
    RGBColor @@ RandomReal[{0, 1}, 3],
    Translate[#, RandomVariate[NormalDistribution[], 2]] &@
    Rotate[#, RandomReal[{0, 2 \[Pi]}]] &@
    Scale[#, .1] &@
    GeometricTransformation[
        #,
        ShearingTransform[
            RandomReal[{-45, 45}] Degree,
            {1, 0}, {0, 1}
        ]
    ] &@
    Translate[Rectangle[], {-.5, -.5}]
}, {1000}]

enter image description here

How can this code be improved, for example, by including shadows, raytracing or the effects of gravity to make it more realistic?

share|improve this question
    
Nice. I was thinking of animating it, but at 0.5 secs/frame on my PC that would be a slide show. Those transforms are rather expensive. –  Sjoerd C. de Vries Feb 17 '12 at 7:21
2  
The slowness and behaviour of GeometricTransformation and related stuff is something that forces (presumably many) users to write their own fast transformation routines. I´d like to see direct fast transformations on 2D and 3D objects out of the box. –  Yves Klett Feb 17 '12 at 8:18
3  
I've never seen Mathematica but this is just stunning! What you all can do with so small pieces of code! –  Tomas Feb 17 '12 at 11:30
    
By now I imagine this question looks strange to new visitors. The original title was "30 days running and excellent statistics on Area 51, congratulations to all participants!", and was posted to celebrate the success of the then newly created Mathematica section. However, that was seen unfit by the moderators, so it underwent some changes. –  David Nov 6 '13 at 14:22

6 Answers 6

up vote 74 down vote accepted

How can this code be improved, for example, by including shadows, raytracing or the effects of gravity to make it more realistic?

I felt that this question deserved an answer. The one I describe here is to create a set of confetti "agents" that respond in quasi-physical ways to external forces and "know" how they should be displayed.

It is handy, and a whole lot of fun, to do this in an extensible and easily modified way, because you're going to think of loads of improvements to make once the framework is in place. It helps to have well-documented code--there is less cognitive burden on you, the programmer, when modifying it--so I hope you won't mind that it's somewhat more verbose than usual.

By taking a top-down approach, this code practically writes itself. Start with the agents themselves, the confetti:

update[confetto[symbols_, location_, frame_, momentum_, angularMomentum_], 
      force_, {t_, dt_}] := 
  With[{\[Delta]Momentum = force[location, frame, momentum, t]},
   confetto[symbols, location + dt momentum, 
   rotate[frame, dt angularMomentum], 
   momentum + dt \[Delta]Momentum, angularMomentum]
  ];

I have endowed a single "confetto" with information about how to draw it (symbols), its present location and momentum (location and momentum)--that is, its physical state--, and some internal state information (frame for the orientation and angular momentum for its rate of change: you will see the little pieces of paper rotate as they move). That should be enough for rich simulations. A simulation will proceed by applying update over time periods of short duration to update the state of each object. This will rely on two other methods: force to compute forces and display to draw an object in its current state.

Update calls rotate to change the orientation, so let's take care of that detail now:

crossProduct[{x_, y_, z_}, {x0_, y0_, z0_}] := 
   {y z0 - y0 z, z x0 - z0 x, x y0 - x0 y};
rotate[frame_, \[Alpha]_] := # / (Norm[#] + 0.000001) & /@ 
      (Map[# + crossProduct[#, \[Alpha]] &, frame, {1}]);

(You can probably do this faster with quaternions, but this is good enough for a start.)

There are many ways to display a confetto, depending on what kind of object you would like it to be. For instance--this will be relatively fast and is useful for testing--just draw a point as a visual placeholder:

display[confetto[symbols_, location_,  ___]] := {symbols, Point[location]}

You can get more information by drawing a "tail" showing how the objects have been moving:

display[confetto[symbols_, location_, frame_, momentum_, ___]] := 
    {symbols, Thick, Line[{location, location - 0.2 momentum}]}

To emulate the other examples offered in this thread, and to show how the angular momentum works, let's view each object as a square. The frame attribute of a confetto determines its size and orientation. At the same time we draw these objects, we also draw their "shadows," provided they are in front of the coordinate planes. Here, then, is a fancier version of display:

shadow[x_, k_] /; 1 <= k <= Length[x] := ReplacePart[x, k -> 0];
display[confetto[symbols_, location_, frame_, ___]] := 
  Block[{x = frame[[1]], y = frame[[2]], vertices, objects, 
    shadowPlanes},
   vertices = {location + x, location + y, location - x, location - y};
   objects = {symbols, Polygon [vertices]};
   shadowPlanes = Pick[Range[Length[location]], Positive[location]];
   If [Length[shadowPlanes] > 0,
    f = Function[{k}, Polygon[shadow[#, k] & /@ vertices]];
    objects = Join[objects,
      {Opacity[0.5], GrayLevel[0.3], EdgeForm[{GrayLevel[0.3], Opacity[0.1]}]},
      f /@ shadowPlanes];
    ];
   objects
   ]

Write your own display function to simulate other objects.

Notice that none of this graphical work needs to get done except when we want to look at an object. Thus, we could create a long simulation (using update) but call display only at key times, or when interesting things happen. Separating the physics from the graphics is a good strategy.

Later on, to help the eye make sense of these shadows, we will want to have some fixed "walls" on which the shadows appear.

walls[indexes_List, size_, \[Epsilon]_] := 
  With[{square = {{1, 1}, {-1, 1}, {-1, -1}, {1, -1}}},
   {RGBColor[.97, .97, .97], Opacity[.1],
    Polygon /@ 
     Outer[Insert[ #2, \[Epsilon], #1] &, indexes, size square, 1] 
    }
   ]

Update invokes a "force" function to change an object's momentum. Newtonian gravitation on a flat earth is especially simple:

gravity[location_, frame_, momentum_, time_] := {0, 0, -1}

In general, the forces applied to an object depend on its location, the time (for time-varying forces), the object's location, and the situations of all other objects. Handling the latter is complicated so I have not built it into this framework: only external forces are applied. Here is a more complex example of what we can still do despite this limitation:

smokeRing[location_, frame_, momentum_, time_] := 
  Module[{normal = crossProduct @@ frame, origin = {15, 15, 15}, x,
    wind0 , \[Rho], z, wind1, wind, windSpeed = 5},
   x = location - origin;
   wind0 = {x[[2]], -x[[1]], 0};
   \[Rho] = Sqrt[x[[1]]^2 + x[[2]]^2] ; 
   If[\[Rho] == 0, \[Rho] = 1];
   z = x[[3]] ;
   wind1 = {-z x[[1]] / \[Rho], -z x[[2]]/ \[Rho], \[Rho] - 3};
   wind = (wind0  + wind1) windSpeed / Norm[x] - momentum;
    Abs[normal . wind] wind / Norm[wind] 
   ]

You can see it in action in the example below, where it has been added to the gravitational force. If you would like to see this force field, (partial) visualizations can be drawn; e.g.,

VectorPlot3D[
    smokeRing[{x, y, z}, {{1, 0, 0}, {0, 0, 1}}, {0, 1, 0}, 0], 
        {x, 0, 30}, {y, 0, 30}, {z, 0, 30}]

Note, though, that the force on a confetto depends on its orientation and its momentum: this attempts a realistic simulation of what wind does to a small slip of paper.

You might like to write code for other kinds of forces. Can you blow one smoke ring through another and then turn it green? :-)

We're all set to go! Let's make some confetti. I will place them all at the same location with the same orientation at the outset, but endow them with randomly varying momenta and angular momenta so that they all do different things:

r[n_] := RandomReal[NormalDistribution[0, 1], n];
confetti = 
  Table[confetto[
    Hue[RandomReal[]], {20, 20, 25}, {{1,0,0}, {0,1,0}}, r[3], r[3]/2], {320}]

To make them fly, we just need to keep updating their state as a clock ticks:

 Module[{c = confetti, speed = 0.06, nFrames = 240, 
    w = walls[Range[3], 30, e = -0.02], time = 0, slices, 
    force = Through[(gravity + smokeRing)[##]] &},
   slices = Table[time = time + speed; 
   c = ParallelMap[update[#, force, {time, speed}] &, c, {1}], {i, 1, nFrames}];
   frames = ParallelMap[Graphics3D[{w, Map[display, #, {1}]}, 
         PlotRange -> {{e, 29}, {e, 29}, {e, 29}},
         ViewVector -> {{70, 50, 40}, {-1, -1, -1}},
         Boxed -> False, ImageSize -> 400] &, Prepend[slices, confetti], {1}]
  ];

(You could anti-alias the graphics here if you like. I find that the computation takes too long, so I have left it out.) Through is a handy way to create combinations of forces: this gives you a manageable way to handle extremely complex combinations of additive forces.

That was a 30 second calculation, by the way: not fast, but not too shabby.

To keep the file size down, I have exported only some of these frames:

Export["F:/temp/confetti4a.gif", frames[[141 ;; 210]]]

Enjoy!

Frames 141-210

share|improve this answer
15  
I am impressed. +1 –  Mr.Wizard Feb 24 '12 at 22:31
    
Nicely done! +1 –  Vitaliy Kaurov Feb 24 '12 at 22:35
4  
I didn't expect something useful to come out of this thread after the mods crippled it, but seems like I was proven wrong. –  David Feb 24 '12 at 22:57
    
Worthy of a blog post! +1 –  jrhodin Feb 24 '12 at 23:01
    
The coolest Mathematica thing I have seen !!! –  500 Mar 1 '12 at 19:32

No fluid dynamics I'm afraid, but here's what I came up with

Preliminaries

n = {200, 200, 200};
dim = 2;
edges = {.015, .018, .024};
speed = {{0, -1}, {0, -1.5}, {0., -2}};
basePoly = {{0, -1}, {1/2, 0}, {0, 1}, {-1/2, 0}};
period = 3;

Initial position colour and orientation

angularVelocity = N[RandomChoice[Range[-8, 8], #] period Pi] & /@ n;
initPos = RandomReal[dim, {#, 2}] & /@ n;
initAngle = RandomReal[2 Pi, #] & /@ n;
colors = Transpose[ConstantArray[Hue /@ RandomReal[1, 200], 4]];

Visualisation

polygons[t_] := 
  Graphics[Table[
    Polygon[Function[{pos, ang, vel}, 
       Mod[pos + speed[[i]] t, 
           2] + # & /@ ((edges[[i]] basePoly).RotationMatrix[
           ang + vel t])] @@@ 
      Transpose[{initPos[[i]], initAngle[[i]], angularVelocity[[i]]}],
      VertexColors -> colors], {i, 3}],
   PlotRange -> {{0, dim}, {0, dim}}];

Manipulate[polygons[t], {t, 0, period - .03, .03}]

Or to get an animated gif (note that exporting takes quite some time)

tab = Table[polygons[t], {t, 0, period - .03, .03}];
Export["confetti2.gif", tab]

enter image description here

share|improve this answer
3  
@Mr.Wizard Judging from your solution, you're celebrating in space. At least I have included gravity :-) –  Heike Feb 17 '12 at 9:50
1  
You must know some shortcuts for pseudo-turbulent motion. Come on, impress me. :D –  Mr.Wizard Feb 17 '12 at 9:54
2  
Actually, confetto, since it's Italian –  Szabolcs Feb 17 '12 at 9:59
2  
Needs more Navier-Stokes! –  David Feb 17 '12 at 13:37
1  
@David, at the risk of people not getting the reference: is that like needs more cowbell? –  rcollyer Feb 17 '12 at 16:37

Here is my modest attempt at confetti:

With[{g = 9, n = 120},
  confe[t_] = Table[
    With[{f = RandomReal[{9, 20}], 
          th = RandomReal[{Pi/4 + Pi/12, Pi/2 - Pi/12}], 
          ph = RandomReal[{-Pi, Pi}]},
     Translate[
      With[{l = RandomReal[{2/5, 3/4}], h = RandomReal[{2/5, 3/4}], 
            c = RandomReal[{0, 1}]}, {Directive[EdgeForm[], Hue[c]], 
           Polygon[AffineTransform[
             Orthogonalize[RandomReal[1, {3, 3}]]] /@
                     {{l, 0, 0}, {0, h, 0}, {-l, 0, 0}, {0, -h, 0}}]}],
      {f t Cos[th] Cos[ph], f t Cos[th] Sin[ph], f t Sin[th] - (g t^2)/2}]],
         {n}]];

(* poor man's antialiaser, by Szabolcs *)
antialias[g_, n_: 3] := 
  ImageResize[Rasterize[g, "Image", ImageResolution -> n 72], Scaled[1/n]]

With[{tf = 2, frames = 81},
 Export["confetti.gif",
  Table[
   antialias@Graphics3D[confe[t], Axes -> None, Boxed -> False, 
    ImagePadding -> None, Lighting -> "Neutral", 
    PlotRange -> {{-20, 20}, {-20, 20}, {-2, 21}}, 
    SphericalRegion -> True],
   {t, 0, tf, tf/(frames - 1)}],
  AnimationRepetitions -> Infinity, "DisplayDurations" -> 1./20,
  ImageSize -> Medium]]

confetti!

Change Export[]+Table[] to Animate[] if desired.


(added 02/18/2012)

A little bird told me that the admonition "the more, the merrier" is quite applicable to the subject of confetti; I thus decided to see if I can do an animation with three confetti launchers instead of just one. I also wanted to experiment with Yves's enhancement of using confetti pieces with varying colors, so I added that enhancement in the following code as well:

i = 0;
Scan[
 With[{g = 9, n = 150, pt = #},
   confe[t_, ++i] = Table[With[{
       (* projectile motion parameters *)
       f = RandomReal[{9, 20}],
       th = RandomReal[{Pi/4 + Pi/12, Pi/2 - Pi/12}], 
       ph = RandomReal[{-Pi, Pi}],
       (* polygon parameters *)
       l = RandomReal[{2/5, 3/4}], h = RandomReal[{2/5, 3/4}]},
      {EdgeForm[], 
       Polygon[Composition[
          TranslationTransform[pt + {f t Cos[th] Cos[ph], f t Cos[th] Sin[ph], 
             f t Sin[th] - (g t^2)/2}], 
          AffineTransform[Orthogonalize[RandomReal[1, {3, 3}]]]] /@
                   {{l, 0, 0}, {0, h, 0}, {-l, 0, 0}, {0, -h, 0}}, 
            VertexColors -> Map[Hue, RandomReal[1, 4]]]}], {n}]] &,
         40 RandomReal[{4/5, 1}, 3] PadRight[
         Map[Composition[Through, {Cos, Sin}], 2 Pi Range[3]/3], {3, 3}]/Sqrt[3]]

With[{tf = 2 + 1/4, frames = 81}, 
 Export["confetti-tri.gif", 
  Table[antialias@
    Graphics3D[{confe[t, 1], confe[t, 2], confe[t, 3]}, Axes -> None, 
     Boxed -> False, ImagePadding -> None, Lighting -> "Neutral", 
     PlotRange -> {{-20 - 20/Sqrt[3], 40/Sqrt[3] + 20},
                   {-40, 40}, {-2, 21}}, SphericalRegion -> True],
        {t, 0, tf, tf/(frames - 1)}], AnimationRepetitions -> Infinity, 
          "DisplayDurations" -> 1./20, ImageSize -> Medium]]

confetti; thrice the fun

Generalizing the code to more than three confetti launchers should be straightforward.

As David had previously noted; the use of Szabolcs's antialias[] routine might make the Export[]-ing slow on some machines; it can be removed if need be.

share|improve this answer
1  
Welcome to the 4k club :-) –  Heike Feb 17 '12 at 10:26
2  
Hope you don't mind my edit. I like smooth and antialiased animations better! The change is to use 81 frames, 20 fps and antialiasing. –  Szabolcs Feb 17 '12 at 11:18
    
Thanks @Szabolcs; it seems Export[]ing on my machine is a bit hit-and-miss. –  J. M. Feb 17 '12 at 11:19
    
Things that run smoothly on my machine: GTA 4. Things that do not run smoothly on my machine: this confetti code. ;-) –  David Feb 17 '12 at 13:31
    
@David: That's nothing; I did all this on a measly underpowered netbook (with some code help from Szabolcs), and it was a bit of a wait for Export[] to finish... ;) –  J. M. Feb 17 '12 at 13:35

Elaborating on Mr. Wizard´s answer, a quicker way to generate and render the polygons is to define your own roughshod transformation functions and use the multi-primitive syntax for Polygon together with random VertexColors. The resulting graphics is rendered way faster and is much more responsive to mouse interaction:

diamond = {{#, -#} #2, -{#, #}, {-#, #} #2, {#, #}} &;
diamond3D = Polygon[{##, 0} & @@@ diamond[1, 1/2]];

n = 5000;

rt[pts_, rot_, tran_] := (rot.#) + tran & /@ pts

rm[axis_, \[Theta]_] := With[{ax = Normalize[axis]},
  With[{x = ax[[1]], y = ax[[2]], z = ax[[3]], cos = Cos[\[Theta]], 
    sin = Sin[\[Theta]]},
   {{cos + x^2 - cos x^2, x (y - cos y) - sin z, 
     sin y - (-1 + cos) x z}, {x (y - cos y) + sin z, 
     cos + y^2 - 
      cos y^2, -sin x - (-1 + cos) y z}, {-sin y - (-1 + cos) x z, 
     sin x - (-1 + cos) y z, cos + z^2 - cos z^2}}
   ]
  ]

pts = Table[
   rt[diamond3D[[1]], 
    rm[RandomReal[{0, 1}, 3], RandomReal[{0, 2 Pi}]], 
    RandomReal[NormalDistribution[25, 6], 3]
    ], {n}];

Graphics3D[
 Polygon[pts, 
  VertexColors -> Table[ConstantArray[Hue[RandomReal[]], 4], {i, n}]]]

enter image description here

or if you are feeling particularly whimsical (it is carneval time):

Graphics3D[
 Polygon[pts, 
  VertexColors -> Table[Hue[RandomReal[]], {i, n}, {t, 4}]]]

enter image description here

share|improve this answer
1  
Yves, where is the Graphics3D code for the upper graphic? Also, you should add RotationAction -> "Clip" for fast rotation. I'll +1 once you add the code. –  Mr.Wizard Feb 17 '12 at 9:38
1  
Thanks, that was lost in edition. I guess the speedup is noticeable as well with the Clip set - then it is even more responsive. –  Yves Klett Feb 17 '12 at 9:46
    
How did you come up with rm? Played around with the built-in transformations, and created a transformation matrix out of it in the end? –  David Feb 17 '12 at 13:33
1  
@David: it's Rodrigues's rotation formula. –  J. M. Feb 17 '12 at 14:17
1  
The inbuilt RotationMatrix command is very powerful, but for simple transformations using a dedicated function (which was derived as assumed above by simplifying the output of RotationMatrix[theta,{x,y,z}] is much faster. That is a handy feature of Mathematica: using a symbolic solution and whittling away the stuff you do not need to tune for performance. –  Yves Klett Feb 17 '12 at 15:27

Very windy

It's very windy here today, so the confetti is going everywhere.

g = Graphics3D[
Table[{EdgeForm[], RandomChoice[{White, Pink, Yellow}], 
 Translate[
  Polygon[RandomReal[.01, {4, 3}] ], {RandomReal[], RandomReal[], 
   RandomReal[]}]} , {x, 1500}], Boxed -> False];
Export["animation.gif", 
 Table[Show[g, ViewAngle -> 1, ViewPoint -> {0, 0, 0}, 
    ViewCenter -> {Sin[2 x], Cos[-2 x], Cos[2 x]} , 
    Lighting -> "Neutral"] , {x, -2, 2, 0.05}]]
share|improve this answer

Since Heike is AWOL here is some 3D confetti to tide us over.

diamond = {{#, -#} #2, -{#, #}, {-#, #} #2, {#, #}} &;
diamond3D = Polygon[ {##, 0} & @@@ diamond[1, 1/2] ];

rots = Rest@Tuples[{0, 1}, 3];

Graphics3D[{EdgeForm[None],
  Table[
   {Hue @ Random[],
     Translate[
       Rotate[diamond3D, Random[] Pi, RandomChoice@rots],
       RandomReal[NormalDistribution[25, 6], 3]
     ]},
   {500}
  ]
}, RotationAction -> "Clip"]

Mathematica graphics

share|improve this answer
    
Why does everyone get rid of my random shearing transformation? :-( –  David Feb 17 '12 at 13:34
    
@David wasn't that to produce a 3D effect in 2D? –  Mr.Wizard Feb 17 '12 at 13:37
1  
No, I start with rectangles and then shear them with a random angle $\in[-45°,45°]$ to create the diamonds. –  David Feb 17 '12 at 13:39
    
@David so the intent is not similar diamonds in different perspectives, but rather different shapes of confetti? –  Mr.Wizard Feb 17 '12 at 13:41
    
Yes. (ALthough primarily the intent was using ShearingTransformation because I've never done that before.) –  David Feb 17 '12 at 13:43

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.