4

Interactive Applications, Image Processing and More

In this chapter we explore the use of dynamic functions for creating interactive simulations (demonstrations). We also introduce image processing, graphs and networks and show some of the commands added to the most recent Mathematica versions for advanced calculus. We will use examples throughout the chapter to illustrate the functionality of all the commands.

4.1 Manipulate

One of the most interesting functions in Mathematica is Manipulate. We can easily build dynamic applications with it. This function has numerous options, and in this section we show some of them. Normally we will use more than one option at a time; if you prefer you can try them separately and then combine them. Remember that if you don’t know the syntax of a function you can always use the free-form input first and later modify the Mathematica output to suit your needs.

• We type in an input cell: manipulate sin x from 0 to 1. An input and an output are generated.

  

• In the input cell above we click on the floating label “Replace cell with this input” that appears when placing the mouse below “Result”. This way we obtain the function below that we can use as a basic Manipulate template. Notice that a is a parameter that can take values between 0 and 2 with a default value of 1. Try moving the slide bar with the cursor.

Manipulate [Plot [Sin [x *a ], {x, 0, 1}], {{a, 1}, 0, 2}]

The output area containing Manipulate changes dynamically depending on the input. However, sometimes we may be interested in giving it a fixed size.

• To set the size of that area we use the option ContentSize. Note that if the result does not fit, a sliding bar is displayed. We also use BaseStyle to choose the output format.

  Manipulate[D [Sin [x ]/ Cos[ x], {x, n}],
    {n, 1, 10, 1}, ContentSize → {200, 50},
    BaseStyle → {Blue, FontFamily → "Times", 14}]

  

In some of the examples that come next we use ContentSize to reduce the print size. To replicate them in a computer you can remove the option.

• In the following example we use Manipulate to dynamically represent the famous Lissajous curves: x (t )= cos (a t), y (t) = sin(b t), for integers a and b. By adding the option Appearance   → “Labeled” we can display to the right of the sliding bars the actual values of the parameters. We can also label the parameters using the syntax: {{a, initial a value, “a label”}, minimum a value, maximum a value}:

  Manipulate
   [ParametricPlot[{Cos[ at], Sin[ bt]}, {t, 0, 2 π} ],
   {{a, 3, "Amplitude a"}, 1, 8, Appearance → "Labeled"},
   {{b, 3, "Amplitude b"}, 1, 13, Appearance → "Labeled"},
   ContentSize →{150, 150}]

  

• To display in the previous output the controls associated to the parameters a and b you can click on . If you’d like them to be shown by default, you should add the option Appearance → “Open”.

  Manipulate[Plot [Sin [nx ], {x, 0, 2 π}],
   {n, 1, 20, Appearance → "Open"}, ContentSize →{200, 150}]

  

• An alternative way to display the controls is AppearanceElements → All.

  Manipulate [Plot [Sin [nx ], {x, 0, 2 π}], {n, 1, 20},
   AppearanceElements → All, ContentSize →{200, 150}]

  

• You can also include a drop-down button. This will automatically be added when a parameter contains five or more choices as shown in the next example. In this case we have the possibility to choose several filling alternatives for displaying a graph. We use the Plot option: Filling. We also use PlotLabel to show the parameter value when labeling the graph. Notice that the combination of Plot options with Manipulate greatly increases the number of possible combinations for dynamic interactions.

  Manipulate[Plot [Sin [nx ], {x, 0, 2 π}, Filling → choice, PlotRange → 2,
    PlotLabel →2, Style[ StringForm[ "Sin(n t) representation for n = `1`",
      PaddedForm [n, {4, 2}]], 10]],
    {n, 1, 20}, {{choice, None, "Choice"}, {None, Axis, Top, Bottom,
     Automatic, 1, 0.5, 0, - 0.5, - 1}}, ContentSize → {200, 150}]

  

• Here is a slightly more complicated example showing how we can format the output of Manipulate . In this case we take advantage of the flexibility provided by the options of Grid.

  Manipulate[
    Grid [Table [{i, i^m}, {i, 1, n}],
     Alignment → {{Left, Right}, Automatic}, Frame → All,
     ItemStyle → {Blue, FontFamily → "Helvetica"}, Background → LightGray],
    {n, 5, 20, 1}, {m, 5, 100, 1}]

  

Another interesting option is ControlType. For example, we can use Checkbox, an option not only available in Manipulate, to include check boxes. The syntax is: {a,{a1,a2}}, where {a1,a2} refers to the alternatives available, a1 is the default option. When there are more than two choices you can use RadioButtonBar.

• In the example below there are options to display the axes and to choose the filling color of the disk. The filling color by default is red.

  Manipulate[
    Graphics [{EdgeForm[ Thick], color, Disk[]}, Axes → axes, ImageSize → Tiny],
    {{axes, True, "Axes"}, {True, False}, ControlType → Checkbox},
    {{color, Red, "Color"}, {Red → "Red", Green → "Green", Blue → "Blue"},
     ControlType → RadioButtonBar}]

  

Once we execute the previous command we can change the color and/or choose not to display the axes.

• The next example uses ColorSlider to dynamically change the background color as we move along the color bar starting with LightBlue. We use the label “Disk color”. In this case we don’t need to type ColorSlider because it’s implicitly stated.

  Manipulate[Graphics [{EdgeForm[ Thick], col, Disk[]}, ImageSize → Tiny],
    {{col, LightBlue, "Disk Color"}, Red}]

  

• We can also do something similar using ColorSetter. Clicking on the colored square will launch the operating system color palette to enable us to dynamically modify the disk background.

  Manipulate[Graphics [{EdgeForm[ Thick], color, Disk[]}, ImageSize → Tiny],
    {{color, LightBlue, "Color"}, LightBlue, ControlType → ColorSetter}]

  

• In the command below we use ControlType→Slider2D to move a point of a certain size around a square.

  Manipulate[Graphics [{PointSize[ 0.1], Point[ pt]},
    PlotRange → 1, ImageSize → Tiny], {pt, {- 1, - 1}, {1, 1}}]

  

• This example is more advanced.

  Manipulate[
  
     Graphics[{Line[Table[{{Cos[t], Sin[t]}, pt}, {t,2π30,2π,2π30}]]},
  
      PlotRange → 1, ImageSize → Small],
  
     {pt, {-1, -1}, {1, 1}}]

  

• Here we combine Manipulate with a gauge (HorizontalGauge). Click on it and move it around.

  Manipulate [Plot [Sin [p t], {t, 0, 2 π},
     PlotRange → {{0, 2 π}, {- 1, 1}}, ImageSize → Small],
    {{p, 1, "Period"}, 0, 5, HorizontalGauge[##] &}, ControlPlacement → Bottom]

  

If we use Locator with Manipulate we will be able to move objects in the output with the mouse. Additionally, all the information associated to those objects will be dynamically updated. The syntax of Locator is: {{parameter, {x, y}}, Locator}.

In some of the examples that follow we have added the option ImageSize → Tiny or ImageSize → Medium to reduce the print size. To replicate them in a computer remove the option.

• In this example we can move the three vertices of a polygon and see how the triangle area is filled automatically.

  Manipulate[
    Graphics [{Pink, Polygon[pts]}, PlotRange → 1.1, ImageSize → Tiny],
    {{pts, {{0, 0}, {1, 0}, {0, 1}}}, Locator}]

  

We are going to extend the functionality of the previous command to calculate and display the area of the triangle, but first let’s introduce a way to call a function from within Manipulate.

• Use the option SaveDefinitions.

  g[x_] := x^2
  
  Manipulate[g[y], {y, 0, 100, 1}, SaveDefinitions → True]

  

  Alternatively, we can use Initialization with the function that we would like to evaluate first when Manipulate is executed:

  Manipulate[h [y], {y, 0, 100, 1}, Initialization :→ (h[x_] := x^2)]

  

• Going back to the example of the triangle, to explicitly include the value of its area we have to define a function that calculates it from the Cartesian coordinates of the its three vertices: v₁, v₂, and v₃.

  areaTriang[{v1_, v2_, v3_}] :=
    Abs[Det[Join[Transpose[{v1, v2, v3}], {{1, 1, 1}}]]]/2
  areaTriang[{{3, 2}, {4, 1}, {7, -3}}]
  12

• Now we include areaTriang in the previously typed Manipulate. Move the vertices with the mouse to see how the area is dynamically updated.

  Manipulate[Graphics[{Pink, Polygon[pts]}, PlotRange → 1,
     PlotLabel → StringForm["Triangle Area = '1'", areaTriang[pts]],
     ImageSize → Tiny],
    {{pts, {{0, 0}, {1, 0}, {0, 1/2}}}, Locator},
    Initialization =→ (areaTriang[{v1_, v2_, v3_}] :=
        Abs[Det[Join[Transpose[{v1, v2, v3}], {{1, 1, 1}}]]]/2) ]

  

• If we use LocatorAutoCreate → True we will be able to add or remove points using click (click in OS X).

  Manipulate[
    Graphics[{Pink, Polygon[pts]}, PlotRange → 1.1, ImageSize → Tiny],
    {{pts, {{0, 0}, {1, 0}, {0, 1}}}, Locator, LocatorAutoCreate → True}]

  

• In this example we use BSplineFunction to generate a B-Spline curve associated with all the displayed points.

  Manipulate[
    Show[Graphics[{{Point[p], Green, Line[p]}}, ImageSize → Small],
     ParametricPlot[BSplineFunction[p][t], {t, 0, 1}]],
    {{p, pts}, Locator},
    Initialization =→ (pts = {{1, 5}, {3, 2}, {6, 4}})]

  

If we are going to use PlotPoints with a large number of points, we can save computation time by using ControlActive.

• While moving the slider button, PlotPoints performs the calculations using a preset value. In this example the first argument in ControlActive is 8; once we stop, PlotPoints will use another value, normally significantly bigger than the preset one (in this example 40). If we replace 8 with 40 in ControlActive, the update of the plot will slow down. We also include Defer, a function that displays the unevaluated form of its input to label the graph.

  Manipulate[Plot[Sin [1x−a], {x, - 1, 1}, PlotPoints → ControlActive[8, 40],
    PlotRange → 1, PlotLabel → Style[Defer[Sin [1x−″a″]], Medium]], {a, 0, 1}]

  

• DynamicModule is another function used for dynamic applications. The example below shows how to use it to display some of the different control types available in Mathematica.

  DynamicModule[{pua, rbba, cbba, tgba}, Grid[{
     {Style["Control Type", FontWeight → "Bold"],
     Style["Example", FontWeight → "Bold"]},
     {"Slider", Manipulate[x, {x, 0, 1, ControlType → Slider},
       LabelStyle → 16]},
     {"2DSlider", Manipulate[x, {x, 0, 1, ControlType → Slider2D},
       LabelStyle → 16]},
     {"PopupMenu", Row[{PopupMenu[Dynamic[pua], {a, b, c, d}],
       "       ", InputField[Dynamic[pua], FieldSize → 5]}]},
     {"RadioButtonBar", Row[{RadioButtonBar[Dynamic[rbba], Range[5]],
       "       ", InputField[Dynamic[rbba], FieldSize → 5]}]},
     {"CheckBoxBar", Row[{CheckboxBar[Dynamic[cbba], {1, 2, 3}],
       "       ", InputField[Dynamic[cbba], FieldSize → 5]}]},
     {"TogglerBar", Row[{TogglerBar[Dynamic[tgba], Range[5]],
       "       ", InputField[Dynamic[tgba], FieldSize → 7]}]},
     {"InputField", Manipulate[input, {input, 3.14},
       ControlType → InputField, LabelStyle → 16]},
     {"ColorSlider", ColorSlider[Pink]}
    }, BaseStyle → {"TraditionalForm", FontFamily -> "Helvetica"},
    Alignment → {Left}, Background → LightYellow,
    Frame → All, Spacings → {2, 0.62}]]

  

    Quit[]

4.2 Creating Demonstrations

The main use of Manipulate is to create eye-catching interactive visualizations with just a few lines of code. In the Demonstrations site (http://demonstrations.wolfram.com) you can find thousands of them. Some of the demonstrations that we will be showing here are adaptations of existing ones available on the website.

4.2.1 A Random Walk

• We use the function RandomWalkProcess to represent a random walk on a line with the probability of a positive unit step p and the probability of a negative unit step 1-p. By default we assume n steps = 500 and set the interval from 100 to 1000 and p = 0.5. Each time we execute the command, even though the number of steps is the same, the distance covered will be different since we are assuming random walks.

  Manipulate[
    ListPlot[RandomFunction[RandomWalkProcess[p], {1, n}], Filling → Axis],
    {{n, 500, "Steps"}, 100, 1000, 1, Appearance → "Labeled"},
    {{p, 0.5, "Probability"}, 0, 1, Appearance → "Labeled"}]

4.2.2 Zooming and the Rosetta Stone

In this example we show how we can zoom on an image and scroll through it. In this case the image is a picture of the Rosetta Stone but any other picture would do as well.

• We can import it directly with:

  Clear["Global`*"] (* Remove all the variables from memory *)
  
  rosettaimage =
     Import["http://upload.wikimedia.org/wikipedia/commons/thumb/c/ca/
        Rosetta_Stone_BW.jpeg/800px-Rosetta_Stone_BW.jpeg"];
  
  rosetta = Image[rosettaimage, ImageSize → 300]

  

• Now we can copy it, as shown below, or type rosetta instead.

  Manipulate[
    ImageResize[ImageCrop[ , {300, 300}/ zoom, - pts],
      {300, 300}, Resampling → ControlActive[ "Nearest", "Lanczos"]],
    {{pts, {0, 0}, "pts"}, {- 1, - 1}, {1, 1}},
    {{zoom, 1, "Zoom"}, 1, 10}]

  

• We can generate a similar effect using DynamicImage (New in Mathematica 11.0).

  DynamicImage[ , ZoomFactor → 2, ImageSize →{300, 300}]

4.2.3 Zooming and Google Maps

• In this example we access https://maps.google.com using URLFetch and we move through the chosen area by zooming on it. We use functions not yet covered in the chapter that can be found in the help system. InputField can be especially useful. It enables us to open a window for inputting the data interactively, in this case the city that we are interested in.

  Manipulate[ImportString[
    ExportString[URLFetch["http://maps.googleapis.com/maps/api/staticmap",
      "ContentData", "Parameters" → {"center" → c, "zoom" → ToString[z],
       "size" → "512x256", "maptype" → ToLowerCase["Map"], "sensor" → "false",
       "style" → "inverse_lightness:true", "format" → "png"}], "Byte",
      "DataFormat" → {"Bytes"}], "PNG", "DataFormat" → {"Byte"}],
    {{c, "Salamanca", "Location"}, "",
     InputField[#1, String, FieldSize → 35] &},
    {{z, 11, "Zoom"}, 1, 20, 1}, ContinuousAction → False]

  

• An easier way of doing it is with DynamicGeoGraphics (available since Mathematica 11.0).

  DynamicGeoGraphics[ , GeoRange → Quantity[10, "km"]]

4.2.4 Derivatives in Action

Clear["Global`*"]

• Here is a derivative evaluation using the definition:

  Panel[DynamicModule[{f = Sin[x]}, lhs = DifferenceQuotient[f, {x, h}];
     Column[{InputField[Dynamic[f]], Dynamic[Block[{e = Inactivate[
             Limit[lhs, h -> 0]]}, e ? Activate[e]]]}]] // TraditionalForm]

  

• In this example we use derivatives to show the tangent at the selected point for different curves. This type of visualization is useful to represent the tangent to a curve and introduce the concept of the derivative.

  Manipulate[Plot[{f[x], f[x1] + f'[x1] * (x - x1)}, {x, -2 Pi, 2 Pi},
     PlotRange -> {-2, 2}, Epilog -> {PointSize[0.025], Point[{x1, f[x1]}]}],
    {x1, -2 Pi, 2 Pi}, { f, {Sin, Cos, Tan, Sec, Csc, Cot}}]

4.2.5 Tsunamis

We can model very complex natural phenomena. The following demonstration simulates a tsunami using the following system of partial differential equations:

∂2u(t,x)∂t2=∂2u(t,x)∂x2+a u(t,x)3+b u(t,x)2+c u(t,x)+d,with u(0,x)=e−x2,∂u(t,x)∂t=0 u(t,−x0)=u(t,x0)

(http://mathworld.wolfram.com/news/2005-01-14/tsunamis)

• We solve it with NDSolve using a, b, c, d, x₀ as parameters. We can show dynamically the behavior of the system by modifying the parameter values.

  Manipulate[
   Plot3D[Evaluate[u[t, x] /. Quiet[NDSolve[Evaluate[{D[u[t, x], t, t] ]
            D[u[t, x], x, x] + a u[t, x]^3 + b u[t, x]^2 + c u[t, x] + d,
          u[0, x] == e^-x^2, D[u[t, x], t] == 0 /. t → 0, u[t, -x0] == u[t, x0]}],
        u, {t, 0, x0}, {x, -x0, x0}, Method → {"MethodOfLines",
          "SpatialDiscretization" → {"TensorProductGrid",
            "DifferenceOrder" → "Pseudospectral", "MinStepSize" → 0.2}}]]],
    {x, -x0, x0}, {t, 0, x0}, MeshFunctions → {#3 &},
    Mesh → None,
    ColorFunction → "Rainbow",
    PlotPoints → 20,
    MaxRecursion → 1],
   {{a, -0.3}, -4, 0}, {{b, -0.6},
    -4, 0},
    {{c, 0.8}, -4, 1}, {{d, 0}, -1, 1},
    {{x0, 16, "Solution Range"}, 5, 20},
    ControlPlacement → Left,
    ContentSize → {400, 300}]

  

• A more realistic simulation is available at:

  http://demonstrations.wolfram.com/TsunamiStrikingALandscape

4.2.6 Bouncing Balls

• This function combines Manipulate with DynamicModule to show bouncing balls. Each time you click inside the area, a new ball will be generated.

  Manipulate[
   DynamicModule[{contents = {}, lastpt = {0, 1}}, Graphics[{PointSize[0.1],
     Point[Dynamic[If[pt =!= lastpt, AppendTo[contents, {pt, {0, 0}}];
        lastpt = pt];
       contents = Map[If[#[[1, 2]] ≥ 0, {#[[1]] - #[[2]], #[[2]] +
             {0, 0.001}}, {{#[[1, 1]], 0}, {1, -0.8} #[[2]]}] &, contents];
       Map[First, contents]]], Line[{{0, -.05}, {1, -.05}}]},
     PlotRange → {{0, 1}, {-.1, 1}}]], {{pt, {0, 1}}, {0, 0},
     {1, 1}, Locator, Appearance → None}, SynchronousUpdating → True]

  

• In this example we simulate the bounce of a ball falling down stairs. You can modify the impulse given to the ball, its rebound and the step size. Mathematica can solve the problem both analytically and numerically, by replacing DSolve with NDSolve (numeric solution).

  Manipulate[
    sol = DSolve[{y''[t] ? -9.8, y[0] == 13.5, y'[0] == 5, a[0] == 13,
       WhenEvent[y[t] - a[t] == 0, y'[t] → - c y'[t]],
       WhenEvent[Mod[t, n], a[t] → a[t] - 1]}, {y, a}, {t, 0, 8},
     DiscreteVariables → {a}];
    Plot[Evaluate[{y[t], a[t]} /. sol], {t, 0, 8}, Filling → {2 → 0}],
    {c, 0.6, 1},
    {n, 0.6, 1.75}]

  

4.2.7 Language Detection

• One of Mathematica’s latest features as mentioned earlier is Classify . Here we use it to identify the language of a sentence.

  Classify["Language", {"the house is blue",
     "la maison est bleu", "la casa es azul", "das Haus ist blau",
     

  {English, French, Spanish, German, Chinese, Arabic, Ukrainian}

  Manipulate [Classify ["Language", sentence],
   {{sentence, "la casa es azul", "Sentence"}, {"the house is blue",
     "la maison est bleu", "la casa es azul", "das Haus ist blau",
     

  

4.3 Image Processing

The image processing functionality of Mathematica has greatly improved in the latest versions of the program. We are going to give a brief overview of it. You can extend your knowledge by going through this tutorial: tutorial/ImageProcessing. At the end of this chapter there are several links in case you may be interested in learning more about the topic. In the first chapter we saw that when you click on an image, the Image Assistant, a toolbar providing several options to modify the image will appear right below it. As a matter of fact, many of the operations that we will show here can be executed directly using this toolbar. However, for clarity purposes we will show the Mathematica commands instead of describing how to use the toolbar. Besides, if we were interested in creating a program we would have to type the required instructions.

4.3.1 Playing with The Giralda

• We import a JPG image (in this example, The Giralda of Seville, although with a search engine you can find many images similar to the one below or even use other images as well). The resolution of the image was preserved when downloaded. You can also cut and paste from a website.

  Clear["Global` *" ] (* Remove all the variables from memory*)

• 

• We can check the image size in pixels. It consists of a n×m grid of triplets, each one representing one pixel.

  ImageDimensions[giralda]
  
  {635, 635}

• We can see the RGB value of the individual pixels:

  ImageData[giralda]
  

  

• We adjust the contrast and the brightness (if you prefer, instead of copying and pasting the image, just type giralda).

  

  {{a, -1.5, "Contrast"}, -2, 2}, {{b, 0.5, "Brightness"}, 0, 1}]

  

• The following command detects the edges of an image.

  edges = EdgeDetect[giralda]

  

• Here we compare both images.

  GraphicsRow[{giralda, edges}]

  

• ImagePartition splits an image into a collection of subimages of a certain size. (image downloaded from http://noticias-24.net/wp-content/uploads/2011/07/Machu-Picchu.jpg).

  

  Execute the function to see the output.

4.3.2 Background Removal and Image Composition

• In this example we remove the background of an image and create a new one by combining the result with an image of the Andromeda Galaxy.

  foreground = RemoveBackground[ , {"Background", Green}];
  ImageCompose[ , foreground]

  

• In the example below, available in the documentation, we eliminate small image components to extract a flock of flamingos.

  DeleteSmallComponents[
  RemoveBackground[, {"Background", {"Uniform", 0.08}}], 2]

4.3.3 3D Images

Since Mathematica 9 there are many more functions for 3D image processing as this example shows:

ctHead = ExampleData[{"TestImage3D", "CThead"}];

head = Image3D[ctHead, BoxRatios → {1, 1, 1}];

Manipulate[
  Image3D[head, ClipRange → {{x, 256}, {0, y}, {z, 100}}],
  {{x, 100}, 0, 256, 1}, {{y, 150}, 0, 256, 1}, {{z, 50}, 0, 100, 1}]

http://www.wolfram.com/mathematica/new-in-10/enhanced-3d-image-processing/index.html contains examples that may be useful for those readers interested in 3D image processing.

4.3.4 Eyesight Recovery

Next we show how to improve image resolution.

• Here’s an example of an image with fuzzy text (you can find the picture in the ImageDeconvolve help file):

  

• With a deconvolution we can substantially improve the image quality.

  ImageDeconvolve[ fuzzy, BoxMatrix[3] /49, Method → "TotalVariation"]

  

• Here is simulate a signal with noise.

  data = Table[Sin[i^2 + i] + RandomReal[{-.3, .3}], {i, 0, Pi, 0.001}];
  ListLinePlot[data]

  

• The next function uses a filter to remove the noise component of the signal.

  Manipulate[With[{res = LowpassFilter[data, ω]},
     GraphicsColumn[{Spectrogram[res], ListLinePlot[res]}]],
    {ω, Pi, .01, Appearance → "Labeled"}]

  

4.3.5 Edge Detection

Mathematica has several functions for detecting edges and borders that are very useful for image processing.

• In the next example we capture the image of the author while writing this book and apply the FindFaces command to detect his face.

  picture = CurrentImage[]

  

  faces = FindFaces[picture, {100, ∞}]
  
  {{{145.5, 36.5}, {258.5, 149.5}}}
  
  Show[picture,
    Graphics[{EdgeForm[{Red, Thick}], Opacity[0], Rectangle @@@ faces}]]

  

4.3.6 Barcode Recognition

• This example shows the use of BarcodeRecognize to identify barcodes.

  

  

  BarcodeRecognize[boardingPass, "Data", "PDF417"]
  
  M2VANALMSICK/MARKUS ECSEZLJ HNDDXBEK 0313 271Y018K0254
    136>20B1WW3271BEK 251762174509010 1 EK 116054035 CSEZLJ
    DXBDUSEK 0055 271Y019K0249 127251762174509011 1 EK 116054035

4.3.7 A Painting with a Surprise

The next example shows how to visualize an image from a certain perspective and how to select a part of it. The image was imported from a Wolfram blog post (http://blog.wolfram.com/2010/10/27/the-ambassadors).

ambassadors = Image[Import[
"http://blog.wolfram.com/data/uploads/2010/10/TheAmbassadorsBlogPost01
  .jpg"], ImageSize -> 150]

The image above corresponds to the painting “The Ambassadors” by Holbein. There’s a skull in it. Can you see it?

• With ImagePerspectiveTransformation we can apply a transformation to see the image from a different perspective and, combined with TransformationFunction, display the part of the image that we want to visualize.

  ImagePerspectiveTransformation[ambassadors,
  TransformationFunction[ (0.5−0.87−0.05−1.342.70.43−0.620.20.525)]]

  

4.3.8 Where Are the Matching Points?

Can you identify the location of the common points in these two images? (Images available in ImageCorrespondingPoints).

• The output displays the matching positions between the two images.

  matches = ImageCorrespondingPoints @@ imgs;
  MapThread[
    Show[#1, Graphics[{Yellow, MapIndexed[Inset[#2[[1]], #1] &, #2]}]] &,
    {imgs, matches}]

  

4.3.9 Image Identify

A new area of functionality available since Mathematica 10.1 is image identification: https://www.imageidentify.com/

• The function ImageIdentify is used to identify the image in a picture. If you have a camera connected to your computer, you can use the command below to identify the captured image in real time.

  {#, ImageIdentify[#]} &[ CurrentImage[]]

  

4.3.10 Metadata

As we have previously seen, data from image files usually carry additional information about the images themselves. In this case we download a file in the ARC Grid format, used in topography for representing terrain elevation.

• We import the following ARCGrid file.

  Import[ "http:// exampledata.wolfram.com/ ArcGRID.zip", "ARCGrid"]

  

• Notice that this is a compressed file. We can decompress it to find out what files are included.

  Import["http://exampledata.wolfram.com/ArcGRID.zip", "ZIP"]
  
  {NED_93751926\.DS_Store, NED_93751926\info\arc.dir,
   NED_93751926\info\arc0000.dat, NED_93751926\info\arc0000.nit,
   NED_93751926\info\arc0001.dat, NED_93751926\info\arc0001.nit,
   NED_93751926\meta1.html, NED_93751926\Metadata.xml,
   NED_93751926\ned_93751926\dblbnd.adf, NED_93751926\ned_93751926\hdr.adf,
   NED_93751926\ned_93751926\prj.adf, NED_93751926\ned_93751926\sta.adf,
   NED_93751926\ned_93751926\w001001.adf,
   NED_93751926\ned_93751926\w001001x.adf, NED_93751926\NED_93751926.aux}

• Next, we represent the terrain elevations in 3D (we use MaxPlotPoints→100 to speed up the computations).

  ListPlot3D[Import["http://exampledata.wolfram.com/ArcGRID.zip",
     {"ArcGRID", "Data"}], MaxPlotPoints → 100,
    ColorFunction → "SouthwestColors", Mesh → None]

  

• Let’s take a look at the metadata inside.

  Import["http://exampledata.wolfram.com/ArcGRID.zip",
   {"ArcGRID", "Elements"}]
  
  {Centering, CentralScaleFactor, CoordinateSystem,
   CoordinateSystemInformation, Data, DataFormat, Datum, ElevationRange,
   Graphics, GridOrigin, Image, InverseFlattening, LinearUnits, Projection,
   ProjectionName, RasterSize, ReferenceModel, ReliefImage, SemimajorAxis,
   SemiminorAxis, SpatialRange, SpatialResolution, StandardParallels}

• Now, we extract the information related to the coordinates system.

  Import[ "http://exampledata.wolfram.com/ArcGRID.zip",
   {"ArcGRID", "CoordinateSystemInformation"}]
  
  GEOGCS → {NAD83, DATUM → {North_American_Datum_1983,
       SPHEROID → {GRS 1980, 6 378 137, 298.257, AUTHORITY → {EPSG, 7019}},
       TOWGS84 → {0, 0, 0, 0, 0, 0, 0}, AUTHORITY → {EPSG, 6269}},
     PRIMEM → {Greenwich, 0, AUTHORITY → {EPSG, 8901}},
     UNIT → {degree, 0.0174533, AUTHORITY → {EPSG, 9108}},
     AXIS → {Lat, NORTH}, AXIS → {Long, EAST}, AUTHORITY → {EPSG, 4269}}

• The following command enables us to create a link to http://maps.google.com using the latitude and the longitude.

  CoordinatesToMapLink[{lat_, long_}] := Hyperlink[
    StringJoin["http://maps.google.com/maps?q=+",
     ToString@lat, "+", ToString@long, "&z=12&t=h"]
    ]

• We can now get the coordinates of the previous file and set up a link to Google Maps.

  coords = Import[ "http://exampledata.wolfram.com/ArcGRID.zip",
     {"ArcGRID", "SpatialRange"}]
  {{40.0617, 40.1447}, {-88.3158, -88.1619}}

• Since we are establishing the link with the center of the imported grid, we need to calculate the average of the latitude and longitude.

  CoordinatesToMapLink[Map[Mean, coords]]
  
  http://maps.google.com/maps?q=+40.1032+-88.2389&z=12&t=h

4.4 Graphs and Networks

Graphs and networks is another area where the latest Mathematica versions incorporate new functionality: guide/GraphsAndNetworks. A graph can be represented using Graph, a function with many options. Let’s see a basic example.

• We begin by defining the connections between vertices: i j or i j.

  graph1 = {"a1" "a2", "a2" "a3", "a2" "a1", "a3" "a4"};

• Next we define the capacity of each edge and vertex. Finally we add labels to identify the vertices.

  Graph[graph1, EdgeCapacity →{2, 3, 4, 5},
  VertexCapacity → {2, 3, 4, 6}, VertexLabels → "Name"]

  

• We can use special symbols as labels.

  

  

• We may have a graph representation in a certain format from which we would like to extract information. We can do it as follows:

  EdgeRules[g]
  
  {a1 → a2, a2 → a3, a2 → a1, a3 → a4}
  
  PropertyValue[g, EdgeCapacity]
  
  {2, 3, 4, 5}
  
  PropertyValue[g, VertexCapacity]
  
  {2, 3, 4, 6}
  
  PropertyValue[g, EdgeLabels]

  

• In the next example we find the shortest way to link all the locations in Figure 4.1 with fiber optic cable:

  

  Figure 4.1     Network graph of villages in Illinois.

• After creating the network graph with Mathematica (code not shown) and naming it “g”, we find the minimum spanning tree containing all the villages (Figure 4.2):

  fibernetwork = FindSpanningTree[g];
  
  HighlightGraph [g, fibernetwork, GraphHighlightStyle → "Thick"]

  

  Figure 4.2     Minimum Spanning Tree.

• In this example we generate random graphs and search for cliques (highlighted in red):

  Grid@Table[HighlightGraph[g = RandomGraph[{8, 16}],
     Subgraph[g, First[FindClique[g]]]], {2}, {4}]

  

• The command below returns the edges and vertices of a dodecahedron in graph format:

  {Graphics3D[{Opacity[.8], PolyhedronData["Dodecahedron", "Faces"]}],
   g = PolyhedronData["Dodecahedron", "SkeletonGraph"]}

  

• Here we are trying to find the shortest path passing once through each vertex (this is the famous Hamilton’s Icosian game):

  h = PathGraph@First[FindHamiltonianCycle[g]];
  
  {HighlightGraph[g, h, GraphHighlightStyle → "Thick"],
  Graphics3D[{Opacity[.8], PolyhedronData["Dodecahedron", "Faces"],
     Red, Tube[PolyhedronData["Dodecahedron", "VertexCoordinates"]
        Append[VertexList[h], VertexList[h], 0.1]}]}

  

4.5 Mazes

The function Thinning looks for the skeleton of an image through morphological analysis.

• In this example the image is a labyrinth. Thinning replaces the background with lines showing possible paths.

  

  

• Now we create the graph of the image:

  MorphologicalGraph[labyrinth]

  

4.6 Application: Finding the Period of a Pendulum

Clear["Global` *" ]

The example that follows is significantly more difficult than the previous ones (obtained from http://www.wolfram.com/services/education/seminars/s51.html).

Our objective is to find out the period of a pendulum by analyzing a sequence of video images. The images were obtained with CurrentImage (if your computer has a webcam you can use this function). CurrentImage adds a time stamp to the image, information that we will use later on in the example:

• We begin by highlighting the most prominent lines to identify the ones corresponding to the pendulum.

  edges = EdgeDetect /@ ims;

• In the images above, the pendulum lines are the ones close to the vertical. We can identify them using Radon.

  radons = ImageAdjust /@ (Radon[#, Automatic, {-Pi/4, Pi/4}] & /@ edges);

• Binarize detects the brightest points and extracts their x-coordinates to obtain the angle.

  xs = ComponentMeasurements[#, "Centroid"][[1, 2, 1]] & /@
     (Binarize[#, .9] & /@ radons)
  
  {89.5, 96., 111.5, 124., 125.5, 122.5, 112.5,
    100.5, 87.5, 89., 95.5, 106., 121.5, 127.5, 124.}

• In the next step we obtain the relationship between the positions and the time by converting the x-coordinates to radians and combining them with the images time stamps.

  thetas = ((xs/215) - .5) * Pi/4;
  
  times = Mod[Options[#, "MetaInformation"][[1, 2, 1]], 100] & /@ ims
  
  {36.0593128, 36.3133382, 36.6473716, 36.9003969, 37.1534222,
   37.5664635, 37.8204889, 38.1605229, 38.4995568, 38.9105979,
   39.1666235, 39.4196488, 39.8376906, 40.1757244, 40.4267495}
  datapoints = Transpose[{times, thetas}];
  ListPlot[datapoints]

  

• We fit the data to a sinusoid curve.

  nlm = NonlinearModelFit[datapoints,
    a Sin[b (t - c)] + d, {{a, .07}, {b, 3}, {c, 2}, {d, 0}}, t]

  

  Show[ListPlot[datapoints],
    Plot[Normal[nlm], {t, 36, 41}], PlotRange → All]

  

    nlm["BestFitParameters"]
  
    {a → 0.0746392, b → 2.16036, c → -10.0063, d → -0.00305312}

• We estimate the period, in seconds:

  period = 2 Pi/ (b /. %)
  
  2.90839

• Here is the video sequence using the calculated period:

  ListAnimate[ims, DefaultDuration -> 2.9]

  

• Next, we find the formula to calculate the length of the pendulum:

  

  {{T==2π1g,f==1T,vmax==2(1−Cos[θ0])g l},{T==4 Elliptick[Sin[θ02]2]1g,f==1T,vmax==2(1−Cos[θ0])g l}}

  pendulumeq = FormulaData[{"PendulumSmallOscillations", "Standard"}][[1]]

  T=2π1g

  pendulumeq // InputForm
  
  QuantityVariable["T", "Period"] ==
   2*Pi*Sqrt[QuantityVariable["l",
       "Length"]/QuantityVariable["g",
       "GravitationalAcceleration"]]

• Finally, we apply the formula to compute the length, in meters, of our pendulum:

  WolframAlpha["Gravitational Acceleration value",
   {{"Value", 3}, "QuantityData"}]
  
  9.807 m/s²
  
  Solve[pendulumeq /. {QuantityVariable["T", "Period"] → period,
     QuantityVariable["l", "Length"] → l,
     QuantityVariable["g", "GravitationalAcceleration"] → 9.807}, l]
  
  {{l → 2.10127}}

With ImageDisplacements, you can use an optical flow to interpolate between existing frames (https://www.wolfram.com/language/11/image-and-signal-processing/slow-motion-using-optical-flow.html). In the following example we generate a video sequence twice as long as the original.

• The interpolated images are constructed by warping the original frames according to the optical flow.

  flows = Map[vecField ↦ Transpose@Reverse[vecField],
     ImageDisplacements[ims, MaxIterations -> 1] /2];
  bg = First@DominantColors[First@ims, 1]

  

• Next, we construct the interpolated frames and insert them into the final sequence:

  vecTrafo[xy_, motion_] := xy + Extract[motion, Ceiling[xy]];
   
  oflow =
    Table[ ImageForwardTransformation[ims[[i]], vecTrafo[#, flows[[i]]] &,
      DataRange -> Full, Background -> bg], {i, Length@ims - 1}];
   
  slowmo = Riffle[ims, oflow];

• Finally, we animate the result with a simple blending-based reference using a period twice as long as the original:

  compresults = MapThread[ ImageAssemble[{{Show[#2, Graphics@
            Text[Style["blended frames", Larger, Red], {60, 180}]]}}] &,
     {slowmo, Riffle[ims, Blend /@ Partition[ims, 2, 1]]}];
   
  ListAnimate[compresults, DefaultDuration -> 2*2.9]

  

4.7 Advanced Calculus

Clear["Global`*"]

So far in this chapter we have seen some of the new functionality included in the latest versions of Mathematica. In this section we continue with our exploration of some of the latest features and their applications for solving advanced calculus problems. It’s important to remember that some of the options that we use are common to other functions.

• We use CoordinateTransform to represent a curve with origin at the center that moves toward the surface of a sphere of radius 1 and calculate its length with ArcLength.

  cSpherical[t_] := {t, (1 + 2 Sin[2 t + 1]), 1 + 2 t^2}
   
  cCartesian[t_] =
    CoordinateTransform["Spherical" → "Cartesian", cSpherical[t]];
   
  Show[Graphics3D[{Opacity[.25], Sphere[]}],
   ParametricPlot3D[cCartesian[t], {t, 0, 1}, PlotStyle → Thick,
    ColorFunction → (Hue[.8 #4] &)], ImageSize → Small]

  

  ArcLength[cCartesian[t], {t, 0., 1}]
   
  2.17417

• In the example below, we compute the period of a function and plot it.

  p = FunctionPeriod[Cos[2 x] + Sin[3 x], x]
   
  2 π
   
  Plot[Cos[2 x] + Sin[3 x], {x, 0, 2 p }, Mesh → 1,
   MeshShading → {Green, Blue}, Ticks → {Range[0, 2 p, p/2], {-1, 1}}]

  

• Here, we define three spheres and calculate the intersection point from their graphical representation.

  {s1, s2, s3} =
    Table[Sphere[{1/3 Cos[k 2 π /3], 1/3 Sin[k 2 π /3], 0}], {k, 0, 2}];

  {{p→{0,0,−223}},{p→{0,0,223}}}

  Graphics3D[
   {{Opacity[0.5], s1, s2, s3}, {Red, PointSize[Large], Point[p /. sol]}}]

  

• The following command plots two concentric spheres:

  = ImplicitRegion[4 ≤ x² + y² + z² ≤ 9, {x, y, z}];
   
  RegionPlot3D[, ColorFunction → "BlueGreenYellow", PlotStyle → Opacity[0.5]]

  

  Integrate[1, x ∊ ]

  76π3

• In this example we download the 3D figure “StanfordBunny”, discretize it using DiscretizeGraphics, calculate its centroid with RegionCentroid and finally visualize it.

  bunny =
   Show[ExampleData[{"Geometry3D", "StanfordBunny"}], ImageSize → Small]

  

  
  = HighlightMesh[DiscretizeGraphics[bunny],
      {Style[1, None], Style[2, Opacity[0.5]]}];
   
  c = RegionCentroid[]
   
  {-0.0267934, -0.00829883, 0.0941362}
   
  Show[Graphics3D[Prepend[First[bunny], Opacity[0.5]]],
    Graphics3D[{Red, Point@c}], ImageSize → Small]

  

• We can also calculate the centroid using the definition (notice how Integrate is able to integrate over a region defined by the figure of the bunny):

  m = RegionMeasure[]; Integrate[p, p ∊ ] /m
   
  {-0.0267934, -0.00829883, 0.0941362}

• The command below defines a region based on the union of two disks of radius 2 centered at {0, 0} and {1, 0}.

  = RegionUnion[Disk[{0, 0}, 2], Disk[{1, 0}, 2]];

• Now, we represent the difference between the region previously defined and a disk of radius 1 centered at {1/2, 0}.

  = RegionDifference[, Disk[{1/2, 0}, 1]];

• To visualize we discretize the region with MeshRegion .

  DiscretizeRegion[]

  

• Finally, we solve the partial differential equation over .

  sol = NDSolveValue [{▽{x,y}2u[x, y]== 0,
        DirichletCondition[u[x, y] . Sin[x y], True]}, u, {x, y} ∊ ];
  Plot3D[sol[x, y], {x, y} ∊ ] // Quiet

  

4.8 Additional Resources

To access the following resources, if they refer to the help files, write them down in a notebook, select them and press <F1>. In the case of external links, copy them in a browser.

About demonstrations

Manipulate: tutorial/IntroductionToManipulate

Advanced Manipulate functionality tutorial: tutorial/AdvancedManipulateFunctionality

Introduction to Dynamic tutorial: tutorial/IntroductionToDynamic

The Wolfram Demonstrations Project: http://demonstrations.wolfram.com

About images

Image processing tutorial: tutorial/ImageProcessing

Image Processing & Analysis guide page: guide/ImageProcessing;

Image and Signal Processing: http://www.wolfram.com/language/11/image-and-signal-processing/

Computational Photography: http://www.wolfram.com/language/11/computational-photography/

A collection of video presentations and seminars available in: http://www.wolfram.com/training/courses/image-processing/

An interesting demonstration about image processing: The Incredible Convenience of Mathematica Image Processing (http://blog.wolfram.com/2008/12/01/the-incredible-convenience-of-mathematica-image-processing)

The Wolfram Language Image identification Project: https://www.imageidentify.com/

About Advanced Calculus

Symbolic & Numeric Calculus: http://www.wolfram.com/language/11/symbolic-and-numeric-calculus/

Differential Eigensystems: http://www.wolfram.com/language/11/differential-eigensystems/ Algebra and Number Theory: http://www.wolfram.com/language/11/algebra-and-number-theory/

Partial Differential Equations: http://www.wolfram.com/language/11/partial-differential-equations/