Class 5 : Programming in Mathematica Part #3

Applying Functions Repeatedly

?Fold

?FoldList

?Nest

?NestList

Nest[f, x, 4]

NestList[f, x, 4]

recip[x_] := 1/(1 + x)

Nest[recip, x, 3]

newton3[x_] := N[1/2 (x + 3/x)]

NestList[newton3, 1.0, 5]

FixedPoint[newton3, 1.0]

FixedPointList[newton3, 1.0]

divide2[n_] := n/2

NestWhileList[divide2, 123456, EvenQ]

NestWhileList[newton3, 1.0, Unequal, 2]

NestWhileList[Mod[5 #, 7] &, 1, Unequal, All]

FoldList[f, x, {a, b, c}]

Fold[f, x, {a, b, c}]

FoldList[Plus, 0, {a, b, c}]

Testing and Searching List Elements

Position[{a, b, c, a, b}, a]

Count[{a, b, c, a, b}, a]

MemberQ[{a, b, c}, a]

MemberQ[{a, b, c}, d]

m = IdentityMatrix[3]

FreeQ[m, 0]

Position[m, 0]

Building Lists from Functions

Array[p, 5]

Table[p[i], {i, 5}]

Map[p, Range[5]]

p[x_]:=(p^2)
Array[p,5]
Table[p[i],{i,5}]
Map[p,Range[5]]

Array[# + #^2 &, 5]

Array[m, {2, 3}]

Array[Plus[##]^2 &, {3, 3}]

NestList[D[#, x] &, x^n, 3]

Selecting Parts of Expressions with Functions

Select[{2, 15, 1, a, 16, 17}, # > 4 &]

t = Expand[(x + y + z)^2]

Select[t, FreeQ[#, x] &]

Select[{-1, 3, 10, 12, 14}, # > 3 &, 1]

Everything Is an Expression

x + y + z

FullForm[%]

1 + x^2 + (y + z)^2

FullForm[%]

Head[f[x, y]]

?Head

Head[a + b + c]

Head[{a, b, c}]

Head[23432]

Head[345.6]

Part[{a, b, c}, 0]

Part[{a, b, c}, 1]

Part[{a, b, c}, 3]

Part[{a, b, c}, 4]

Part[23242, 0]

Part[23242, 1]

Immediate and Delayed Definitions

ex[x_] := Expand[(1 + x)^2]

?ex

iex[x_] = Expand[(1 + x)^2]

?iex

ex[y + 2]

iex[y + 2]

r1 = Random[]

r2 := Random[]

{r1, r2}

{r1, r2}

Applying Transformation Rules

x + y /. x -> 3

x + y /. {x -> a, y -> b}

x + y /. {{x -> 1, y -> 2}, {x -> 4, y -> 2}}

Solve[x^3 - 5 x^2 + 2 x + 8 == 0, x]

x^2 + 6 /. %

{x^2, x^3, x^4} /. {x^3 -> u, x^n_ -> p[n]}

h[x + h[y]] /. h[u_] -> u^2

h[x + h[y]] //. h[u_] -> u^2

{x^2, y^3} /. {x -> y, y -> x}

x^2 /. {x -> (1 + y), y -> b}

x^2 /. x -> (1 + y) /. y -> b

x^2 + y^6 /. {x -> 2 + a, a -> 3}

x^2 + y^6 //. {x -> 2 + a, a -> 3}

log[a b c d] /. log[x_ y_] -> log[x] + log[y]

log[a b c d] //. log[x_ y_] -> log[x] + log[y]

Functions as Procedures

exprod[n_] := Expand[Product[x + i, {i, 1, n}]]

exprod[5]

cex[n_, i_] := (t = exprod[n]; Coefficient[t, x^i])

cex[5, 3]

t

ncex[n_, i_] := Module[{u}, u = exprod[n]; Coefficient[u, x^i]]

ncex[5, 3]

u

Special Forms of Assignment

t = 7 x

t += 18 x

t

t = 8; t *= 7; t

i = 5; Print[i++]; Print[i]

i = 5; Print[++i]; Print[i]

{x, y} = {5, 8}

{x, y} = {y, x}

x

y

{a, b, c} = {1, 2, 3}; {b, a, c} = {a, c, b}; {a, b, c}

v = {5, 7, 9}

Append[v, 11]

v

AppendTo[v, 11]  (*This is like doing v=Append[v,11] *)

v

Conditionals

If[7 > 8, x, y]

If[7 > 8, Print[x], Print[y]]

When you write programs in Mathematica, you will often have a choice between making a single definition whose right-hand side involves several branches controlled by If functions, or making several definitions, each controlled by an appropriate /; condition. By using several definitions, you can often produce programs that are both clearer, and easier to modify.

?/;

f[x_] := If[x > 0, 1, -1]

g[x_] := 1 /; x > 0

g[x_] := -1 /; x <= 0

?g

?Switch

?Which

h[x_] := Which[x < 0, x^2, x > 5, x^3, True, 0]

h[-5]

h[2]

r[x_] := Switch[Mod[x, 3], 0, a, 1, b, 2, c]

r[7]

Switch[17, 0, a, 1, b, _, q]

An important point about symbolic systems such as Mathematica is that the conditions you give may yield neither True nor False. Thus, for example, the condition x==y does not yield True or False unless x and y have specific values, such as numerical ones.

If[x == y, a, b]

If[x == y, a, b, c]

TrueQ[x == y]

x === y

If[x === y, a, b]

If[TrueQ[x == y], a, b]

The main difference between lhs===rhs and lhs==rhs is that === always returns True or False, whereas == can leave its input in symbolic form, representing a symbolic equation, as discussed in "Equations". You should typically use === when you want to test the structure of an expression, and == if you want to test mathematical equality. The Mathematica pattern matcher effectively uses === to determine when one literal expression matches another.

Head[a + b + c] === Times

Head[a + b + c] == Times

t[x_] := (x != 0 && 1/x < 3)

t[2]

t[0]

The way that Mathematica evaluates logical expressions allows you to combine sequences of tests where later tests may make sense only if the earlier ones are satisfied. The behavior, which is analogous to that found in languages such as C, is convenient in constructing many kinds of Mathematica programs.

Loops and Control Structures

?Do

?For

?While

Do[Print[i^2], {i, 4}]

t = x; Do[t = 1/(1 + k t), {k, 2, 12, 2}]; t

n = 17; While[(n = Floor[n/2]) != 0, Print[n]]

For[i = 1, i < 7, i++, Print[i]]

For[i = 1; t = x, i^2 < 10, i++, t = t^2 + i; Print[t]]

While[False, Print[x]]

t = 1; Do[t *= k; Print[t]; If[t > 19, Break[]], {k, 10}]

t = 1; Do[t *= k; Print[t]; If[k < 3, Continue[]]; t += 2, {k, 10}]

f[x_] := (If[x > 5, Return[big]]; t = x^3; Return[t - 7])

f[10]

The Structure of Graphics

?Graphics

Graphics[{Thick, Green, Rectangle[{0, -1}, {2, 1}], Red, Disk[], Blue, Circle[{2, 0}], Yellow, Polygon[{{2, 0}, {4, 1}, {4, -1}}], Purple, Arrowheads[Large], Arrow[{{4, 3/2}, {0, 3/2}, {0, 0}}], Black, Dashed, Line[{{-1, 0}, {4, 0}}]}]

Show[%, Frame -> True]

?Graphics3D

Graphics3D[{Blue, Cylinder[], Red, Sphere[{0, 0, 2}], Black, Thick, Dashed, Line[{{-2, 0, 2}, {2, 0, 2}, {0, 0, 4}, {-2, 0, 2}}], Yellow, Polygon[{{-3, -3, -2}, {-3, 3, -2}, {3, 3, -2}, {3, -3, -2}}], Green, Opacity[.3], Cuboid[{-2, -2, -2}, {2, 2, -1}]}]

ListPlot[Table[Prime[n], {n, 20}]]

InputForm[%]

Graphics[Circle[]];
2 + 2

Print[Graphics[Circle[]]];
2 + 2

g1 = Plot[Sin[x], {x, 0, 2 Pi}];
Show[g1, Background -> Pink]

?Show

Show[{g1, Graphics[Circle[]]}]

Show[{g1, Graphics[Circle[]]}, PlotRange -> All, AspectRatio -> Automatic]

?Polygon

poly = Polygon[Table[N[{Cos[n Pi/5], Sin[n Pi/5]}], {n, 0, 5}]];
Graphics[poly]

InputForm[%]

Graphics[Polygon[Table[{Random[], Random[]}, {20}]]]

Graphics[{RGBColor[0.3, 0.5, 1], EdgeForm[Thickness[0.01]], poly}]

Show[%, Frame -> True]

Two - Dimensional Graphics Elements

?Point

?Line

?Rectangle

?Polygon

?Circle

?Disk

?Text

?Raster

Graphics[Raster[{{{0, 1, 1}, {1, 0, 1}, {1, 1, 0}}, {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}}]]

rgb = Reverse[ExampleData[{"TestImage", "Lena"}, "Data"]/255.];

Graphics[Raster[rgb]]

gray = Map[{.3, .59, .11}.# &, rgb, {2}];

ker = {{1, 0, -1}, {1, 0, -1}, {1, 0, -1}};

f = ListCorrelate[ker, gray];

Graphics[Raster[f, Automatic, {Min[f], Max[f]}/4, ColorFunction -> "TemperatureMap"]]

sawline = Line[Table[{n, (-1)^n}, {n, 6}]]

sawgraph = Graphics[sawline]

Plot[Sin[Pi x], {x, 0, 6}]

Show[%, sawgraph]

{Blue, Rectangle[{1, -1}, {2, -0.6}], Rectangle[{4, .3}, {5, .8}]}

Graphics[{sawline, %}]

pentagon = Table[{Sin[2 Pi n/5], Cos[2 Pi n/5]}, {n, 5}]

Graphics[Polygon[pentagon]]

Manipulate[Graphics[Polygon[Table[{Sin[2 Pi n/NN], Cos[2 Pi n/NN]}, {n, NN}]]], {NN, 3, 20, 1}]

?PlotRange

({{▪, {{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}}}})

Manipulate[Graphics[Polygon[Table[{Sin[2 Pi n/NN], Cos[2 Pi n/NN]}, {n, NN}]], PlotRange -> {{-1.1, 1.1}, {-1.1, 1.1}}, Axes -> True], {NN, 3, 20, 1}]

Graphics[Polygon[{pentagon, 1 + .5 pentagon, 1.5 + .2 pentagon}]]

?Translate

?Rotate

The Representation of Sound

Play[(2+Cos[20 t]) * Sin[3000 t + 2 Sin[50 t] ],{t,0,2}]

There is so much more to learn but now lets move on to demonstrations ...