Appendix C.

Solutions to Exercises
This appendix provides solutions to selected exercises in Chapters 2 and 3.

Section 2.1.20
1. (10 Sqrt[(10.8 × 10^3)/300] + 4)^(1/3)

3. ScientificForm[((2.54^(3/5)Sqrt[1.15 × 10^ –2])+ (5.11^(2/5)))/ Sqrt[2.32 × 10^ –5],

5. ScientificForm [ (((3 × 10^2)^3) ((2 × 10^ –5)^ (1/3)))/Sqrt[3.63 × 10^ –8], 3]

7. ScientificForm[N[Sqrt[(–2 –5)^2 + (5 + 3)^2]],3]

9. ScientificForm[400 Cos[35 Degree]// N, 3]

11. θ = N [ArcCos[2/3]/Degree]
Tan [θ Degree]^2

13. N [EulerGamma, 25]

15. A = {{1, 0, –1}, {2, 4, 7}, {5, 3, 0}}

B = {{6, 1}, {0, 4}, {–2, 3}}
A.B // MatrixForm
Clear [A, B]

17. mymatrix = {{–2, 1, 3}, {0, –1, 1}, {1, 2, 0}}

Inverse [mymatrix] // MatrixForm
Clear [mymatrix]

19. data = {{0.608, 0.05}, {0.430, 0.10}, {0.304, 0.20},

{0.248, 0.30}, {0.215, 0.40}, {0.192, 0.50}}
Fit [data, {1, 1/V, 1/(V^2)}, V]
Clear [data]

21. ourdata = {{0.5, 4.2}, {1.0, 16.1}, {1.5, 35.9}, {2.0, 64.2}}
Fix [ourdata, {t^2}, t]
2 × 16.0328ft/s^2
CleaR [ourdata]

23. data = {{0.1, 1.1}, {0.3, 3.2}, {0.5, 4.9}, {0.7, 6.8}, {0.9, 9.1}}
Fit [data, {x}, x]
 9.98182 1b/in

25. N [(3Pi, 7 I) Cos [37 Degree] + (2 + 8 I) Exp[–3 I + 2]]

27. Randomnteger[{1, 100}, 20]

Max [%]

29. 1. RandomInteger[{0,1}, 10]

Count [%, 0]
N [%/10]
2. RandomInteger[{0, 1}, 100]
Count[%, 0]
N[%/100]
3. N [Count [RandomInteger [{0, 1}, 10 000], 0]/10 000]
4. The fractional outcome approaches the probability as N becomes large.

31. NSolve [4 β^7 – 16 β^4 + 17 β^3 + 6β^2 –21 β + 10 == 0, β]

33. NItegrate [ (x^3) / (Exp[x] –1), {x, 0, 1}]

35. NItegrate [(x^2) /Sqrt[(x^7) + 1], {x, 2, ∞}]

37. NItegrate [Log [x] /Sqrt[1 – x ^2], {x, 0, 1}] // Chop

Note that the integrand approaches 0 as x approaches 1.

39. NItegrate [1/((x – 1) ^2), {x, 0, 1}]

41. (a^3) NItegrate [Sqrt [x^2 + y^2], {x, –1, 0}, {y, –Sqrt [1 –x^2], 0}]

43. (4 k a^6) NItegrate [(x^2 + z^2) ^ (3/2), {y, 0, 4},

{x, 0, Sqrt[1 + y^2]}, {z, 0, Sqrt[1 + y^2 – x^2]}} //Chop

45. NDSolve [{y '' [x] + (Sin [x]^2y' [x] + 3y[x]^2 == Exp [–x^2],
y[0] == 1, y' [0] == 0}, y, {x, 0, 3}
Table [y [x] /. %[[1]], {x, 3}]
Plot [Evaluate [y[x] /. %%], {x, 0, 3}, AxesLabel → {"x", "y"}]

47. sol = NDSolve [

{y '' [t] == Sim[t]y[t] + t, y[0] == 0, y' [0] == 1}, y, {t, 0, 6.4}]
Plot [Evaluate[y[t] /. sol], {t, 0, 6.4}, AxesLabel → {"t", "y"}]
Clear[sol]

49. (1 /π) NItegrate [

r/Sqrt[((2.5 – rCos[θ])^2) + ((1.2 – rSin[θ])^2) + 3.7^2],
 {r, 0, 1}, {θ, 0, 2π}]
in Units of q/(tπε0a), where ε0 is the permittivity constant.

Section 2.2.20
1. Apart [ (x^2 + 2x –1) / (2x^3 + 3x^2 –2x)]

3. Factor [x^4 + 2x^3 – 3x – 6]

5. Factor [ax^2 + ay + bx^2 + by]

7. Together [1/ ((x^2) – 16)) – ((x + 4) / ((x^2) –3x –4))]

9. Together [((1/x^2) – (1/y^2))/(1/x) + (1/y))]

11. Together [(3/ ((x^3) –x)) + (4/ ((x^2) + 4x + 4))]//ExpandDenominator

13. Apart [(x^4 – 2x^2 + 4x + 1) / (x^3 – x^2 – x + 1)]

15. PowerExpand [(54 (x^3) (y^6)z) (^1/3)]

17. PowerExpand [Log [Sqrt [x] /x] + Log [(Ex^2) ^ (1/4)]]

19. Simplify [(Sec [α] – 2 Sin [α]) (Csc[α] + 2 Cos [α]) Sin [α] Cos[α]]

21. TrigExpand [Sin [7 θ]]

23. TrigFactor [(Sin [x] ^3) Sin [3x] + cos[x]^3) Cos [3x]] // Simplify

25. TrigFactor [–Sin [α – β – γ] + Sin[α + β – γ] + Sin[α – β + γ] – Sin [α + β + γ]]

27. FullSimplify [Sec [x] Tan [x] (sec[x] + Tan[x] + (Sec[x] – Tan[x])]

29. Simplify [ (Sec[x] – Csc[x]) / (tan[x] + Cot [x]) == (Tan [x] – Cot [x]) / (Sec [x]

31. FunctionExpand [Gamma [x] Gamma [–z]]

33. FunctionExpand [D [HermiteH [n ,x], x]]

35. FullSimplify [D[Gamma [z + 1], z] == Gamma [z +z D Gamma [z], z]

37. FunctionExpand [Gamma[z] Gamma [z + 1/2]]

39. Simplify [Sin[nπ – θ], ((n – 1/2) /2) ∊ Integrs] Table [2 k + 1/2, {k, –10, 10}]

41. Simplify [ArcSin [Sin [u]], –π/2 ≤ u ≤ π/2]

43. Coefficient [((4a +x) ^2) ((7 + bx^2) ^4), x, 0]

45. Numerator [ (x^2 + 3x + 2) / (x^2 – 1)]

47. Needs ["Units'"]

Needs ["PhysicalConstants'"]
h = PlanckConstant
me = ElectronMass
mp = ProtonMass
1. ∊k = 10 ElectronVot
2. Convert [h/Sqrt[2 me ∊k], Meter] // PowerExpand
3. ∊k = 10 Mega ElectronVolt
4. Convert [h/Sqrt [2mp ∊k], Meter] // PowerExpand
5. Clear [h, me, mp, ∊k]

49. Solve [{4x + 5y == 5, 6x + 7 y == 7}, {x, y}]

51. Solve [sqrt [x + 2] + 4 == x, x]

53. Solve [sqrt [2x – 3] – Sqrt [x + 7] == 2, x]

55.

57. D[Sin [Exp [x^2]], x]

59. D[xArcSinh [x/3] – Sqrt [9 + x^2], x]// Simplify

61. D[Sin[xy]/Cos[x + y], x]

63. Dt [x^2 + 3x y – y^2] // Simplify

% /. {x → 2, y → 3, Dt[x] → 0.05, Dt[y] → –0.04}

65. P = n R T/V
Dt [P, t, Constants → {n, R}]
% /. {Dt [T, t, Constants → {n, R}] → α,
Dt [V, t, Constants → {n, R}] → β} // Simplify
Clear [P]

67. Integrate [5 Log[t] – Exp [–3 t], t]

69. Integrate [4/ (1 + x^2), {x, 0, 1}]

71. Integrate [(2x^2 – x + 4) / (x^3 + 4x), x]

D [%, x]
% // Simplify

73. Integrate [ (x^2) Exp [–2 a x^2], {x, –∞, ∞}, Assumptions → a > 0]

75. Integrate [(Sin [x]^p)x, {x, 0, π}, Assumptionms → {p> –1}]

77. 1. sol = Solve [Integrate [(A/ (b^2 + x^2))^2,

2. {x, –∞, ∞}, Assumptions → b > 0] == 1, A] [[2]]
3. Integrate [ (x (A / (b^2 + x^2))^2/. sol),
4. {x, –∞, ∞}, Assumptions → b > 0]
We do not need Mathematica to determine this. Because the integrand is odd, the in
vanish.
5. Integrate[((x^2) (A/ (b^2 + x^2))^2/. sol),
6. {x, –∞, ∞}, Assumptions → b > 0]
7. Clear [sol]

79. Sum [ (Cos[x]^n) / (2^n), {n, 0, ∞}]

81. Sum [i^3, {i, n}]

83. Series [Sec[x], {x, π/3, 3}]

85. Limit [
Log[10, x – a] / ((a – b) (a – c)) + Log[10, 2 (x – b)] / ((b – c) (b –
Log [10, x – c] / ((c – a) (c – b)), x → ∞] // FullSimplify
87. Limit [1/ (Exp[x] – Exp[x – x^ (–2)]), x → ∞]

89. Limit [(1 + Sim [4x])^Cot[x], x → 0, Directon → – 1]

91. Limit [(Sqrt [(t^2) + 9] – 3) / (t^2), t → 0]

93. DSolve [y '' [x] –2y' [x] == Sin [4x], y[x], x]

95. 1. sol = DSolve [φ '' [x] + (k^2) φ [x] == 0, φ [x], x]

2. ((φ[x] /. sol [[1]]) /. x → 0) == 0
3. Simplify [(Sin[ka] . k → (nπ/a)) == 0, n ∊ Integres]
4. Reduce [{Sin [ka] == 0, a ≠ 0}, k, GeneratedParameters → n]
5. Solve [Integrate [(C2 Sin [nπx/a]) ^2, {x, 0, a},
6. Assumptions → {n ∊ Integers, n > 0}] == 1, C2] [[2,1]]
7. En == ((ћ^2) (k^2) / (2m)) /. k → (nπ/a)
8. φn == C2 Sin [kx] /. {k → (nπa), C2 → Sqrt [2/a]}
9. Integrate [ (2/a) Sin [nπx/a]Sin [mπx/a], {x, 0, a},
10. Assumptions → {m ∊ Integres, n ∊ Integres, m ≠n}]
11. Clear[sol]

97. 1. E[n_] : = (ћ ω (n + 1/2))

Where E is the capital Greek letter epsilon.
Table [E[n], {n, 0, 3}]
2. φ[n_, x_] : = ((2^ (– n/2)) (n!^ (–1/2)) (((mω)/ (ћπ)) ^ (1/4)
3. HermiteH [n, Sqqqrt [mω/ћ]x]Exp[– ((mω) / (2ћ)) x^2])
4. Table [φ [n, x], {n, 0, 3}]
5. Clear [E, φ]

99. FourierTransform [Piecewise [{{–A, –b, < x < 0}, {A, 0 < x < b}}],
x, –k, Assumptions → b > 0] //FullSimplify

101. InverseFourierTransform[1/(I(k^3)), k, –x]

FourierTransform[%, x, –k]
Simplify [% == 1/ (1 + I (k^3))]

103. RSolve[{A[n] == A[n – 1] + rA[n – 1], A[0] == P}, A[n], n]

A[n] /. %[[1, 1] /. {P → 1000, r → .08, n → 30}

105. Apply Simplify [▄] three times:

Section 2.3.5
1. Plot [x/ (x^2 + 1), {x, –10, 10}]

3. sol =
NDSolve [{y'' [t] == – (t^3) y [t] + 1, y[0] == 1, y' [0] == 0}. {t, 0
Plot [Evaluate [y[t] /. sol], {t, 0, 8}, AxesLabel → {"t", "y"}]
Clear [sol]

5. n = 5;
sol = NDSolve[{ψ '' [ξ] + (– ξ2 + 2n + 1) ψ [ξ] == 0,
ψ[0] == 0, ψ' [0] == 1}, ψ, {ξ –5, 5]
{ψ[–5], ψ[5]}/. sol [[1]]
Plot [Evaluate [ψ[ξ]/. sol], {ξ, –5, 5}, AxesLabel - > {"ξ", "ψ"}]
Clear [n, sol]

7. sol = NDSolve [{x '' [t] – (12/ (x[t]^13)) + (6/ (x[t]^7)) == 0,

x[0] == 1.02, x ' [0 == 0}, x, {t, 0, 10}]
Plot [Evaluate[{x[t], x ' [t]}/. sol], {t, 0, 10},
PlotStyle → { {}, {Dashing [{0.01, 0.02}]}},
PlotLabel - > "x(t) and x' (t)"]
Clear [sol]

9. Plot [x^2 + Cos [32x], {x, –5, 5} AxesLabel → {"x", "f"}]

The plot cannot be right since the function is an even function.
Plot[x^2 + Cos [32x], {x, –5, 5},
AxesLabel → {"x", "f"}, PlotPoints → 120]
This is more like it.

11. 1. z = 1 + Exp [–€/ (kT)]

The average energy E is
 E = k (T^2) D [Log [Z], T] // Simplify
where we have assigned the average energy to the capital Greek letter epsilon E. (Th
keyborad E has built-in meaning in Mathematica; it is the exponential constant e.) Le
ε = E/€
t = kT/€
Thus,

Plot [1/ (1 + Exp[1/t]), {t, 0, 4}, AxesLabel → {"T (€/k)", "E (€)"}]
2. The heat capacity C is
D[E, T]
Let
c = C/k
t = kT/€
Thus,

Plot [(Exp[1/t])/(((1 + Exp[1/t])^2) (t^2)),

{t, 0, 4}, AxesLabel → {"T (€/k)", "C (k)"}]
3. The entropy S is

k Log[Z] + E/T
Let
s = S/k
t = kT/€
Thus,

Plot[(1/ ((1 + Exp[1/t]) t)) + Log [1 + Exp[–1/t]], {t, 0, 4},

PlotRange - > All, AxesLabel → {"T (€/k)", "S (k)"}]
Clear [Z, E]

13. Series [Sin [x]Cos[x], {x, 0, 7}]// Normal

Plot [{%, Sin[x]Cos[x]}, {x, –2, 2}]
The series is a good approximation of f(x) for |x| ≲ 1.3.

15. S[n_, x_] : = Sum [(((–1)^k)/((k!)^2)) ((x/2) ^ (2k)), {k, 0, n}]

Plot [Evaluate [{BesselJ[0, x], S[1, x], S[2, x], S[3, x], S[4, x]}],
{x, –5, 5}, PlotRange → {–0.75, 1.25},
PlotStyle → {{Black, Thickness [0.0125], Dashing [Medium]},
{Green, Thick}, {Magenta, Thick}, {Blue, Thick}, {Red, Thick}},
Background → Lighter[Blue, 0.9],
PlotLabel → "Partial sums of the Bessel function"]
 Clear[S]

17. Plot [1/ (Exp [x – 12] + 1), {x, 0, 20),

PlotRange → {0, 1.1}, PlotStyle → Thickness[0.008],
AxesLabel → {"€ (kT)", "n (€)"}, Ticks → {{{12, "μ"}}, {0.5, 1}}]
Plot [1/ (exp[x] + 1), {x, –10, 6}, Frame → True,
GridLines → {Table [i, –10, 6, 2}], Tale [i, {i, 0, 1, 0.2}]},
PlotStyle → Thickness [0.008],
FrameLabel → {" (€ – μ) (kT)", "n(€)"},
PlotLabel - > "Fermi-Dirac Distribution",
FrameTicks - > {Table [i, {i, –10, 6, 2}], Automatic, None, None},
FrameStyle → Thickness[0.005]]

19. ClickPane [Plot [{6(Sech[x]^2), Sqrt[5 –x^2]},

{x, –Sqrt [5], Sqrt[5]}], (xycoord = #) &]
Dynamic [xycoord]
startvalue = {–2.2190927280183064', –1.1662385139950224',
1.166238513995022', 2.219092728018306'};
Table [FindRoot [6 (Sech [x]^2) == Sqrt [5 – x^2],
{x, startvalue [[i]]}], {i. Length [startvalue]}]
Clear [xycoord, startvalue]

21. ClockPane [Plot [BesselJ[0, x], {x, 0, 16}], (xycoord = #)&]

Dynamic [xycoord]
startvalue = {2.4017801178387854', 5.53453679328068',
8.728720070201827', 11.92290334712976', 14.871280218127111'};
Table [FindRoot [BesselJ [0, x] == 0, {x, startvalue [[i]]}],
{i, Length [startvalue]}]
ourstartvalue = {3.9374451548201064', 10.202958505703895'};
Table [FindMinimum [BesselJ [0, x], {x, ourstartvalur [[i]]}],
{i, Length [ourstartvalue]}]
Clear [xycoord, startvalue, ourstartvalue]

23.

25. ClockPane [Plot [ {Abs [(Sin[x] –x) /Sin[x]], 0.01}, {x, 0, 03.}],
(xycoord = #) &]
FindRoot [Abs [(Sin[x] – x) /Sin[x]] == 0.01, {x, xycoord[[1]]}]
% [[1, 2]]/Degree
 Clear [xycoord]
ClickPane [Plot [{Abs [(Sin [x] – x)/Sin[x]], 0.005}, {x, 0, 0.2}],
(xycoord = #) &]
FindRoot [Abs[(Sin [x] – x) /Sin[x]]] == 0.005, {x, xycoord [[1]]}]
%[[1, 2]]/Degree
Clear[xycoord]

27. mydata = {{4, 5}, {6, 8}, {8, 10}, 9, 12}};

Fit [mydata, {1, x}, x]
Plot1 = Plot[%, {, 3 10}, AxesLabel - > {"x", "y"}]
Plot2 = ListPlot [mydata,
AxesLabel - > {"x", "y"}, PlotStyle - > PointSize [0.02]]
Show [Plot1, Plot2]
Clear [mydata, plot1, plot2]

29. xlist = Table [i, {i, 0, 2π, 2π/9}];

Length[%]
ylist = Sin[xlist];
Transpose [{xlist, ylist}];
ListPlot [%, PlotStyle - > PointSize [0.025],
AxesLabel - > {"xlisti", "ylisti"}]
Clear [xlist, ylist]

31. data = {{0, 1}, {0.1, 1.05409}, {0.2, 1.11803}, {0.3, 1.19523},
{0.4, 1.29099}, {0.5, 1.41421}, {0.6, 1.58114},
{0.7, 1.82574}, {0.8, 2.23607}, {0.9, 3.16228}};
Fit [data, {1, x, x2, x3}, x]
Plot [%, {x, 0, 1}, AxesLabel → {"x", "f(x)"}]
ListPlot[data, PlotStyle → PointSize[0.02],
AxesLabel → {"x", "f(x)"}]
Show [%, %%]
Clear [data]

33. ParametricPlot [{θ – 0.5 Sin [θ], 1 – 0.5 Cos [θ]},

{θ, 0, 7π}, PlotRange - > {{0, 7π}, {0, 2}},
Ticks → {Range [0, 7 π, π], Range [0, 2]},
AxesLabel → {"x (r)", "y (r):},
ImageSize - > 72 * 7.5, PlotStyle - > {Red, Thick}]

ParametricPlot [{θ – 1.5 Sin [θ], 1 – 1.5 Cos [θ]},

{θ, 0, 7π}, PlotRange - > {{–π/6, 7π}, {–1, 3}},
Ticks → {Range [π, 7π, 2π], Range [–1, 3]},
AxesLabel → {"x (r)", "y (r)"},
ImageSize - > 72 * 7.5, PlotStyle - > {Red, Thick}]

35.
37. Do [vdP = NDSolve[{x' [t] == v[t], v'[t] == 0.5(–x[t]^2)v[t] – x[t],
v[0] == 0, x[0] == i}, {x, v}, {t, 0, 50}];
Print [ParametricPlot [Evaluate [{x[t], v[t]}/ .vdP],
{t, 0, 7π}, AxesLabel → {"x", "v"}]], {i, 1, 3, 0.5}]
Clear[vdP]

39. Plot 3D[x^2 + y^2, {x, –2, 2}, {y, –2, 2},
BoxRatios - > {1, 1, 1}, AxesLael - > {"x", "y", "z"}]

41. Plot 3D [Sin [x + y], {x, 0, 2π},

{y, 0, 2π}, AxesLabel →{"x", "y", "f(x, y)"}]

43. Plot3D[x(y^2) –x^3, {x, –2, 2}, {y, –2, 2}, BoxRations → {1, 1, 1},
Boxed → False, Axes → False, ViewPoint → {–0.060, 3.354, 0.447}]

45. Plot3D [Exp [– (x + y) ^2], (x, –2, 2},

AxesLabel → {"x", "y", "f"}, Ticks → {{–2, 0, 2}, {–2, 0, 2}, None}]

47. ListAnimate [Table [Plot 3D [(t + x) ((x^2) – 3 (y^2)), {x, –2, 2},
{y, –2, 2}, BoxRations → {1, 1, 1}, PlotRange → {–150, 150},
Boxed → False, Axes → False], {t –12, 12, 1}]]

49. LostAnimate [Table [Plot [Sin [x – i (2π/16)] + 0.75 Sin [x + i (sπ/16)],

{x, 0, 8π}, PlotRange → {–2, 2},
AxesLabel -> {"x (1/k)", "y (A)"}], {i, 0, 15, 1}]]
There are antinodes but no nodes.
There is another way to generate the animation:
Do[Print [Plot [Sin [x – i (2π/16)] + 0.75 Sin [x + i (2π/16)],
{x, 0, 8π}, PlotRange → {–2, 2},
AxesLabrl - > {"x (1/k)", "y (A)"}]], {i, 0, 15}]
To animate, select all the Print cells and choose Graphics ▸ Rendering ▸ Animate Select
Again, there are antinodes but no nodes.

51. ParametricPlot3D[{{u Cos [v], u Sin [v], u^2},

{u Cos [v], u Sin [v], (1/2) (u Cos [v] + 3 u Sin [v] + 3)}},
{u, 0, 2}, {v 0, 2π}, Boxed → False, Axes → False]

53. g[i_] : =
Plot[
{Exp [–16 (x - i) ^2] + 1.5 Exp [–(x + i) ^2],
1.5 Exp [– (x + i) ^2] + 3, Exp [–16 {x – i) ^2] + 5}, {x, –3.0, 3.0},
PlotStyle → {{Thickness [0.01], Black},
{Thickness[0.005], Red}, {Thickness [0.005], Blue}},
PlotRange → {–0.1, 6.25}, Axes → False,
Frame - > True, FrameTicks - > None]
Grid [Partotopm [Table [g [i], {i, –2.0, 3.5, 0.5}], 3]]
 Clear [g]

55. Plot [{y Tan[y], Sqrt[16 – y^2]},

{y, 0, 8}, PlotRange → {{0.5}, {0.5}}]
startvalue = {{1.254, 3.802}, {3.606 1.739}};
Table [FindRoot [y Tan[y] == Sqrt [16 – y^2], {y, startvalue [[i, 1]]}],
{i, Length [startvalue]}]

Section 2.4.12
1. RandomInteger[20, {5, 5}]
% // MatrixForm

3. 1. For n = 102 we have for the outcomes

RandomInteger [{1,2}, 10^2]
whrere “1” represents heads up and “2” represents tails up.
We can genrerate the distribution of getting heads and tails:
distribution = Table [Count [%, i], {i, 1, 2}]
To Produce a bar chart of this distribution, let us use the function BarChart in the
package BarCharts':
Needs ["BarCharts'"]
BarChart [distribution, BarLabels → {"heads", "tails"}]
2. For n = 103, 104, 105, and 106, we have
3. Do[Print [
4. BarChart [Table [Count [RandomInteger [{1, 2}, 10^j], i], {i, 1, 2}],
5. BarLabels → {"heads", "tails"},
PlotLabel - > "n = "<> ToString[10^j]]], {j, 3, 6}]
6. Probability indicates the relative frequency that a particular event would occur in the
Here, after a very great number of tosses, the distribution became fairly uniform and
number of times getting, for example, heads approached the value 1/2 ,the probabilit
landing heads up with a single toss.

5. Table [(x^n) – 1, {n, 1, 11, 2}]

Drop [%, (2,3}]

7. mymatrix = Array [a, {4,4}]

% // MatrixForm
mymatrix [[All, 3]]
% // MatrixForm
mymatrix [[Range [2, 4], {3, 4}]]
% // MatrixForm
Clear [mymatrix]
9. Select [{14, 29, 30, 35, 53, 86, 42,
76, 16, 98, 87, 54, 100, 69, 20, 101, 3}, OddQ]

11. mylistA = RandomInteger [{301, 600}, 20]

mylistB = RandomInteger [{301, 600}, 20]
ReplacePart [mylistA, mylistB [[12]], 2]
Clear [mylistA, mylistB]

13. {a, b, c}, a, {d, {e, {f, {a, c, g}}}}}

Flatten [%]
Position [%%, {a, c, g}]
FlattenAt [%%%, {{2}, {4, 2, 2, 2}}]

15. mylist = {a, {d, {e, {f, {g, h}}}}, {{i, {j, k}}, {p, q, {r, s}}}}
Position [mylist, {g, h}]
Position [mylist, {r, s}]
FlattenAt {mylist, {{2, 2, 2,2}, {3, 2, 3}}]
Clear [mylist]

17. bigger[x_] : = x > 50

SomeRandoms = RandomInteger [{1, 200}, 30]
Select [someRandoms, bigger]
Clear [bigger, someRandoms]

19. Yourlist = Flatten [Table [{n, l, ml, ms}, {n, 2, 4},

{1, 0, n – 1}, {ml, –l, l}, {ms, –1/2, 1/2}], 3]
Yourtest [x_] : = x[[3]] == –2
Select [Yourlist, yourtest]
Clear [Yourlist, Yourtest]

21. noduplicates [list_] : = Union [list] === Sort [list]

noduplicates [{d, c, a, b}]
noduplicates [{d, d, d, a}]
noduplicates [{a, a, a, a}]
Clear [noduplicates]

23. onlyduplicates [list_] : Length [Union [list]] == 1

onlyduplicates [{d, c, a, b}]
onlyduplicates [{a, a, a, d}]
onlyduplicates [{a, a, a, a}]
onlyduplicates [{x^2 – 1, x^2 – 1, x^2 – 1, (x – 1) (x + 1)}]
onlyduplicates [{{–1, –1, 2}, {–1, –1, 2}, {–1, –1, 2}}]
Clear [onlyduplicates]

25. Range [2, 16, 2]^2

Apply [Plus, %]/Length[%]
27. Ourlist =
{84, 79, 30, 45, 51, 86, 42, 57, 6, 98, 3, 87, 14, 100, 69, 20}
1. Apply [Plus, ourlist] /Length [ourlist] // N
2. Total [ourlist] /Length[ourlist] //N
3. Mean [ourlist] // N
4. (Plus @@ Take [Sort [ourlist], {8, 9}])/2
5. Median [ourlist]
6. crit [x_] : = x > 50
7. Select [ourlist, crit]
8. newlist = Partition[ourlist, 4]
9. % // MatrixForm
10. newlist [[3]]
11. Transpose [newlist] [[3]]
or
newlist [[All, 3]]
12. Flatten [newlist]
Clear [ourlist, crit, newlist]

29. Range [100]

Partition [%, Length [%]/2]
MapAt [Reverse, %, 2]
% [[1]] + % [[2]]
101 Length [%]
%/100

31. T = {15, 20, 25, 30, 40, 50, 60, 70, 80, 90,
100, 110, 120, 130, 140, 150, 160, 170, 180, 190, 200,
210, 220, 230, 240, 250, 260, 270, 280, 290, 298.1};
Cp = {0.311, 0.605, 0.858, 1.075, 1.452, 1.772, 2.084,
2.352, 2.604, 2.838, 3.060, 3.254, 3.445, 3.624, 3.795,
3.964, 4.123, 4.269, 4.404, 4.526, 4.639, 4.743, 4.841,
4.927, 5.010, 5.083, 5.154, 5.220, 5.286, 5.350, 5.401};
Integrate [Interpolation [Transpose [{T, Cp/T}]] [x], {x, 15, 298.1}]
Clear [T, Cp]

33. Needs ["VectorAnalysis'"]

SetCoordinates[Cartesian [x, y, z]];
a = {ax [x, y, z], ay [x, y, z], az [x, y, z]};
f = func [x, y, z];
Simplify [Curl [fa] – f Curl [a] + CrossProduct [a, Grad [f]]]
Clear [f, a]

35. data = {{0.46, 0.19}, {0.69, 0.27}, {0.71, 0.28}, {1.04, 0.62},
{1.11, 0.68}, {1.14, 0.70}, {1.14, 0.74}, {1.20, 0.81},
{1.31, 0.93}, {2.03, 2.49}, {2.14, 2.73}, {2.52, 3.57},
{3.24, 3.90}, {3.46, 3.55}, {3.81, 2.87}, {4.06, 2.24},
{4.93, 0.65}, {5.11, 0.39}, {5.26, 0.33}, {5.38, 0.26}};
FindFit [data, a1 Exp[–(1/2) (((x – a2) /a3)^2)], {a1, a2, a3}, x]
Thus, a1, = 3.97924, a2 = 2.99725, and a3 = 1.00152.
 Show [ListPlot [data, PlotStyle - > PointSyze [0.025]],
Plot [Evaluate [a1 Exp [–(1/2) (((x –a2) /a3) ^2)]/.%], {x, 0, 6}],
AxesLabel → {"x", "y"}]
Clear [data]

37. tlist = Table [15i, {i, 58}];

countlist = {775, 479, 380, 302, 185, 157, 137, 119, 110, 89, 74, 61,
66, 68, 48, 54, 51, 46, 55, 29, 28, 37, 49, 26, 35, 29, 31,
24, 25, 35, 24, 30, 26, 28, 21, 18, 20, 27, 17, 17, 14, 17,
24, 11, 22, 17, 12, 10, 13, 16, 9, 9, 14, 21, 17, 13, 12, 18};
data = Transpose [{tlist, countlist}];
FinFit [data, a1 + a2 Exp [–t/a3] + a4 Exp [–t/a5],
{a1, a2, a3, a4, a5}, t, PrecisionGoal → 6]
decay [t_] = (a1 + a2Exp [–t/a3] + a4 Exp [–t/a5]/.%
Show[ListPlot [data, PlotStyle → PointSize[0.015]],
Ploy [decay [t], {t, 15, 870}, PlotRange - > All],
AxesLabel - > {"time (sec)", "counts"}]
Clear [tlist, countlist, data, decay]

39. data = {{100, –160,}, {200, –35},

{300, –4.2}, {400, 9.0}, {500, 16.9}, {600, 21.3}};
B = interpolation [data]
Show [Plot [B[T], {T, 100, 600}],
ListPlot [data, PlotStyle → PointSize [0.02]], Frame → True,
FrameLabel → {"T(K)", "B(cm^3/mol)"}, Axes → None]
B[450] (cm^3) / mol
Clear [data, B]

41. Let us being with the assignment:

distances = {1023.56, 1023.47, 1023.51, 1023.49,
1023.51, 1023.48, 1023.50, 1023.53, 1023.48, 1023.52};
The sample mean (in ft) is
NumberForm [Mean [distances], 7]
The sample standard deviation (in ft) is
NumberForm, [StandardDeviation [distances], 2]
The standard deviation of the mean (in ft) is
NumberForm [%/Sqrt [Length [distances]], 1]
Thus, the Thus, the best estimates for the distance between the two points and its uncertain
ft and 0.009 ft, respectively. The experimental result is usually stated as 1023.505 ± 0.009 f
Clear [distances]

43. 1. Let us begin with the assignment for the list of numbers of decays observed in 1 min
dpm = {9, 11, 15, 16, 19, 22, 24}
For each number of decays observed in 1 minute, there is a number of times observe
numbers of times observed is
freq = {2, 2, 2, 1, 1, 1, 1}
 and the list of fractional numbers of times observed is
frac = freq/Total [freq]
The best estimate of the mean number of decays in 1 minute is the sample mean:
μ = Total [dpmfrac] // N
The best estimate of the standard deviation is
NumberForm [Sqrt [μ], 2]
The best estimate of the standard deviation of the mean σ is given by
μ

NumberForm [Sqrt [μ/Total [freq]], 2]

2. To plot the bar histogram, we use the function GeneralizedBarChart in the
package BarCharts‘. Here is the bar histogram of the fractional number of “times ob
the “number of decays” together with the plot of the Poisson distribution with μ= 15.
3. Needs ["BarCharts'"]
4. Show [GeneralizedBarChart [Transpose [{dpm, frac, Table [0.2, {7}]}]],
5. Plot [(μx Exp [–μ]) / ((x)!), {x, 9, 24],
6. PlotStyle → Thickness [0.0125]], Frame → True,
7. FrameLabel → {"Decay Number", "frac times observed"},
8. FrameTicks → {Automatic, Automatic, None, None}, Axes → False]
Clear[dpm, freq, frac, μ]

45. myaccumulate [list_] : =

Table [Sum[list [[n]], {n, 1, i}], {i, 1, Length [list]}]
myaccumulate [{a, b, c, d}]
myaccumulate [{a, b, c, d, e}]
myaccumulate [{{a, b}, {c, d}, {e, f}}]
myaccumulate [{{a, b}, {c, d}, {e, f}, {g, h}}]
Clear [myaccumulate]

47. MyData = {{"t(2)", "d(ft)"},

{0.5, 4.2}, {1.0, 16.1}, {1.5, 35.9}, {2.0, 64.2}};
Export ["C: \APGTM\MyFolder\Grav.txt", MyData, "Table"]
Export ["C: \APGTM\MyFolder\Grav1.xls". MyData]
Clear [MyData]

49. data =
Import [" /2nd Edition 2008/ApGTM2ND/OurFolder/ACDC.txt", "Table"]
mydata = Drop [data, 9]
func[x_] : = Take [x, {2, 13}]
ourdata = func/@mydata
newdata = ourdata // Flatten
concentration = interpolation [newdata]
Plot [concentration [x], {x, 1, 480},
Axes → False, Frame → True, FrameTicks →
{{Automatic, Automatic}, {Transpose [{Table [i, {i, 1, 433, 72}],
Table [1964 + i, {i, 1, 37, 6}]}], Automatic}},
FrameLabel → {"Year", "Concentration (ppm)"}]
Clear [data, mydata, func, ourdata, newdata, concentration]
Section 2.5.4
1.

1.

2.

3.

4.

5.
6. T = {15, 20, 25, 30, 40, 50, 60, 70, 80, 90,
7. 100, 110, 120, 130, 140, 150, 160, 170, 180, 190, 200,
8. 210, 220, 230, 240, 250, 260, 270, 280, 290, 298.1};
9. Cp = {0.311, 0.605, 0.858, 1.075, 1.452, 1.772, 2.084,
10. 2.352, 2.604, 2.838, 3.060, 3.254, 3.445, 3.624, 3.795,
11. 3.964, 4.123, 4.269, 4.404, 4.526, 4.639, 4.743, 4.841,
12. 4.927, 5.010, 5.083, 5.154, 5.220, 5.286, 5.350, 5.401};
where C is the capital script c.

with the units cal/K.

Transpose [{T, Cp}];
ListPlot [%, PlotStyle → PointSize [0.015],
AxesLabel → {"T(K)", "Cp (cal/K):}]
Clear [T, Subscript]
 13.
Where E is the capital Greek letter epsilon.

3.
1.

2.

5.

7.
(a)
(b) Solve [∂r % == 0, r] [[4]]]

9.

11. Needs ["Units'"]

1. C = 5.10 × 10–6 Farad
f0 = 1.30 × 103 Hertz
 where we have used the capital script C to denote the capacitance because the keyboa
built-in meaning in Mathematica. The inductance is given by

For a discussion on obtaining parts of expressions, see Section 3.1.3.1.

2.
At reesonance, we have

and cos φ = 1. Thus, the average power delivered by the source at resonance can be w

The resistance is given by

3. The power factor is given by

We have avoided making assignments for XL and XC because L and Calready have ass
{XL,Xc}
Using transformation rules allows us to bypass this difficulty.
Clear [C, L, R, Subscript, OverBar]

Section 3.1.4
1. 1. x – y // FullForm
2. x^2/y^2//Fullform
3. {a, {b, {c, d}}, {e, f}}//FullForm
4. (a + Ib) / (c – Id) // FullForm
5. Integrate [x^2, x] // Hold// FullForm
6. DSolve[y'' [x] – 3y' [x] – 18y[x] == x Exp[4x], y[x], x] // Hold// Fullform
7. f[a] + g[c, d]/ .f[x_] → x^3//Hold//FullForm
8. Sin/@ (a + b + c) // Hold //FullForm
9. CrossProduct [a, CrossProduct [b, c]] +
10. CrossProduct [b, CrossProduct [b, c]] +
11. CrossProduct [c, CrossProduct [a, b]] // FullForm
3. complexConjugate [expr_] : = (expr /. Complex [x_, y_] → Complex [x, –y])
For example,
ComplexConjudgate [(a + b)/ (c – d)^2]
Clear [complexConjugate]

5.

7. Level [x^3 + (1 + z) ^2, {2}]

9. Rest [Part [a + b/c + (d + e) / (1 + f/ (1 – g/h)), 3, 2, 1, 2, 2, 1, 2]]

11. myexpr = a +b/c + (d + e/g) / r + s/ (1 + t));

Position [myexpr, 1 + t]
Part [myexpr, 3, 2, 1, 2, 2, 1]
Clear [myexpr]

13.

15.

17. mytest [expr_] : = FreeQ [expr, y]

Select [
1 + 3x + 3x^2 + x^3 + 3y + 6xy + 3x^2y + 3y^2 + 3xy^2 + y^3, mytest]
Clear [mytest]

19. Table [{i}, {i, 2, 8}]

Insert [h [e1, e2, e3, e4, e5, e6, e7,], b, Table [{i}, {i, 2, 8}]]

21. yourlist = {{a, {b, c}}, {d, {e, {f, {g, h}}}}, {{i, j}, k}};
1. FlattenAt [yourlist, Position [yourlist, {g, h}]]
2. Flatten [yourlist, 2]
Clear [yourlist]

23. t = {15, 20, 25, 30, 40, 50, 60, 70, 80, 90,
100, 110, 120, 130, 140, 150, 160, 170, 180, 190, 200,
210, 220, 230, 240, 250, 260, 270, 280, 290, 298.1};
cp = {0.311, 0.605, 0.858, 1.075, 1.452, 1,772, 2.084,
2.352, 2.604, 2.838, 3.060, 3.254, 3.445, 3.624, 3.795,
 3.964, 4.123, 4.269, 4.404, 4.526, 4.639, 4.743, 4.841,
4.927, 5.010, 5.083, 5.154, 5.220, 5.286, 5.350, 5.401};
1. cp/t
2. f [x_, y_] : = x/y
Thread [f [cp, t]]
Clear[cp, t, f]

25.

27. ourexpr = a + b/c + (d + e/f) / (r + s/t)

FullForm [ourexpr]
Positon [ourexpr, Power]
For the positions of all the numerators, replace the last two elements of each sublist by a sin
num [x_] : = Append [Drop [x, –2], 1]
MapAt [func, ourexpr, num/ @%%]
Clear [ourexpr, num]

29.

31.
Here is another way to do this:

Section 3.2.9
1.

3. sgn [x_ ? Positive] : = 1

sgn [x_ ? Negative] : = –1
Plot [sgn [x], {x, –2, 2}, AxesLabel → {"x", "sgn(x)"}]
ClearAll[sgn]

5. vectorClassify [{x_, y_}/; (x > 0 && y > 0)] : = 1

vectorClassify [{x_, y_)/; (x < 0 && y > 0)] : = 2
 vectorClassify [{x_, y_)/; (x < 0 && y < 0)] : = 3
vectorClassify [{x_, y_)/; (x > 0 && y < 0)] : = 4
vectorClassify [{x_, 0}/; x > 0] : = 5
vectorClassify [{x_, 0}/; x < 0] : = 6
vectorClassify [{0, y_}/; y > 0] : = 7
vectorClassify [{0, y_}/; y < 0] : = 8
Another definition:
ClearAll [vectorClassify]

vectorClassify [{_ ? Positive, _ ? Positive}] : = 1

vectorClassify [{_ ? Negative, _ ? Positive}] : = 2
vectorClassify [{_ ? Negative, _ ? Negative}] : = 3
vectorClassify [{_ ? Positive, _ ? Negative}] : = 4
vectorClassify [{_ ? Positive, 0}] : = 5
vectorClassify [{_ ? Negative, 0}] : = 6
vectorClassify [{0, _ ? Positive}] : = 7
vectorClassify [{0, _ ? Negative}] : = 8
{vectorClassify [{–10, 0}], vectorClassify [{2, 0}],
vectorClassify [{0, -5.2}], vectorClassify [{–2.6, 4}],
vectorClassify [{3, –3}], vectorClassify [{3π/2, –2.1}]}

{vectorlassify [{1, 1, 2}],

vectorClassify [{0, 0}], vectorClassify [1, 0]}

ClearAll [vectorClassify]

7. Cases [{a, {a}, {a, a}, {b, c}, {d, {e, f}}, {Sin [ax], Sin [ax]},
{a, a, a}, {Sin [bx], Tan [cx]}}, {x_, y_}/; x = ! = y, Infinity]

9.

11. SetAttributes [f, Orderless]

f [x_Symbol, y_Integer, z_Complex] : = {x, y, z}
f [2 + I, g, 5]
ClearAll [f]

13. func [x_Symbol, y_Integer : 7] : = yx

{func [x, 10], func[x], func[x], func[2, 5], func[x, y, 4], func [{x, 6}]
ClearAll [func]

15. myRane [n_Integer : 1, m_Integer] : = Table [i, {i, n, m}]/ ; m ≥ n

{myRange [5], myRange [1], myRange [0], myRange [–7]}
myRange [–3, 2], myRange [2, 4], myRange [5, 2], myRange, 3.5, 5.5]}
ClearAll [myRange]
17.

19. ourfunc [r_Rational |r_Integer] : = Abs [r]

{ourfunc [–3/5], ourfunc [–5], ourfunc[7],

ourfunc [x], Ourfunc [–3/5, –5], ourfunc[1.2]}

ClearAll [ourfunc]

21. characterList = Characters [ToString [N[Pi, 770]]];

findNines [{"3", ".", a _ _ _, "9", "9", "9", "9", "9", "9",_ _ _}] : =
Length [{a}]
findNines[characterList]
ClearAll [characterList, findNines]

23.

25. Here are several acceptable definitions:

mymean [{x _ _}] : = (Plus,[x])/Length [{x}]/; NumberQ [Plus [x]]
yourneams[x : {_ _}] : = (Plus @@ x) /Length [x] / ; NumberQ [Plus @@ x]
ourmean [x_List/; Length [x]≥1]: =
(Plus @@ x) /Length [x]/ ; NumberQ [Plus @@ x]
mylist = Table [RandomInteger [1000], {RandomInteger[{1, 100}]}];
{mymean [mylist], yourmeans [mylist], ourmean [mylist]}
yourlist = {1, a, x, y, b}
{mymean [yourlist], yourmean [yourlist], ourmean [yourlist]}
ClearAll [mymean, yourmean, ourmean, mylist, yourlist]

27. myfunc [x _ _ List] : = Length /@ {x}

{myfunc [{1}, {2, 3, 4, 5}, {6, 7}, {8, 9}],
myfunc[{a, b}, {c, 5}], myfunc [x, 3, {1}]}
ClearAll [myfunc]

Section 3.3.7
1. 1. f[x_] : = 1 + x^3
2. ClearAll[f]
3. func [x_] : = {x, x2}
4. ClearAll [func]
5. my f [z_] : z/. x → y
6. ClearAll [myf]
7. g[x_, y_] : = 1/xy
8. ClearAll [g]
9. h[x_, y_, z_] : = (x, y^z)
10. ClearAll[h]
11. myg[y_] : = – D [y, x]
12. ClearAll [myg]
13. g[y_] : = y3
14. f[x_] : = g/@x
15. ClearAll [g, f]
16. hisf [x_] : = Apply [And, Map [OddQ, x]]
17. ClearAll [hisf]
18. herf [x_] : = Delete [x, RandomInteger [{1, Length [x]}]]
19. ClearAll [herf]

3. Cases [{1, a, 2.0, 5.0, 4, x^2, Sin[x]}, _ Integer? (# > 3 &)]

5. Select [{{4.294, 3.757, 7.222}, 9.240, 3.008, 1.001},

{0.696, 3.826, 0.375}, {1.931, 4.814, 5.422},
{7.161, 3.665, 0.212}, {1.809, 4.298, 7.333},
{5.745, 3.287, 1.215}, {1.901, 3.335, 0.022},
{8.769, 3.246, 0.137}}, (Times @@ #) > 20&]

7. Table [{RandomInteger [10], RandomInteger [10], RandomInteger [10]},

RandomInteger [10]}]
Select [%, EvenQ [Plus @@ #] &]
Select [%%, OddQ [Plus @@ #] &]

9. Needs ["VectorAnalysis'"]
CoordinateSystem
Coordinates []
SetCoordinates [Cartesian [x, y, z]]
A = {Ax [x, y, z], Ay [x, y, z], Az [x, y, z]};
B = {Bx [x, y, z], By [x, y, z], Bz [x, y, z]};

Simplify [Curl [CrossProduct [A, B]] –

(DotProduct [B, {D[#, x], D[#, y], D[#, z]}] &) / @A +
(DotProduct [A, {D[#, x], D[#, y], D[#, z]}] &) / @B –
A Div[B] + B Div [A]]
ClearAll [A, B]

11. 1. {v0, θ0} // FullForm

2. {v0, θ0} = {55 m/s, 30°};
3. {v0, θ0}
4. ?? Subscript
 5. ClearAll [Subscript]
6. {v0, θ0}

13. 1. hermit [n_Integer/ ; n > 1, z_] : =

2. Expand @ (2 z hermite [n – 1, z] – 2 (n – 1) hermite [n – 2, z])
3. hermite [0, z_]: = 1
4. hermit [1, z_] : =2 z
5. totalCalls [n_Integer/ ; n > 1, z_] : =
6. Trace [hermite [n, z], hermite [_integer, z]] // Flaten // Length
7. totalCalls [20, z]
8. partialCapps [n_integer/ ; n > 1, k_Integer? NonNegatrive, z_] : =
9. (Trace [hermit [n, z], hermit [k, z]]//Flaten// Length)/; n ≥ k
10.
11. partialCalls [20, 3, z]
12. newTotalCalls [n_Integer/; n > 1, z_] : = (ClearAll [H];
13. H[m_Integer/; m > 1, x_] : =
14. H[m, x] = Expand @ (2 x H [m – 1, x] – 2 (m – 1) H (m – 2, x]);
15. H[0, x_] : = 1;
16. H[1, x_] : = 2x;
17. Trace [H [n, z], H[_Integer, z]] // Flaten // Length)
18. newTotalCalls [20, z]
19.
20. newpartialCalls [n_Integer/; n > 1,
21. k_Integer ? NonNegative, z_] : = (ClearAll [H];
22. H [m_Integer/; m> 1, x_] : =
23. H[m, x] = Expand @ {2 x H [m – 1, x] – 2 (m – 1) H (m – 2, x]);
24. H [0, x_] : = 1;
25. H [1, x_] : = 2 x;
26. Trace [H[n, z], h[k, z]] // Flatten // Length) /; n≥k
27.
28. newPartialCalls [20, 3, z]
29.
30. ClearAll [hermit, totalCalls,
31. partialCalls, H, newTotalCalls, newPartialCalls]

15. 1. m = 3. 00 10–3;
2. b = 0. 0300;
3. g = 9.8;
4. vT = –gm/b
The terminal speed is 0.98 m/s. Ninety-nine Percent of the terminal speed is 0.9702 m
Abs [%]0.99
5. t[0] = 0;
6. x[0] = 0;
7. v[0] = 0;
8. a[n_] : = a[n] = –g– (b/m)v[n]
9. Δt = 0.005;
10. t[n_] : = t[n] = t [n – 1] + Δt
11. v[n_] : = v[n] = v [n – 1] + a[n – 1] Δt
12. x[n_] : = x[n] = x [n – 1] + v[n – 1] Δt
13. velocity = Table [v[n], {n, 0, 90}];
14. time = Table [t[n], {n, 0, 90}];
15. ListPlot [Transpose [{time, velocity}],
16. AxesLabel → {"time (s)", "velocity (m/s)"}]
17. position = Table [x[n], {n, 0, 90}];
 18. ListPlot [Transpose [{time, position}],
19. AxesLael → {"time(s)", "position (m)"}]
20. TableForm [Transpose [{time, position, velocity}], TableHeadings →
21. {None, {"Time (s)", "Position (m)", "Velocity (m/s)"}]
22. ClearAll [m, b, g, vT, t, x, v, a, Δt, velocity, time, position]

23.
Note that there are discrepancies between the results of Euler’s method and NDSolve. Decre
size would improve the accuracy of the Euler method solution.

17. 1. FoldList [Plus, 0, {a, b, c, d}]

2. FoldList [Times, 1, {a, b, c, d}]
3. Fold [10 #1 + #2&, 0, {1, 0, 3, 5, 7, 3}]

19.
1. The point x = 0 is a stable fixed point when the map parameter μ is less than 1/2:

Here is a graph of f(x) together with the straight line x:

Plot [{f [x], x}, {x, 0, 1}, PlotRange → {0, 1}]
2. The Point x = 0 is a fixed point when the map parameter μ is greater than 1/2:
3. μ = RandomReal [{1/2, 1}]
0 == f [0]
The point is not stable or attracting:
ListLinePlot [Transpose [{Range [0, 100], NestList [f, 0.0001, 100]}],
PlotRange → {0, 1]]
Another point x = 2 μ/(1 + 2 μ) is also a fixed point when the map parameter μ is gre

The point is also not stable or attracting:

Here is a graph of f(x) together with the straight line x:

 Plot [{f [x], x}, {x, 0, 1}, PlotRange → {0, 1}]
ClearAll [f, μ]

21. 1.
The head of is Power rather than Sqrt. Thus, the additional rules associated with
apply to .

2.

Section 3.4.6
1. Single-clause definition:
scf [x_] : = If [x ≥ 0, x, –x]
Another single-clause definition:
anotherscf [x_] : = Piecewise [{{x, x ≥ 0}, {–x, x < 0}}]
Multiclause definition:
mcf [x_/ ; x ≥ 0] : = x
mcf [x_/ ; x < 0] : = –x
Derivative of f at 0:
∂x {scf[x], anotherscf[x], mcf[x]}/ .x → 0
The answer 1 for scf' [0] is wrong because f is not differentiable at 0, and we cannot find
multiclause definition.
ClearAll [scf, anotherscf, mcf]

3. 1. scV[x_] : =
2. Which [x < –2 || –1 ≤ x < 1, 0, –2≤x < –1, –2, 1≤x < 3, –1, x ≥ 3, 1]
3. anotherscV [x_] : = Piecewise [{{0, x < –2 || –1 ≤ x < 1},
4. {–2, –2 ≤ x < –1}, {–1, 1 ≤ x < 3}, {1, x ≥ 3}}]
5. mcV [x_/ ; x < –2 || –1 ≤ x < 1] : = 0
6. mcV [x_/ ; –2 ≤ x < –1] : = –2
7. mcV [x_/ ; 1 ≤ x < 3] : = –1
8. mcV [x_/ ; x ≥ 3] : = 1
9. Plot [scV[x], {x, –4, 4}, AxesLabel → {"x(a)", "V(b)"}]
10. Plot [anotherscV[x], {x, –4, 4}, AxesLabl → {"x (a)", "V (b)"}]
 11. Plot [mcV[x], {x, –4, 4}, AxesLabel → {"x (a)", "V(b)"}]
12. ClearAll [scV, anotherscV, mcV]

5. func [x_/ ; VectorQ [x, NumberQ]] : = If [Count [x, 0] == 0,

(1/#) &/@x, Print [Count [x, 0], "zeroes in list"]]
func [{1, 2, 3, 4, a}]
func [{2, 3, 4, 10}]
func [{0, 3, 0, 0}]
ClearAll [func]

7. 1. mySum [n_Integer? Positive] : =

2. Module [{i = 1, total = 0},
3. While {i ≤ n, total = total + Prime [i]: i + + ]; tital]
4. mySum[106]// Timing
5. yourSum [n_Integer? Positive] : = Plus @@ Table [Prime [i], {i, n}]
6. yourSum[106]//Timing

7.
9. 1. Options [binomialExpansion] = {caption → False, exponent → 2};
2.
3. binomialExpansion [x_Symbol, y_Symbol, opts_ _ _Rule] : =
4. Module [{caption, exponent},
5. Print[{opts}];
6. Print [Options [binomial Expansion]];
7. Print [caption];
8. Print [exponent];
9. caption = caption/ . {opts}/. Options [binomialExpansion];
10. exponent = exponent/. {opts]/. Options [binomialExpansion];
11. Print [caption] ;
12. Print [exponent];
13. If [caption = = = True, Print ["Expansion of ", (x + y)exponent]];
14. Expand [(x + y)exponent]]
15.
16. binomialExpansion [a, b]
17.
18. binomialExpansion [a, b, caption → True, exponent → 10]
Within Module, caption and exponent are declared local variables and, thus,
become caption$n and exponent$n. In the evaluation of caption = caption/ . {opts}/
Options[binomialExpansion] and exponent = exponent/ . {opts}/. Options [binomial
caption$n and exponent$n do not match the (unaltered) option
names caption and exponent in {opts} and OPtions [binomial Expansion] and therefo
unchanged because the option rules do not apply.
ClearAll [binomialExpansion]
19. ClearAll ["Global' *"]
20. Options [binomialExpansion] = {Caption → False, exponent → 2};
21. binomialExpansion [x_Symbol, y_Symbol, opts _ _ _Rule] : =
22. Module [{cap, exp},
 23. cap = caption/. {opts}/. Options[binomialExpansion];
24. exp = exponent/. {opts}/. Options [binomialExpansion];
25. If [cap = = = True, Print ["Expansion of ", (x + y)exp]];
26. Expand [(x + y)exp]]
27.
28. binomialExpansion[a, b]
29.
30. binomialExpansion [a, b, exponent → 10, caption → True]
Here, the local variables are cap and exp rather than caption and exponent.
ClearAll [binomialExpansion]

11. 1. Let V, x, and m be measured in units of V0, a, and m, respectively.

2. Important: Enter the definition of motion1DPlot in section 3.4.5 here.

3. (* name the options and specify their default values *)
4. Options [motion1DPlit] =
5. {positionPlot → True,
6. velocityPlot → True,
7. accelertationPlot → True,
8. combinationPlot → True,
9. positionAFLabel → {"t (s)", "x (m)"},
10. velocityAFLael → {"t (s)", "v (m/s)"},
11. accelerationAFLabel →{"t (s)", "a (m/s2)"},
12. combinationAFLabel → {"t (s)", None}};
13.
14. motion1dplot [a_, x0_, v0_, tmax_, opts _ _ _ Rule] : =
15. Module[
16. {{* declare local variables *)
17. sol, curves = {}, plotx, plotv, plota,
18.
19. (* determine option values and assign
20. them as initial values to local variables *)
21. position = positionPlot/. {opts}/. Options [motion1Dplot],
22. velocity = velocityPlot/. {optts}/. Options [motion1DPlot],
23. acceleration =
24. accelerationPlot/. {opts}/. Options [motion1DPlot],
25. combination = combinationPlot/. {opts}/. Options [motion1DPlot],
26. positionLabel = positionAFLabel/. {opts}/.
27. Options [motion1DPlot], velocityLabel =
28. velocityAFLabel/. {opts}/. Options [motion1Dplot],
29. accelerationLabel = accelerationAFLabel/. {opts}/.
30. Options [motion1DPlot], combinationLabel=
31. combinationAFLabel/. {opts}/. Options [motion1DPlot],
32.
33. (* select valid options for Plot and show and
34. assign them as initia; values to local variables *)
35. optPlot = Sequence @@ FilterRules [{opts], Options[Plot]],
36. optShow = Sequence @@ FilterRules [{opts}, Options [Graphics]]},
37.
38. (* set text of a warning message Z*)
39. motion1DPlot : : argopt =
40. "Each of the values for the options positionPlot,
41. velocityPlot, accelerationPlot, and
42. combinationPlot must be either True or False.";
43.
44. (* verify option specifications *)
45. If [Count [{position, velocity,
46. acceleration, combination}, True | False] = ! = 4,
47. Message [motion1DPlot : : argopt]; Return [$Failed]];
48.
49. (* solve the equation of motion numberically *) sol =
50. NDSolve [{x '' [t] == a, x[0] == x0, x' [0] == v0}, x, {t, 0, tmax}];
51. (* plot position vs. time *)
52. If[position,
53. Plotx = Plot [Evaluate [x[t]/. sol], {t, 0, tmax},
54. PlotLabel → "position vs. time", AxesLabel → positionLabel,
55. Ticks → Automatic, FrameLabel → positionLabel,
56. FrameTicks → Automatic, Evaluate [optPlot],
57. PlotRange → All, Axes → False, Frame → True];
58. Print [plotx];
59. AppendTo [curves, plotx]];
60.
61. (* plot velocity vs. time *)
62. If [velocity,
63. plotv = Plot [Evaluate[x' [t]/. sol],
64. {t, 0, tmax}, PlotLabel → "velocity vs. time",
65. AxesLabel → velocityLabel, Ticks → Automatic,
66. FrameLabel → velocityLabel, FrameTicks → Automatic,
67. Evaluate [optPlot], PlotStyle → Dashing [{0.03, 0.03}],
68. PlotRange → All, Axes → False, Frame → True];
69. Print [plotv];
70. AppendTo [curves, Plotv]];
71.
72. (* plot acceleration vs. time *)
73. If [acceleration,
74. plota = Plot [Evaluate[a/ .sol], {t, 0, tmsx},
75. PlotLabel → "acceleration vs. time",
76. AxesLabel → accelerationLabel, Ticks → Automatic,
77. FrameLabel → accelerationLabel, FrameTicks → Automatic,
78. Evaluate [optPlot], PlotStyle → RGBColor [1, 0, 0],
79. PlotRange → All, Axes → False, Frame → True];
80. Print[plota];
81. AppendTo [curves, plota]];
82.
83. (* combine the plots *)
84. If [(combination) && (Length [curves] > 1),
85. Show [curves,
86. PlotLabel → "combiation", AxesLabel → combinationLabel,
87. Ticks → {Automatic, None}, FrameLabel → combinationLabel,
FrameTicks → {Automatic, None}, optShow]]]
E greater than zero:
 E between –V0/8 and zero:

E between –V0/4 and –V0/8:

13.

1.
2. (* name the options and specify their default values *)
3. Options [newmotion1DPlot] =
4. {PositionPlot → True,
5. velocityPlot → True,
6. accelerationPlot → True,
7. combinationPlot → True,
8. positionAFLabel → {"t (s)", "x (n)"},
9. velocityAFLabel → {"t (s)", "v(m/s"},
10. accelerationAFLabel → {"t (s)", "a (m/s2)"},
11. combinationAFLabel → {"t (s)", None}};
12.
13. newmotion1DPlot [
14. eqn_/ ; Head [eqn] == Equal,
15. x0_/ ; (NumberQ[x0] && Im [x0] == 0),
16. v0_/ ; (NumberQ[v0] && Im [v0] == 0),
17. tmax_/ ; (NumberQ [tmax] && Im [tmax] == 0 && Positive [tmax]),
18. opts _ _ _ Rule]:=
19. Module [
20. {(* declare local variables *)
21. sol, corves ={}, plotx, plotv, plota,
22.
23. (* determine option values and assign
24. them as initial values to local variables *)
25. position = positionPlot/. {opts}/. Options [newmotion1Dplot],
26. velocity = velocityPlot/. {opts}/. Options [newmotion1DPlot],
27. acceleration = accelerationPlot/. {opts}/.
28. Options [newmotion1DPlot], combination =
29. combinationPlot/. {opts}/. Options [newmotion1DPlot],
30. positionLabel = positionAFLabel/. {opts}/.
31. Options [newmotion1DPlot], velocityLabel =
32. velocityAFLabel/. {opts}/. Options [newmotion1DPlot],
33. accelerationLabel = accelerationAFLable/. {opts}/.
34. Options [newmotion1DPlot], combinationLabel =
35. combinationAFLabel/. {opts}/. Options [newmotion1DPlot],
36.
37.
38. (* select vaild options for Plot and Show and
39. assign them as initial values to local variables *)
40. optPlot = Sequence @@FilterRules [{opts}, Options [Plot]],
41. optShow = Sequence @@FilterRules [{opts}, Options [Graphics]]},
42.
43. (* set text of a warning message *)
44. newmotion1DPlot : : argopt =
45. "Each of the values for the options positionPlot,
46. velocityPlot, accelerationPlot, and
47. combinationPlot must be either True or False.";
48.
49. (* verify option specifications *)
50. If [Count [{position, velocity,
51. acceleration, combination}, True |False] = ! = 4,
52. Message [newmotion1DPlot: : argopt]; Return [$Failed]];
53.
54. (* solve the equation of motion numberically *)
55. sol = NDSolve [{eqn, x[0] == x0, x' [0] == v0}, x, {t, 0, tmax}];
56. (* plot position vs. time *)
57. If [position,
58. Plotx = Plot [Evaluate [x [t]/. sol], {t, 0, tmax},
59. PlotLabel → "position vs. time", AxesLabel → positionLabel,
60. Ticks → Automatic, FrameLabel → positionLabel,
 61. FrameTicks → Automatic, Evaluate [optPlot],
62. PlotRange → All, Axes → False, Frame → True];
63. Print [plotx];
64. AppendTo [curves, plotx]];
65.
66. (* plot velocity vs. time *)
67. If[velocity,
68. plotv = Plot [Evaluate [x' [t]/. sol],
69. {t, 0, tmax}, PlotLabel → "velocity vs. time",
70. AxesLabel → velocityLabel, Ticks → Automatic,
71. FrameLabel → velocityLabel, FrameTicks → Automatic,
72. Evaluate [optPlot], PlotStyle → Dashing [{0.03, 0.03}],
73. PlotRange → All, Axes → False, Frame → True];
74. Print [plotv];
75. AppendTo [curves, plotv]];
76.
77. (* plot acceleration vs. time *)
78. If [acceleration,
79. plota = Plot [Evaluate [(eqn [[2]])/. sol], {t, 0, tmax},
80. PlotLabel → "acceleration vs. time",
81. Axeslabel → accelerationLabel, Ticks → Automatic,
82. FrameLabel → accelerationLabel, FrameTicks → Automatic,
83. Evaluate [optPlot], PlotStyle → RGBColor [1, 0, 0],
84. PlotRange → All, Axes → False, Frame → True];
85. Print [plota];
86. AppendTo [curves, plota]];
87.
88. (* combine the plots *)
89. If [(combination) && (Length [curves] > 1),
90. Show [curves,
91. PlotLabel → "combination", Axeslabel → combinationLabel,
92. Ticks → {automatic, None}, FrameLabel → combinationLabel,
93. FrameTicks → {Automatic, None}, optShow]]
94. ]
95.
96. newmotion1DPlot [eqn_, x0_, v0_, tmax_, opts _ _ _ Rule]: =
97. (newmotion1DPlot: : argtype =
98. "One or more arguments entered are of the wrong type." ;
99. Message [newmotion1DPlot: :argtype]; Return [$Failed])
100.
101. ClearAll [newmotion1DPlot]

Section 3.5.4
1.

3. ClearAll ["Global ' * "]

twoTriangles = {
Thickness [0.008],
Line [{{–4, 0}, {4, 0}, {0, 6}, {–4, 0}}],
Line [{{–4, 4}, {4, 4}, {0, –2}, {–4, 4}}]};
sixVertices = {
PointSize [0.075],
Transpose [{
Table [RGBColor [Random [], Random [], Random [] ], {6}],
Point/@{{–4, 0}, {4, 0}, {0, 6}, {–4, 4}, {4, 4}, {0, –2}}}]};
Graphics [{twoTriangles, sixVertices}]

5. Graphics [
{{Green, Polygon [{{0, 10}, {5, 16}, {10, 10}}],
Polygon [{{1, 15}, {5, 21}, {9, 15}}],
Polygon [{{2, 20}, {5, 25}, {8, 20}}]},
Rectangle [{4.5, 5}, {5.5, 10}],
{Red, Rectangle [{2, 2}, {8, 5}]},
Text [Style ["Merry x' mas",
FontFamily → "Times", 14, Yellow], {5, 3.35}]}]
7.

1.

2.

Section 3.6.4
1.

3. distribution [x_/ ; VectorQ [x, IntegerQ]] : =

Module [{whichBin, binlabels, numberinBin, binpositions},
whichBin = Ceiling [x/5];
binlabels = Range [Min[whichbin], Max[whichBin]];
numberinBin = count[whichBin, #] &/@binlabels;
binpositionds = ((5 binlabels) –2.5)/. (elem_/ ; elem < 0) → 0;
LinstPlot [
DeleteCases [Transpose [{binpositions, numberinBin}], {_, 0}],
 PlotStyle → PointSinze [0. 025},
PlotRange → {{–1.5, 100}, {0, Max [numberinBin] + 2}},
PlotLabel → "Number of Integers in Each Interval"]]

scores = {52, 80, 59, 44, 67, 53, 59, 50, 56, 69, 70, 58, 68, 79,
70, 55, 66, 76, 73, 50, 68, 57, 59, 59, 52, 59, 45, 63, 56, 70, 47,
55, 54, 64, 78, 48, 48, 56, 74, 45, 62, 58, 54, 57, 77, 45, 91, 61,
49, 39, 46, 65, 52, 62, 50, 65, 58, 51, 59, 60, 62, 57, 46, 57, 57,
56, 51, 48, 69, 67, 61, 66, 73, 61, 53, 44, 66, 62, 47, 58, 52, 69,
59, 58, 57, 70, 81, 50, 74, 49, 56, 62, 78, 71, 56, 62, 53, 55, 51};

distribution [scores]

ClearAll [distribution, scores]

5. For an illustration, drop only five elements and use the values:
s0 = 0.2; μmin = 2.9; μmax = 3.0; Δ = 0.01; nmax = 10;
Here is the dissection:
NestList [
(# + Δ) &,
μmin,
Round [(μmax – μmin) /Δ]
]

%( #(1 – #))
Map [Function, %]
Map [NestList [#, x0, nmax] &, %]
Map [Drop [#, 5] &, %]
NestList [
(# + Δ) &,
μmin,
Round [(μmax – μmin)/Δ]
]

Transpose [{%, %%}]

Map [Thread, %]
Flatten [%, 1]
ListPlot [%]
ClearAll [x0, μmin, μmax, Δ, numx]

7. Unprotect [NonCommutativeMultiply];
A_ ** U: = A
U ** A_ : = A
A_ ** (B_ + C_) : = A ** B + A ** C
(A_ + B_) ** C : = A ** C + B ** C
number3Q[x_, y_, n_] : = NumberQ[x] && NumberQ[y] && NumberQ[n]
A_ ** (B_(x_. y_ ^n_./ ; number3Q[x, y, n])) : = ((xy^n) A ** B)
 (A_ (x_. y_^n_./ ; number3Q[x, y, n])) ** B_ : = ((xy^n) A ** B)
Protect [NonCommutativeMultiply];
commutator [A_, B_] : = A ** B – B ** A
NumberQ[ћ] ^ = True;
xp3DCommutator [expr_] : =
ExpandAll [expr //. {px ** x :→ x ** px – ћ u, py ** y : → y ** py – ћ
pz ** z : → z ** pz – ћ u, x ** y : → y ** x, x ** z : → z **x,
y ** z : → z ** y, py ** x : → x ** py, pz ** x : → x ** pz, px ** y : →
pz ** y : → y ** pz, px ** z : → z ** px, py ** z : → z ** py,
px ** py : → py ** px, px ** pz : → pz ** px, py ** pz : → pz ** py}]
lx = y ** pz – z ** Py;
ly = z ** px – x ** pz;
lz = X ** py – y ** px;
(commutator [lx, ly] – ћ lz == 0) // xp3DCommutator
(commutator [ly, lz] – ћ lx == 0) // xp3DCommutator
(commutator [lz, lx] – ћ ly == 0) // xp3DCommutator
(commutator [lz, lx ** lx + ly ** ly + lz ** lz] == 0) // xp3DCommutator
ClearAll [number 3Q, commutator, ћ, ex3DCommutator, Subscript]

9. f [{x_, y_, z _ _ _}] : = {x} ~ Join ~ f[{z}]

f [{x_}] : = {x}
f[{}] = {};
Table [RandomInteger [{–100, 100}], {RandomInteger [20]}]
f[%]
ClearAll [f]

Section 3.7.5
5. BeginPackage ["HarmonicOscillator'"]

HarmonicOscillator: : usage =
"HarmonicOscillator' is a package that provides
functions for the eigenenergies and normalized energy
eigenfunctions of the simple harmonic oscillator."

φ: : usage = "φ[n, x] gives the normalized energy

eigenfunctions of the simple harmonic oscillator."

ε: : usage = "ε[n] gives the eigenenergies of

the simple harmonic oscillator in terms of ћω."
ω: : usage = "The symbol ω stands for the oscillator frequency."
m: : usage = "The symbol m stands for the mass."
ћ: : usage=
"The symbol ћ stands for h/2π with h being Planck's counstant."
Begin ["'Private'"]
 HarmonicOscillator: :badarg=
"You called '1' with '2' argument (s) !
It must have '3' argument (s)."

φ: :quannum =
"The quantum number must be a nonnegative integer. your
quantum number '1' is not allowed."

ε: :badarg =
"The argument must be a nonnegative integer. You entered '1'."

φ[n_Integer? NonNegative, x_]: =

((2^ (–/2)) (n ! ^ (–1/2)) (((mω) / (ћπ)) ^ (1/4))
HermiteH [n, Sqrt [mω/ћ]x]Exp [– ((mω) / (2ћ))x^2]}

φ[n_, x_] : = Message [φ: :quannum, {n}]

φ [arg _ _ _ / ; Length [{arg]] ≠ 2] : =
Message [HarmonicOscillator: :badarg, φ, Length [{arg}], 2]

ε[n_Integer ? NonNegative] : = ћω (n + 1/2))

ε[arg_]: = Message [ε: :badarg, {arg}]

ε[arg_ _ _/ ; (Length [{arg}] ≠1)] : =

Message [HarmonicOscillator: :badarg, ε, Length [{arg}], 1]

End[]

Protect [φ, ε]

EndPackage[]

 Copy
 Add Highlight
 Add Note

https://www.safaribooksonline.com/library/view/a-physicists-guide/9780126831924/apc.html