Tag Archives: Mathematica

Animating in Mathematica

M. gave us a lecture on how $S_4$ can be regarded as rigid transformation (rotations about the origin) of a cube centered at the origin. This was not straightforward for me to visualize. So ,after a long contemplation what to use: OpenGL/C++, Povray+Blender, Mathematica and its very useful animation features, I ended up deciding to use Mathematica. I had an intuition that Mathematica, albeit not being perfect in animation and visualization like Blender and Povray will provide for a very fast result (which at the moment was a priority for me). To visualize this you can use the following code:

g=Graphics3D[{Opacity[0.3], Cuboid[{-5, -5, -5}, {5, 5, 5}], 
  Opacity[1.0], Thick, Green, Line[{{-5, -5, -5}, {5, 5, 5}}], 
  Line[{{5, -5, -5}, {-5, 5, 5}}], Line[{{-5, 5, -5}, {5, -5, 5}}], 
  Line[{{-5, -5, 5}, {5, 5, -5}}], Black, 
  Text[Style[1, Large, Bold, Red], {5, 5, 5}],
  Text[Style[2, Large, Bold, Red], {5, -5, 5}],
  Text[Style[3, Large, Bold, Red], {-5, 5, 5}],
  Text[Style[4, Large, Bold, Red], {-5, -5, 5}]},Boxed->False,PlotRange->{{-9,9},{-9,9},{-9,9}}];
Animate[MapAt[Rotate[#, t,{0,5,5},{0,0,0}]&,g,{1}],{t,0,Pi},
  AnimationRunning->False,AnimationRepetitions->1,AnimationDirection->ForwardBackward,FrameLabel->"Transposition(1,3)"]
Animate[MapAt[Rotate[#,t,{5,5,5},{0,0,0}]&,g,{1}],{t,0,2Pi/3},
  AnimationRunning->False,AnimationRepetitions->1,AnimationDirection->ForwardBackward,FrameLabel->"3-Cycle (2,3,4)"]
Animate[MapAt[Rotate[#,t,{0,0,1},{0,0,0}]&,g,{1}],{t,0,Pi/2},
  AnimationRunning->False,AnimationRepetitions->1,AnimationDirection->ForwardBackward,FrameLabel->"4-Cycle (1,3,4,2)"]
Animate[MapAt[Rotate[#,t,{0,0,1},{0,0,0}]&,g,{1}],{t,0,Pi},
  AnimationRunning->False,AnimationRepetitions->1,AnimationDirection->ForwardBackward,FrameLabel->"2 Transpositions (1,4)(2,3)"]

Yes combining the Animate in one single panel was rather a pain as I did not know how to change variables (axis and angle of rotation) all in one panel (I wasn’t able to do it with Buttons and Dynamic in Mathematica).

If you do not have Mathematica, you can still download the animation file here. Now I am proud to claim that I did a Mathematica animation on my own: Time from 0-knowledge to one animation = Roughly 1 hour. If this was Blender+Povray, although I have experience in working with them, I would still need much more time to model, texture and finally generate the animation. So my conclusion is: although the animations and features of Mathematica has many things left to be desired, it is probably the best choice if you want to animate a few mathematical object very fast on the fly. The 1hr work I invested, is now a 5min. work for any other remainder animation I want to make in Mathematica. If the animation I want to do would require much more time than this, e.g. complicated interactions with buttons, phong and radiosity etc., I would probably look at other options as well.

To save an avi you may use something like the following (notice: I have hidden sliders and panel for a better look of the video).


Export["C:/temp/output1.avi",
Manipulate[MapAt[Rotate[#, t,{0,5,5},{0,0,0}]&,g,{1}],{t,0,Pi,
AnimationRunning->True,AnimationDirection->ForwardBackward,AnimationRepetitions->1,Paneled->False,ControlType->None},
FrameLabel->"Transposition(1,3)"]
]

This results in a very poor video compression (quality of videos were OK, but for 4sec. I got 35Mb of video). But that is easily remedied by using Handbrake (I do this if I don’t have too much time to play around more complicated tools) or VirtualDub (which I only use if I have a lot of time to invest.. which is sadly less often the case). I combined the four different videos showing a permutation from each conjugacy class of $S_4$. Here is the final video after compression (also a link was given earlier for you to download the video in case you do not have HTML5 support in your browser):

Mathematica and me

$
\newcommand\R{\mathbb{R}}
$
The last time I think I was serious with Mathematica was 2001? or maybe a few years earlier. I really cannot remember. But I left it and always looked at Maple for enlightenment (where I was/am not still good at). In the past when I looked at Mathematica I thought of it as a Maple similar and probably any amateur would still believe this to be. Both very clumsy to work with. Now, 2016, they differ so much and have advanced so much. One is good at one thing, the other at another. But this is not a debate which is better. This is a “tutorial” what you can do a little good with one. Today Mathematica won my heart (another day it could be Maple). Because the topic “Cylindrical Algebraic Decomposition” (which we in the real world, i.e. real algebraic geometry world, just simply call “cylindrical decomposition”) expresses the strength of Mathematica.

A Mathematica code is a bit different from a C++ code (or even Maple) that I am more used to. So let me list down some things I (think I) learned during the coarse of a few days looking at one or two codes:

  • f @ something means apply f to x
  • f @@ List[...] means change List to f
  • f @@@ List[List[...]] means List[f[...]]

The first problem that I had is the following: Given an real algebraic set defined by a polynomial function $f:\R^m\rightarrow \R$ , find the number of connected component of the complement of this set. Also find an “algorithm” that can tell if two elements in $\R^m$ belong in the same connected component.

For the sake of argument I took $m=2$ and variables to be $x$ and $y$. Then I wanted to find the connected components of all those $(x,y)$ for which $f(x,y)\neq 0$. To this I copied and modified a code from a mathematica stackexchange post and the modified code looks like this

Coco[eqns_, xrange_: {x, -1, 1}, yrange_: {y, -1, 1}, 
  plotit_: False] := 
 Module[{decomp, connected, regconn}, 
  regconn = 
   Resolve@Exists[{x, y}, (x | y) \[Element] Reals, 
      RegionMember[
       RegionIntersection[ImplicitRegion[#1, {x, y}], 
        RegionBoundary@ImplicitRegion[#2, {x, y}]], {x, y}]] &;
  decomp = 
   List @@ BooleanMinimize@CylindricalDecomposition[eqns, {x, y}];
  connected = 
   Or @@@ ConnectedComponents@
     Graph[decomp, 
      UndirectedEdge @@@ 
       Select[Subsets[decomp, {2}], 
        regconn @@ # || regconn @@ Reverse@# &]];
  Print["number of connected components: ", Length@connected];
  If[plotit,Print[
    (Quiet@
         RegionPlot[#, xrange, yrange, 
          PlotPoints -> 100] & /@ {decomp, connected})~
     Join~{FullSimplify[connected, (x | y) \[Element] Reals]}]]; 
  Return[connected]]

As you can see the code just simplifies the regions defined by cylindrical algebraic decomposition using disjunctive normal form and then finds the regions of intersection by identifying each region as a vertex of a graph and then connecting the vertices if they have common intersections. Then Mathematicas (quit powerful) graph theory package can figure out the connected components of the graph and thus identify exactly the connected components of the Zariski open set defined by the complement of the hypersurface. This, I think, is an overkill. You really need not convert everything into a graph and use Mathematica’s connected component procedure for graph. You just need to use pigeon-hole principal by placing each region in a set containers and iteratively by order fill the set containers depending on common intersection of region or make a new container if there is no existing set container having region with common intersection. Since I was/am a lazy animal and the procedure was fast enough for my purpose, I left it as it was.

I tested this on a curve for which I knew how many connected components it’s complement have, namely the curve $y^2=x(x-1)(x-2)(x-3)(x-4)$ the plotof which looks like this:
curve_4_coco

After applying the Coco on the curve by typing (the three other parameters in Coco are optional, they are only used to plot the regions)

connected = Coco[y^2 != x(x-1)(x-2)(x-3)(x-4),{x,0,5},{y,-10,10},True];

I get the picture for the cylindrical algebraic decompositions

the picture of the different components

the number of components and the actual regions given (click to see in full glory)

The counting of component for this function, without plotting, took around 6.7 seconds in my not-so-fast laptop. Understandably, most of the time was sucked by the plotting. The plotting does not concern me a lot so I am happy with this. I think it can even be made faster (I predict, with correct coding and optimization you can squeeze it to 2 seconds).

Hopefully, in a future post I will show how this is done (with less pictures) when the hypersurface lies in a space with dimension greater than two (i.e. $m>2$).