Contour Animations

Purpose: Illustrate the concept of contour maps and their relationship to the 3D plot of z = f(x,y) using animations.
      Developer:  Dr Brad Kline, US Air Force Academy, CO
File Name: ContourAnimate.nb

Initialization Cells

\( (* : Title : \ Surface - to - Contour\ Map\ Animation\ *) 

    
 (* : Context : \ Graphics`ContourAnimate`\ *) 

    
 (* : Author : \ Bradford\ J . \ Kline\ *) 

    
 (* : Mathematica\ \(Version : \ 3.0\)\ *) 

    
 (* : Package\ \(Version : \ 1.1\)\ *) 

    
 (*\( : History : 
	V1  .0\ by\ B . \ Kline\), \ 
      March\ 1999. \ \ 
	V1  .1\ by\ B . \ Kline, \ June\ 1999. \ \ *) 

    
 (*\ Last\ \(Revision : \ \ June\ 1999\)\ *) 


    Off[General::"spell"]; 
Off[General::"spell1"]; 


    BeginPackage["Graphics`ContourAnimate`"]; 


    Needs["Utilities`FilterOptions`"]
\)\(ContourAnimate::usage = 
      "ContourAnimate[f, {x, xmin, xmax}, {y, ymin, ymax}, (NumberOfFrames), (options...)] generates an animation showing the migration of horizontal traces through the surface z = f[x,y] to contours in the xy-plane.  The parameter NumberOfFrames is optional, and defaults to 10.  ContourAnimate accepts any options valid for Graphics3D."; 
		

    Begin["`Private`"]; 


    ContourAnimate[f_, \ {x_, x0_, x1_}, \ {y_, y0_, y1_}, 
        numberofframes_Integer, \ opts___] := 
	
      Module[{contours, surface, contours3d, g, a, val, pts, originalview, 
          targetview, plotrange, fullrange, t}, 

        contours = 
          ContourPlot[f, {x, x0, x1}, {y, y0, y1}, ContourShading -> False, 
            DisplayFunction -> Identity, 
            Evaluate[FilterOptions[ContourPlot, opts]]]; 

        surface = 
          Plot3D[f, {x, x0, x1}, {y, y0, y1}, \ DisplayFunction -> Identity, 
            Evaluate[FilterOptions[Plot3D, opts]], Mesh -> False]; 

        plotrange = FullOptions[surface, PlotRange]; 

        fullrange = {plotrange[\([1]\)], plotrange[\([2]\)], 
            1/2 {plotrange[\([3, 1]\)] - Abs[plotrange[\([3, 1]\)]], 
                plotrange[\([3, 2]\)] + Abs[plotrange[\([3, 2]\)]]}}; 

        Do[
	Clear[g]; 
g\  = \ Function[{x, y}, a*f]; 
	
          contours3d = 
            \(Graphics[contours]\)[\([1]\)] /. 
              Line[pts_] :> 
                \((val = Apply[g, First[pts]]; 
                  Line[Map[Append[#, val]&, pts]])\); 

          Show[Graphics3D[contours3d], surface, 
            DisplayFunction -> $DisplayFunction, 
            FilterOptions[Graphics3D, opts], 
			
            PlotRange -> fullrange], {a, 1, 0, 
            N[\(-1\)/\((numberofframes)\)]}]; 

        originalview = FullOptions[surface, ViewPoint]; 

        targetview\  = \ {0, 3, 30}; 
		
        Do[
			
          Show[Graphics3D[contours3d], DisplayFunction -> $DisplayFunction, 
            ViewPoint -> \((\((1 - t)\)*originalview + \((t)\)*targetview)\), 
            FilterOptions[Graphics3D, opts], PlotRange -> fullrange], {t, 0, 
            1,  .1}]
				]
\)\(ContourAnimate[f_, \ xRange_List, \ yRange_List, \ opts___Rule] := 
      ContourAnimate[f, \ xRange, \ yRange, \ 10, \ opts]
\)\(End[\ ]; 

EndPackage[\ ]\)

The initialization cells in this notebook define the command ContourAnimate.  This command allows us to illustrate the relationship between horizontal traces of the surface z = f[x,y] and the contour diagram of the function f[x,y].  The command generates a sequence of plots showing the traces migrating from the surface to the xy-plane.

ContourAnimate

Evaluate the following for a brief description of the syntax for ContourAnimate:

?ContourAnimate

ContourAnimate basically accepts the same arguments as the standard Mathematica function Plot3D.  Here is an example:

ContourAnimate[x^2 + y^2, {x, -5, 5}, {y, -5, 5}];

ContourAnimate accepts an optional parameter following the second range.  This parameter specifies the number of frames before the contours reach the xy-plane.  The default number of frames is 10.  Here is an example with 4 frames:

ContourAnimate[x^2 + y^2, {x, -5, 5}, {y, -5, 5}, 4];

We may enter the same options that Plot3D and Graphics3D permit, including a change of ViewPoint and PlotRange.

ContourAnimate[x^2 + y^2, {x, -5, 5}, {y, -5, 5}, 4, 
      ViewPoint -> {0.568,  -1.288,  -1.495}, PlotRange -> {0, 25}, 
      ClipFill -> None];

Here is a simulated mountain scene.  You can use the ContourAnimate command to demonstrate the relationship between the earth's terrain and the corresponding topographic map.

ContourAnimate[
      Sin[x] Sin[y]  - 5, {x, -2 Pi, 2  Pi}, {y, -2 Pi, 2  Pi}, 5, 
      PlotPoints -> 30];