Spring 2023
MATH 307: Mathematical computing
with Mathematica

Branko Ćurgus

Thursday, June 8, 2023

---

• I recorded some of my thinking about Problem 1 on Assignment 3, Goldbach's Conjecture. I created a new notebook 20230608_A3P1.nb in our shared Dropbox directory Dropbox\307_Files\2023.

  If the video on the right does not work, try this link for the zoom video.

---

Wednesday, June 7, 2023

---

• My statement of Problem 1(b-2) on Assignment 3 was not clear. In Problem 1 Part (b) we explore all distinct Goldbach partitions of even integerss greater than $2$. In fact, we are interested only in the count of distinct Goldbach partitions for each even integer; call this count the Goldbach length of an even number. For example, \begin{align*} 32 &= 3+29 = 13+19, \\ 34 &= 3 + 31 = 5 + 29 = 11 + 23 = 17 + 17, \\ 36 & = 5+31 = 7+29 = 13+23 = 17 + 19. \end{align*} Here are the first eighteen Goldbach lengths displayed as a Mathematica list:
  {{6, 1}, {8, 1}, {10, 2}, {12, 1}, {14, 2}, {16, 2},
    {18, 2}, {20,2}, {22, 3}, {24, 3}, {26, 3}, {28, 2},
    {30, 3}, {32, 2}, {34, 4}, {36, 4}, {38, 2}, {40, 3}}
  Below is a plot of the first sixty values of the Goldbach lengths. Reproduce the image below. Below is a plot of the first ten thousand values of the Goldbach lengths. Reproduce the image below. Below is a plot of the first fifty thousand values of the Goldbach lengths. Reproduce the image below. Below is a plot of the first five hundred thousand values of the Goldbach lengths. I wanted to create my own version of the picture from Wikipedia. If you can, reproduce the image below.
• In Problem 1 Part (b-4) we explore:
  • the Goldbach lengths of the even numbers which are divisible by $6$ (colored red in the plots below)
  • the Goldbach lengths of the even numbers which leave remainder $2$ when divided by $6$ (colored green in the plots below)
  • the Goldbach lengths of the even numbers which leave remainder $4$ when divided by $6$ (colored blue in the plots below)
  Below is a colored plot of the first sixty values of the Goldbach lengths. Reproduce the image below. Below is a colored plot of the first ten thousand values of the Goldbach lengths. Reproduce one of the two images below. Below is a colored plot of the first fifty thousand values of the Goldbach lengths. Reproduce one of the two images: one above, one below. Below is a colored plot of the first five hundred thousand values of the Goldbach lengths. I wanted to create a colored version of the picture from Wikipedia. If you can, reproduce the image below.
• Clearly the pictures below indicate that the even numbers which are divisible by $6$ have more Goldbach partitions than those even numbers which are not divisible by $6.$ Also, the pictures indicate that there is no significant difference between the number of Goldbach partitions of the even numbers which leave remainder $2$ when divided by $6$ and the even numbers which leave remainder $4$ when divided by $6$. How to provide statistical evidence for these claims?
  • One way is to use moving averages, see Wikipedia page for moving average. I wrote a new section about moving averages in the class file 20230602_A3P1.nb in our shared Dropbox directory Dropbox\307_Files\2023.
  The picture below shows the moving averages (of thousand values) of the values of the Goldbach length for fifty thousand even integers.
• In Problem 1 Part (c) we explore the conjecture that for every odd integer $n$ greater than $3$ there exist a nonnegative integer $a$ and a prime $p$ such that \[ n = 2 a^2 + p. \] To explore this conjecture one can use the idea which was used in Problem 1 Part (a). To get an idea how to organize While[] command to the a search, let us test the odd integer $57$. We start from $a=0$.
  • $a=0$. Is $57- 2*0^2 = 57$ a prime number. No it is not.
  • $a=1$. Is $57- 2*1^2 = 55$ a prime number. No it is not.
  • $a=2$. Is $57- 2*2^2 = 49$ a prime number. No it is not.
  • $a=3$. Is $57- 2*3^2 = 39$ a prime number. No it is not.
  • $a=4$. Is $57- 2*4^2 = 25$ a prime number. No it is not.
  • $a=5$. Is $57- 2*5^2 = 7$ a prime number. Yes it is.
  • Stop. The conjecture is true for $57$ since $57 = 2*5^2 + 7$.
  • Since all prime numbers are positive, we must have \[ 2 a^2 \lt 57. \] Thus we need to test only nonnegative integers $a$ such that \[ 0 \leq a \leq \left\lfloor \sqrt{\frac{57}{2}} \right\rfloor. \]
  • If we find an odd integer $n$ greater than $3$ for which all nonnegative integers $a$ such that \[ 0 \leq a \leq \left\lfloor \sqrt{\frac{n}{2}} \right\rfloor \] result with a composite positive integer \[ n - 2 a^2, \] then the stated conjecture is not true.
• Based on the analysis in the preceding item, one should organize a search, as in Problem 1 Part (a), and test several tens of thousands of odd integers greater than $3$.

---

Friday, June 2, 2023

---

• We discussed Problem 1 on Assignment 3, Goldbach's Conjecture. The record of our discussion of today is in the notebook 20230602_A3P1.nb in our shared Dropbox directory Dropbox\307_Files\2023.

---

Thursday, June 1, 2023

---

• We continued with Problem 2 on Assignment 3, constructing fractal curves in Mathematica. The record of our discussion of today is in the notebook of Tuesday 20230530_A3P2.nb in our shared Dropbox directory Dropbox\307_Files\2023.

  On the right, I post the videos of Tuesday (the first right, the longer video) and today (the second right, the shorter video). In these two videos I present how I construct the first few iterations of the Koch Snowflake.

---

Tuesday, May 30, 2023

---

• In the first part of Problem 2 on Assignment 3 you are asked to create a function that would produce iterations of the quadratic type 2 curve. In the first picture below I show the 0th iteration in blue and the 1st iteration in red. I emphasize the points that are used. You do not need to do this on your plots. In the second picture below I show the 1st iteration in blue and the 2nd iteration in red. The large picture is the fourth iteration of the quadratic type 2 curve.
• In the second part of Problem 2 you are ask you to create a function that would produce iterations of the Cesaro fractal which depends on angle $\alpha$. The four pictures below show the 0th, 1st, 2nd and the 3rd iteration of the Cesaro fractal with the small angle $\alpha = \pi/16$.



• Below is an animated gif file that cycles through the 1st, 2nd, 3rd, 4th, 5th and the 6th iteration of the Cesaro fractal and, within each of the iterations cycles through all the angles starting from $\pi$, proceeding towards $0$ and then back to $\pi$ in steps of $\pi/50$. The animation starts by the first iteration and cycles through angles from $\pi$ to $0$ and back to $\pi$. This is repeated for 2nd, 3rd, 4th 5th and 6th iteration. For each iteration there are 101 pictures.

Place the cursor over the image to start the animation.

---

Friday, May 26, 2023

---

• We continued with Problem 3 on Assignment 2, simulating probabilities in Mathematica. The record of our discussion of today is in the notebook 20230526_A2P3.nb in our shared Dropbox directory Dropbox\307_Files\2023. I added some narrative to the file after the class to make it clearer.

  I think it was a beautiful class today, but unfortunately I rushed into calculations and forgot to record it.
• The interesting calculation that we did today was calculating the probability that a $2\times 2$ matrix with entries from $[-1,1]$ has real eigenvalues. A matrix \[ \left[\! \begin{array}{cc} a & b \\ c & d \end{array} \!\right] \] has real eigenvalues if and only if \[ (a-d)^2 + 4 bc \geq 0. \] Thus to calculate the probability we need to calculate the four dimensional volume of the following solid \[ W = \bigl\{ (a,b,c,d) \in [-1,1]^4 \, : \, (a-d)^2 + 4 bc \geq 0 \bigr\}. \] A problem like this could be done in a multivariable class, but probably it is not done.
• We calculate the volume from the preceding item by slicing the solid $W$. We fix $(b,c) \in [-1,1]^2$ and we make a planar slice of $W.$ For a fixed $(b,c) \in [-1,1]^2$ we need to calculate the area of the slice \[ S_{(b,c)} = \bigl\{ (a,d) \in [-1,1]^2 \, : \, (a-d)^2 + 4 bc \geq 0 \bigr\}. \] In fact, this slice depends only on the product $bc=z \in [-1,1],$ so we can set \[ S_z = \bigl\{ (a,d) \in [-1,1]^2 \, : \, (a-d)^2 + 4 z \geq 0 \bigr\}. \] It is clear that the area of $S_z$ equals $4$ whenever $z \in [0,1].$ Let $z \in [-1,0).$ Then the slice $S_z$ is given in the picture below. The lines with the slope $1$ are $d = a + 2\sqrt{-z}$ and $d = a - 2\sqrt{-z}$. Therefore the shaded area in the picture above, that is the area of $S_z$ is \[ 4 \bigl(1-\sqrt{-z}\bigr)^2. \] Hence, \[ \operatorname{Area}\bigl(S_{(b,c)}\bigr) = \begin{cases} 4 \bigl(1-\sqrt{-bc}\bigr)^2 & \text{if} \ \ (b,c) \in \bigl([-1,0)\times (0,1]\bigr) \cup \bigl((0,1]\times [-1,0)\bigr), \\ 4 & \text{if} \ \ (b,c) \in \bigl([-1,0)\times [-1,0)\bigr) \cup \bigl([0,1]\times [0,1]\bigr). \end{cases} \] Below is the graph of the preceding function The volume of the region $W$ is the double integral of is the integral of the function $\operatorname{Area}\bigl(S_{(b,c)}\bigr)$ over the domain $(b,c) \in [-1,1]\times[-1,1]$; \begin{align*} \operatorname{Volume}(W) & = \int_{-1}^1 \int_{-1}^1 \operatorname{Area}\bigl(S_{(b,c)}\bigr) d b d c \\ & = 8 + 8 \int_{0}^1 \left( \int_{-1}^0 \bigl(1-2 \sqrt{-bc} - b c \bigr) d b \right) d c \\ & = 8 + \frac{8}{6} \int_{0}^1 \bigl(6-8 \sqrt{c} + 3 c \bigr) d c \\ & = 8 + \frac{8}{6} \, \frac{13}{6} \\ & = \frac{98}{9} \end{align*}
• In the preceding item we did some nice calculus work to calculate the volume of $W.$ It is good to practice what we learned, but Mathematica offers us to save our thinking power for other tasks. To calculate the areas of the slices we use two commands

  
  Clear[b, c];
  Area[ ImplicitRegion[(a - d)^2 + 4 (b c) > 0, {{a, -1, 1}, {d, -1, 1}}],
                                 Assumptions :> And[b c < 0, b c > -1]]
  
  

  
  Clear[b, c];
  Area[ ImplicitRegion[(a - d)^2 + 4 (b c) > 0, {{a, -1, 1}, {d, -1, 1}}],
                Assumptions :> And[b c > 0, b c < 1]]
  
  

  Then, with the results of these calculation, we form an If[] statement for the area function $\operatorname{Area}\bigl(S_{(b,c)}\bigr)$ and integrate it over $(b,c) \in [-1,1]\times[-1,1]$

  
  Integrate[ If[b c > 0, 4, 4 (1 - Sqrt[- b c])^2], {b, -1, 1}, {c, -1, 1}]
  
  

  to get 98/9, as what we got using our own integration abilities.
• Finally we can calculate the probability that a random $2\times 2$ matrix with the entries from $[-1,1]$ has real eigenvalues: \[ \frac{\displaystyle\frac{98}{9}}{\ 16 \ } = \frac{49}{72} \approx 0.680556. \]
• Executing the following Mathematica command provides a probabilistic conformation that the above calculation of probability is correct:

  
  N[Mean[If[(#[[1]] - #[[4]])^2 + 4*#[[2]] #[[3]] >= 0, 1, 0] &[
       RandomReal[{-1, 1}, 4]] & /@ Range[10000000]]]
  
  

---

Thursday, May 25, 2023

---

• We continued with Problem 3 on Assignment 2, simulating probabilities in Mathematica. The record of our discussion of today is in the notebook 20230525_A2P3.nb in our shared Dropbox directory Dropbox\307_Files\2023.

---

Tuesday, May 23, 2023

---

• I answered a question about cardioids from Problem 1 on Assignment 2. We continued with Problem 3 on Assignment 2, simulating probabilities in Mathematica. The record of our discussion of today is in the notebook 20230523_A2P3.nb in our shared Dropbox directory Dropbox\307_Files\2023. But, notice that at the beginning of this file there are some explorations related to Problem 2 and also about the colors in Mathematica.

• At the beginning of the class today, I also talked about the connection between COLORS and vectors.

  I wrote about the connection between COLORS and vectors in my webpage Color Cube. In this webpage and also whenever I use colors in Mathematica, I use the so called RGB color model. In this model each color is identified by a triplet of numbers. I like using RGB triplets with entries between $0$ and $1$, including $0$ and $1$.

• Answering a question about cardioids from Problem 1 on Assignment 2, combined with the presentation about COLORS in Mathematica, I created Manipulate[] with a family of circles whose envelope is the cardioid and whose colors transition from RGBColor[0,0,0] Black, to RGBColor[1,1,1] White, and the transition goes through RGBColor[0,1,1] Cyan.

  Below is the code that I used.

  
  Manipulate[Graphics[{
  
     {Thickness[0.001],
      RGBColor[
       If[s < 1,
        s {0, 1, 1}, (1 - (s - 1)) {0, 1, 1} + (s - 1) {1, 1, 1}]],
      Circle[{Cos[#], Sin[#]}, Norm[{1, 0} - {Cos[#], Sin[#]}]] & /@
       Range[0, 2 Pi, Pi/32]}
     },
    PlotRange -> {{-4, 2}, {-3, 3}},
    Frame -> True,
    AspectRatio -> Automatic
    ], {{s, 1}, 0, 2}, ControlPlacement -> Top]
  
  

---

Monday, May 22, 2023

---

• Today we discussed Problem 1 and Problem 2 on Assignment 2. Our discussion of today is contained in the files that I created for these problems previously, 20230518_A2P1.nb and 20230519_A2P2.nb in our shared Dropbox directory Dropbox\307_Files\2023.

  We talked more about finding zeros of the function ff by using FindRoot[] command. More details about this command you can find at my Mathematica page.

• Because of the extreme behaviour of the function ff, this is a challenging problem. First I tried using different methods in FindRoot[]. I tried Method -> "Newton" and Method -> "AffineCovariantNewton" without much success. I was unsuccessful in finding good initial value of x which would lead to the convergence to a specific zero that we want to calculate. However, I was very successful with Method -> "Brent". Using the same two initial values bracketing the desired zero (shifted by $2\pi$) I was able to find $50$ consecutive positive zeros of the function ff.

  Below is the code that I used.

  
  xlrints25 =
   Table[{x /.
      FindRoot[
       ff[x] == 0, {x, (3 Pi)/2 + 2 nn Pi - 1/1000, (3 Pi)/2 + 2 nn Pi},
        MaxIterations -> 1000, WorkingPrecision -> 100,
       Method -> "Brent"], (3 Pi)/2 + 2 nn Pi,
     x /. FindRoot[
       ff[x] == 0, {x, (3 Pi)/2 + 2 nn Pi, (3 Pi)/2 + 2 nn Pi + 1/1000},
        MaxIterations -> 1000, WorkingPrecision -> 100,
       Method -> "Brent"]}, {nn, 1, 25}]
  

---

Friday, May 19, 2023

---

• Today we discussed Problem 2 on Assignment 2. The notebook 20230519_A2P2.nb in our shared Dropbox directory Dropbox\307_Files\2023 contains the Mathematica record. The topic of the discussion is a very interesting function which I call ff.

  At the end of the class we talked about finding zeros of the function ff by using FindRoot[] command. More details about this command you can find at my Mathematica page.

---

Thursday, May 18, 2023

---

• The notebook 20230518_A2P1.nb in our shared Dropbox directory Dropbox\307_Files\2023 contains what we discussed today. This file relates to Problem 1 on Assignment 2. I recorded the demonstration today. I demonstrated how to get an illusion of motion using Manipulate[]. At the end of the class, I was ready to address how Cardioid fits into what we did. After class, I added the first step towards the Cardioid. This is not in the video.
• In Problem 1 on Assignment 2 you are asked to explore two famous curves cycloid and cardioid. First we discuss the cycloid.
• Wikipedia's definition of a Cycoid is: A cycloid is the curve traced by a point on the rim of a circular wheel as the wheel rolls along a straight line without slipping. One could demonstrate a cycloid in a dark room by attaching a small light to a rolling wheel and taking a long exposure photography of the motion. This is what American photographer Berenice Abbott did to create her photograph Cycloid:
  
  You can read more about Berenice Abbott and her art at MoCP and Mount Holyoke College
• In this item I will illustrate the derivation of the parametric equations for the cycloid which you need to implement in the animations in Mathematica. In the following derivation the vectors $\mathbf{i}$ and $\mathbf{j}$ are the unit coordinate vectors $\displaystyle \left[\begin{array}{c} 1 \\ 0 \end{array} \right]$ and $\displaystyle \left[\begin{array}{c} 0 \\ 1 \end{array} \right]$, respectively. In Mathematica notation the vector $\mathbf{i}$ is the pair {1,0} and the vector $\mathbf{j}$ is the pair {0,1}.
  Let $t\in [0,\pi].$ The position vector of the gray center of the circle in the above pictures is \[ t \, \mathbf{i} + \mathbf{j}. \] If the unit circle was positioned at the origin, then the position vector of the red point on the unit circle would be \[ \bigl(\cos(-t -\pi/2) \bigr) \, \mathbf{i} + \bigl(\sin(-t -\pi/2) \bigr) \mathbf{j} = - (\sin t ) \, \mathbf{i} - (\cos t ) \mathbf{j}. \] Consequently, the position vector of the red point on the unit circle in the above pictures is \[ \bigl( t - \sin t \bigr) \, \mathbf{i} + \bigl(1 - \cos t \bigr) \mathbf{j}. \] In Mathematica notation the vector $\mathbf{i}$ is the pair {1,0} and the vector $\mathbf{j}$ is the pair {0,1}. Thus, the parametric equations of the cycloid in Mathematica notation is (t - Sin[t]) {1,0} + (1 - Cos[t]) {0,1} = {t - Sin[t] , 1 - Cos[t] } The following animation might help you to understand the above derivation.

  Place the cursor over the image to start the animation.

  
• In the first part of Problem 1 I ask you to reproduce the following three animations.

  Place the cursor over the image to start the animation.

  
  

  Place the cursor over the image to start the animation.

  
  

  Place the cursor over the image to start the animation.

  

---

• In the second part of Problem 1 I ask you to explore the Cardioid.
• Here is a derivation of the equation of a cardioid.
  

  Click through several helpful images.

  The origin $O = (0,0)$ of the coordinate system is the gray point. Denote by $C$ the black point in the picture. Both circles in the picture are unit circles, the gray one centered at $O,$ the black one centered at $C.$ The angle at the gray point marked by the blue arc between the green and the blue point measures $t$ radians. That is, the length of this blue arc is $t.$ There are two other angles in the picture which also measure $t$ radians: the angle marked by the blue arc between the blue and the red point and the angle marked by the black arc between the blue point and the purple point. The green point is $(1,0),$ the blue point is $(\cos t, \sin t),$ the black point $C$ is $(2\cos t, 2\sin t),$ the purple point is $(2\cos t-1, 2\sin t).$ The goal is to determine the coordinates of the red point. Denote by $\mathbf{a}$ the unit vector whose tail is the black point and whose head is the red point. Based on the previous items we have \begin{align*} \mathbf{a} & = \bigl(\cos( \pi+2 t ) \bigr) \mathbf{i} + \bigl(\sin( \pi+2 t ) \bigr) \mathbf{j} \\ & = -\bigl(\cos(2 t ) \bigr) \mathbf{i} - \bigl(\sin(2 t ) \bigr) \mathbf{j}. \end{align*} Denote by $\mathbf{c}$ the position vector of the black point. Then the position vector of the red point is \[ \mathbf{c} + \mathbf{a} = \bigl( 2 \cos t - \cos(2 t ) \bigr) \mathbf{i} + \bigl(2 \sin t - \sin(2 t ) \bigr) \mathbf{j}. \] Thus the parametric equations for this cardioid are \begin{align*} x & = 2 \cos t - \cos(2 t ) \\ y & = 2 \sin t - \sin(2 t ) \end{align*}



• In the Cardioid part of Problem 1 on Assignment 2 you need to reproduce two pictures from Wikipidia's Cardioid page I made an animation that unifies these two pictures. You should be able to produce something like the animation below. If not, you can present one animation and one picture.

  Place the cursor over the image to start the animation.

  
• Once you have figured out how to construct a cardioid, you should be able to consturct Generalized Cardioids. In this part of Problem 1 you are asked to produce generalized cardioids as shown in the animations below. These animated gif files are large. On a slow internet connection it takes a while for them to load.
  • Below is the cardioid generated by a wheel with radius 1/2 rolling on a circle with radius 1.

    Place the cursor over the image to start the animation.

    
  • Below is the cardioid generated by a wheel with radius 1/3 rolling on a circle with radius 1.

    Place the cursor over the image to start the animation.

    
  • Below is the cardioid generated by a wheel with radius 2 rolling on a circle with radius 1.

    Place the cursor over the image to start the animation.

    
  • Below is the cardioid generated by a wheel with radius 3/2 rolling on a circle with radius 1.

    Place the cursor over the image to start the animation.

    

---

Wednesday, May 17, 2023

---

• Yesterday in class, inspired by Problem 3 on Assignment 1, I decided to try a more general problem: Five points in the plane determine a conic section uniquely. How to illustrate this fact in Mathematica? I asked ChatGPT to solve this for us. However ChatGPT's code did not work. I studied the ChatGPT's code and start seeing a solution there. Below is a "bare bones" code for this problem

  Manipulate[
   Module[{mat, conic},
    mat = Prepend[{#[[1]]^2, #[[1]] #[[2]], #[[2]]^2, #[[1]], #[[2]],
         1} & /@ {pA, pB, pC, pD, pE}, {x^2, x y, y^2, x, y, 1}];
    conic = Det[mat];
    ContourPlot[conic == 0, {x, -5, 5}, {y, -5, 5},
     PlotPoints -> {100, 100},
     ContourStyle -> {Thickness[0.006], RGBColor[0, 0, 0.5]},
     PlotRange -> {{-5, 5}, {-5, 5}}, AspectRatio -> Automatic,
     ImageSize -> 500]],
   {{pA, {0, -3}}, {-5, -5}, {5, 5},
    Locator}, {{pB, {1, -2}}, {-5, -5}, {5, 5},
    Locator}, {{pC, {-1, -2}}, {-5, -5}, {5, 5},
    Locator}, {{pD, {-2, 1}}, {-5, -5}, {5, 5},
    Locator}, {{pE, {2, 1}}, {-5, -5}, {5, 5}, Locator}]
  

• Below is an extended code that shows more information about the conic that is being created:

  Manipulate[
   Module[{mat, conic, mins},
    mat = Prepend[{#[[1]]^2, #[[1]] #[[2]], #[[2]]^2, #[[1]], #[[2]],
         1} & /@ {pA, pB, pC, pD, pE}, {x^2, x y, y^2, x, y, 1}];
    conic = Det[mat]; mins = Map[Reverse, Minors[mat], {0, 1}][[1]];
    If[And[Abs[mins[[1]]] < 0.01, Abs[mins[[2]]] < 0.01,
      Abs[mins[[3]]] < 0.01, Abs[mins[[4]]] < 0.01,
      Abs[mins[[5]]] < 0.01],
     ContourPlot[None, {x, -5, 5}, {y, -5, 5},
      Epilog -> {Text["No conic!", {0, 4}]},
      PlotRange -> {{-5, 5}, {-5, 5}}, AspectRatio -> Automatic,
      ImageSize -> 500],
     ContourPlot[conic == 0, {x, -5, 5}, {y, -5, 5},
      PlotPoints -> {100, 100},
      ContourStyle -> {Thickness[0.01], RGBColor[0, 0, 0.5]},
      Epilog -> {If[
         Abs[Det[{{mins[[1]], mins[[2]]/2}, {mins[[2]]/2,
              mins[[3]]}}]] < 0.01, Text["Parabola", {0, 4}],
         If[Det[{{mins[[1]], mins[[2]]/2}, {mins[[2]]/2, mins[[3]]}}] >
           0.01, Text["Ellipse", {0, 4}], Text["Hyperbola", {0, 4}]]],
        Text[N[Eigenvalues[{{mins[[1]], mins[[2]]/2}, {mins[[2]]/2,
             mins[[3]]}}]], {0, 4.5}]}, PlotRange -> {{-5, 5}, {-5, 5}},
       AspectRatio -> Automatic, ImageSize -> 500]]
    ],
   {{pA, {0, -3}}, {-5, -5}, {5, 5},
    Locator}, {{pB, {1, -2}}, {-5, -5}, {5, 5},
    Locator}, {{pC, {-1, -2}}, {-5, -5}, {5, 5},
    Locator}, {{pD, {-2, 1}}, {-5, -5}, {5, 5},
    Locator}, {{pE, {2, 1}}, {-5, -5}, {5, 5}, Locator}]
  

• A brief explanation for the code above is: A conic section in the $xy$-plane is determined by a quadratic polynomial equation in two variables: \[ a x^2+b x y+ c y^2+d x + e y + f = 0. \] The above expression is a linear combination of the followomg six functions: \[ x^2, \quad x y, \quad y^2, \quad x, \quad y, \quad 1. \] Given five points \[ (x_1,y_1), \quad (x_2,y_2), \quad (x_3,y_3), \quad (x_4,y_4), \quad (x_5,y_5), \] we make a linear combination of the functions \[ x^2, \quad x y, \quad y^2, \quad x, \quad y, \quad 1 \] that goes through the given five points by setting the following $6\times 6$ determinant equal to zero: \[ \left| \begin{array}{cccccc} x^2 & x y & y^2 & x & y & 1 \\ x_1^2 & x_1 y_1 & y_1^2 & x_1 & y_1 & 1 \\ x_2^2 & x_2 y_2 & y_2^2 & x_2 & y_2 & 1 \\ x_3^2 & x_3 y_3 & y_3^2 & x_3 & y_3 & 1 \\ x_4^2 & x_4 y_4 & y_4^2 & x_4 & y_4 & 1 \\ x_5^2 & x_5 y_5 & y_5^2 & x_5 & y_5 & 1 \\ \end{array} \right| = 0. \]
• The above Manipulation[] combined with Export[] from Mathematica produces an animated png file which is shown below.

---

Monday, May 15, 2023

---

• What I present today is an introduction to the construction of the cycloid and the cardioid. Today we study the unit circle and its tangents. A convenient tool in these constructions is Mathematica's concept of pure function.

  Pure Function. In the preceding exercises we often named them for further use. However, this is not always practical. Mathematica allows us to use the functions as if they were named without naming them. For example the square function is not named in Mathematica, but we can write (#^2)&[7] to get the square of 7. In some sense, we use (#^2)& as a name of the square function. Instead of naming the argument we are giving it a "place holder" # and we finish the definition with &.

  The full power of pure function is realized in combination with the command Map[]. For example Map[(#^2)&,{a,b,c}] gives {a^2,b^2,c^2}. Thus, Map[] applies the specified function to the given list. Alternative shortcut form for Map[] is /@. In the previous simple example it would be (#^2)&/@{a,b,c}. This is extremely useful when we have a complicated function and a large list with hundreds of entries.

• Next we play with the unit circle and its tangent lines. In the spirit of the above introduced concept of pure function, I define a tangent line to the unit circle as a pure function:

  Line[{
       {Cos[#], Sin[#]} + 10 {-Sin[#], Cos[#]},
           {Cos[#], Sin[#]} - 10 {-Sin[#], Cos[#]}
            }]&
  

  To understand this definition you need to think of points as vectors. {Cos[#], Sin[#]} is the position vector of a point on the unit circle. The vector {-Sin[#], Cos[#]} is orthogonal to the specifiec position vector. In fact, this definition defines not a tangent line, but a finite line segment of length 20 joining the points {Cos[#], Sin[#]} + 10 {-Sin[#], Cos[#]} and {Cos[#], Sin[#]} - 10 {-Sin[#], Cos[#]} which are outside of the picture below. The midpoint of this line segment is {Cos[#], Sin[#]}, the point where the line segment touches the circle.

  

  Since we used the pure function to make the above image, it is easy to Map[] the function to a range of values to get a more interesting picture

  Line[{
    {Cos[#], Sin[#]} + 10 {-Sin[#], Cos[#]},
      {Cos[#], Sin[#]} - 10 {-Sin[#], Cos[#]}
          }]&/@Range[0,2 Pi,(2 Pi)/5]
  

  

  Replacing (2 Pi)/5 with Pi/128 we get an interesting image

  

  Or, changing the domain for the range from 0,2 Pi with 0,(3/2) Pi we get an interesting image

  

  Or, changing the domain for the range to 0,Pi we get an interesting image

  
• In this item I present some variations on the preceding item. Extending tangents from the touching point in one direction we get Or, shortening the length of the touching line segments And some artistic images inspired by this theme

• If you think that I was just playing in the preceding items, just as an option to consider, I did not. The preceding considerations naturally extend towards the construction of the involute of the unit circle.

  Think of the circle below as an idealized roll of scotch tape. How is tape being unwrapped in a geometrically ideal way?

  

  To answer the above question, we use the idea from the preceding work. Say we unwrap a piece of the tape of length $\pi/3.$ This is the corresponding geometrically ideal picture (click on the image to start an animation of the unwrapping of one full layer of tape)

  

  The involute of the unit circle is the curve formed by the trace of the blue point in the preceding animation. In Mathematica we need to apply Line[] to the list of all points which are colored dark blue in the previous animation. For the animation hover cursor over the image.

  Mathematica's command which created the complete involute of the unit circle in the preceding image is

  {RGBColor[0, 0, 0.7], Thickness[0.003],
   Line[({Cos[#], Sin[#]} - # {-Sin[#], Cos[#]})&/@Range[0,3.28 Pi,0.02]]}
  

  The corresponding traditional vector formula for the circle involute is: \[ \bigl( \cos(t) + t \sin(t), \sin(t) - t \cos(t) \bigr) \quad \text{with} \quad t \geq 0. \]

• It is quite fascinating that the involute of the unit circle is related to the family of circles which are presented below as teal circles in the next image:

  Mathematica's command for the teal circles is

  {RGBColor[0, 0.6, 0.6], Thickness[0.001],
           Circle[{Cos[#], Sin[#]},#]& /@ Range[0,(5-1/6) Pi,Pi/48]}
  

  In the next animation I present only the circles. You can see how the circles on their own recreate the involute. In fact, the involute is the envelope of this family of circles. This means that the involute is tangent to each of the circles in this family.

  

  In the last scene of the preceding animation there are 233 circles. Below I show the image of 77 circles and even with fewer circles one can see the envelope phenomena of the involute.

  

  Below I show the image of 38 circles and even with fewer circles one can see the envelope phenomena of the involute.

  

• Another variation on the involute and the family of circles whose envelope is the involute is to present the circles and the involute as a 3d-image. We lift each circle at the level $z$ which equals the radius of the circle. In this way we form a surface in the image below:

  Show[ParametricPlot3D[{Cos[z] + z Cos[t], Sin[z] + z Sin[t], z},
    {t,0,2 Pi}, {z,0,4 Pi}, Mesh -> {0, 4*24}, MeshStyle -> {None, RGBColor[0,0.6,0.6]},
    PlotPoints -> {100, 100}, PlotStyle -> {Opacity[0.2]}],
   ParametricPlot3D[{Cos[z] + z Sin[z], Sin[z] - z Cos[z], z},
   {z,0,4 Pi}, PlotPoints -> {200}, PlotStyle -> {RGBColor[0, 0, 0.7]}],
   BoxRatios -> {1, 1, 1}, Boxed -> False, Axes -> False, ImageSize -> 800]
  

  

  The following animation illustrates the process of creating the surface described above:

  

  To verify that the calculations for the 3d-image were correct, we view the 3d-object from bird's eye view

  

---

Friday, May 12, 2023

---

• After the class today Daniel notified me that some of my writing in Problem 3 on Assignment 1 was confusing. So, I rewrote parts of Problem 3 to clarify.
• Today in class I created the file 20230512_A1P3P2.nb. In this file, I answered a question related to Problem 2 and I used the output of the Mathematica Solve[] command to create two functions to construct the circumscribed circle of a triangle given by three points: Rad[{Ax_,Ay_},{Bx_,By_},{Cx_,Cy_}] Cen[{Ax_,Ay_},{Bx_,By_},{Cx_,Cy_}] Each of these is a function of three points. That is all that we need for a circle. However, in Problem 3, we need to create a function which will produce a parabola. In this context a parabola is a graph of a quadratic polynomial. Therefore, in addition to three points, our function should be a function of an independent variable, say t, something like p3p[{Ax_,Ay_},{Bx_,By_},{Cx_,Cy_},t_] = ...
• You can use the demonstrations created in 20230512_A1P3P2.nb as a guide to answer Problem 3. However, to create a parabola as a graph of a quadratic polynomial, it is more convenient to use Plot[] instead of Graphics[] used in 20230512_A1P3P2.nb.

---

Thursday, May 11, 2023

---

• I moved the due date to the following Sunday, May 21, 2023.
• The notebook 20230511_A1P2P3.nb in our shared Dropbox directory Dropbox\307_Files\2023 contains what we discussed today. This file relates to Problem 2 and Problem 3.
• We discussed the concept of recursively defined functions which is needed for Problem 2. Please notice the big distinction between recursively defined functions and functions defined by closed form expressions. In your homework please make clear which functions are recursively defined and which are defined by closed form expression. Read more about recursively defined functions on my Mathematica page. At that page I extensively study the sequence \[ 1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, \ldots . \] I give one recursive definition for this sequence, and three closed form expressions. Mathematicians love studying objects like this, called integer sequences. In the search box on this page enter $1, 2, 2. , 3, 3, 3, 4, 4$, for much more information about this sequence.
• The problem which is alike Problem 3 is as follows: Given three noncollinear points, find the center of the circle that passes through each of the given points. As I have demonstrated in 20230511_A1P2P3.nb, Mathematica easily solves this problem symbolically. Given points $A = (A_x, A_y)$, $B = (B_x, B_y)$, $C = (C_x, C_y)$, we seek the point $S = (S_x,S_y)$ (the center of the circle) which is at the same distance, say $r$, from each of the points $A$, $B$, $C$. That is, we need to solve for $S_x, S_y, r$ the following system of equations: \begin{align*} \sqrt{(A_x - S_x)^2 + (A_y-S_y)^2} & = r \\ \sqrt{(B_x - S_x)^2 + (B_y-S_y)^2} & = r \\ \sqrt{(C_x - S_x)^2 + (C_y-S_y)^2} & = r \end{align*} Mathematica is very efficient in solving this system. It finds: \begin{align*} S_x & = \frac{B_x^2 \left(C_y-A_y\right)+C_x^2 \left(A_y-B_y\right)+\left(B_y-C_y\right) \left(A_x^2+\left(A_y-B_y\right) \left(A_y-C_y\right)\right)} {2\left(C_x \left(A_y-B_y\right)+ A_x\left(B_y-C_y\right)+ B_x \left(C_y-A_y\right)\right)} \\[10pt] S_y & = \frac{ A_x\left(B_x^2-C_x^2+B_y^2-C_y^2\right) +C_x \left(A_y^2-B_y^2\right) +B_x \left(C_x^2-A_y^2+C_y^2\right) +\left(C_x-B_x\right) A_x^2 -B_x^2 C_x}{2\left(C_x \left(A_y-B_y\right) +A_x\left(B_y-C_y\right) +B_x\left(C_y-A_y\right)\right)} \\[10pt] r & =\frac{1}{2} \sqrt{ \frac{\left(\left(A_x-B_x\right)^2+\left(A_y-B_y\right)^2\right) \left(\left(A_x-C_x\right)^2+\left(A_y-C_y\right)^2\right) \left(\left(B_x-C_x\right)^2+\left(B_y-C_y\right)^2\right)} {\left(C_x \left(B_y-A_y\right)+B_x \left(A_y-C_y\right)+A_x \left(C_y-B_y\right)\right)^2}} \end{align*} With a little bit of human help these expressions can be brought to a more symmetric form: \begin{align*} S_x & =\phantom{-} \frac{\left(A_y-B_y\right) \left(A_y-C_y\right) \left(B_y-C_y\right) + A_x^2 \left(B_y-C_y\right)+C_x^2 \left(A_y-B_y\right)+B_x^2 \left(C_y-A_y\right)}{2 \bigl(\left(A_x-B_x\right)\left(B_y-C_y\right) -\left(B_x-C_x\right)\left(A_y-B_y\right)\bigr)} \\[10pt] S_y & = -\frac{\left(A_x-B_x\right) \left(A_x-C_x\right) \left(B_x-C_x\right)+A_y^2\left(B_x-C_x\right) + B_y^2 \left(C_x-A_x\right) + C_y^2 \left(A_x-B_x\right) }{2 \bigl(\left(A_x-B_x\right) \left(B_y-C_y\right)-\left(B_x-C_x\right) \left(A_y-B_y\right)\bigr)} \\[10pt] r & = \frac{\sqrt{ \left(\left(A_x-B_x\right)^2+\left(A_y-B_y\right)^2\right) \left(\left(A_x-C_x\right)^2+\left(A_y-C_y\right)^2\right) \left(\left(B_x-C_x\right)^2+\left(B_y-C_y\right)^2\right)}} {2\bigl| \left(A_x-B_x\right) \left(B_y-C_y\right)-\left(B_x-C_x\right) \left(A_y-B_y\right) \bigr|} \end{align*} This circle is known as the circumscribed circle of the triangle $ABC$.

---

Monday, May 8, 2023

---

• Inspired by the parametrization of the unit circle by the trigonometric functions Cos[t] and Sin[t], today in class I started a derivation of a parametrization of a regular pentagon inscribed in the unit circle. The same reasoning can be used to parameterize any regular $n$-gon, where $n$ is a positive integer greater than $2.$ The handwritten note below shows this derivation.
• The derivation from the preceding item, implemented in Mathematica is as follows:

  
  Clear[n, t, NgonCos, NgonSin];
  NgonCos[t_, n_] :=
   Cos[\[Pi]/n] Sec[\[Pi]/n - Mod[t, (2 \[Pi])/n]] Cos[t];
  NgonSin[t_, n_] :=
   Cos[\[Pi]/n] Sec[\[Pi]/n - Mod[t, (2 \[Pi])/n]] Sin[t]
  
  

• The final product of this work are the graphs of the first nine regular $n$-gons inscribed in the unit circel: the equilateral triangle, the square, and the pentagon, the hexagon, the heptagon, the octagon, the nonagon, the decagon, the hendecagon, the dodecagon, see the Wikipedia page.


---

• It is always good to explore several approaches to mathematical problems. Below I provide another way to parameterize a regular $n$-gon. Here $n$ is a positive integer greater than $2.$ The handwritten note below shows this derivation.
• The formulas derived in the preceding item, implemented in Mathematica are as follows:

  
  Clear[nNgCos, nNgSin, tt, nn];
  nNgCos[tt_, nn_] := (1 - Mod[tt, 1]) Cos[(2 \[Pi] Floor[tt])/nn] +
    Mod[tt, 1] Cos[(2 \[Pi] (1 + Floor[tt]))/nn] ;
  nNgSin[tt_, nn_] := (1 - Mod[tt, 1]) Sin[(2 \[Pi] Floor[tt])/nn] +
    Mod[tt, 1] Sin[(2 \[Pi] (1 + Floor[tt]))/nn]
  
  

• The final product of this work are the graphs of the first nine regular $n$-gons inscribed in the unit circel: the equilateral triangle, the square, and the pentagon, the hexagon, the heptagon, the octagon, the nonagon, the decagon, the hendecagon, the dodecagon, see the Wikipedia page.

---

Sunday, May 7, 2023

---

• For better or worse, I am fascinated by the concept of "funny" trigonometric functions. It is for the better.

  Fascination is a gift.
  Let yourself be fascinated. 

  So, I often look for new "funny" trigonometric functions. One idea that I explored was to combine the regular sine function and the trapezoidal sine function from Problem 1 on Assignment 1. What I mean by this is shown in the picture below. The yellow highlighted parts of the graph are from the trapezoidal sine function, and the cyan highlighted parts are from the standard sine function.

  
• To plot the above function I used the Mathematica command Piecewise[], as follows

  
   Piecewise[{
     {Mod[x, 8 + 2 Pi],
      And[Mod[x, 8 + 2 Pi] >= 0, Mod[x, 8 + 2 Pi] < 1]},
     {1 + Sin[Mod[x, 8 + 2 Pi] - 1],
      And[Mod[x, 8 + 2 Pi] >= 1, Mod[x, 8 + 2 Pi] < 1 + Pi/2]},
     {2, And[Mod[x, 8 + 2 Pi] >= 1 + Pi/2, Mod[x, 8 + 2 Pi] < 3 + Pi/2]},
     {1 + Sin[Mod[x, 8 + 2 Pi] - 3],
      And[Mod[x, 8 + 2 Pi] >= 3 + Pi/2, Mod[x, 8 + 2 Pi] < 3 + Pi]},
     {(4 + Pi) - Mod[x, 8 + 2 Pi],
      And[Mod[x, 8 + 2 Pi] >= 3 + Pi, Mod[x, 8 + 2 Pi] < 5 + Pi]},
     {-1 + Sin[Mod[x, 8 + 2 Pi] - 5],
      And[Mod[x, 8 + 2 Pi] >= 5 + Pi, Mod[x, 8 + 2 Pi] < 5 + (3 Pi)/2]},
     {-2, And[Mod[x, 8 + 2 Pi] >= 5 + (3 Pi)/2,
       Mod[x, 8 + 2 Pi] < 7 + (3 Pi)/2]},
     {-1 + Sin[Mod[x, 8 + 2 Pi] - 7],
      And[Mod[x, 8 + 2 Pi] >= 7 + (3 Pi)/2,
       Mod[x, 8 + 2 Pi] < 7 + 2 Pi]},
     {Mod[x, 8 + 2 Pi] - (8 + 2 Pi),
      And[Mod[x, 8 + 2 Pi] >= 7 + 2 Pi, Mod[x, 8 + 2 Pi] < 8 + 2 Pi]}
     }]
  

• What I soon discovered is that Piecewise[] when used in plotting complicated objects is very slow, almost unusable. There are two solutions for this problem
  • Find a way to define the desired function without using Piecewise[], that is by using some other already defined Mathematica functions. This is a preferred option.
  • Create a compiled version of the desired function by using the Mathematica command Compile[].
  Since I was not able to find a simpler form for the desired function, I used Compile[] as follows

  
   Clear[LoSin, LoCos]; LoSin = Compile[{{x, _Real}}, Piecewise[
     {
      {Mod[x, 4 + Pi], And[Mod[x, 4 + Pi] >= 0, Mod[x, 4 + Pi] < 1/2]},
      {1/2 + 1/2 Sin[2 (Mod[x, 4 + Pi] - 1/2)],
       And[Mod[x, 4 + Pi] >= 1/2, Mod[x, 4 + Pi] < 1/2 + Pi/4]},
      {1, And[Mod[x, 4 + Pi] >= 1/2 + Pi/4,
        Mod[x, 4 + Pi] < 3/2 + Pi/4]},
      {1/2 + 1/2 Sin[2 (Mod[x, 4 + Pi] - 3/2)],
       And[Mod[x, 4 + Pi] >= 3/2 + Pi/4, Mod[x, 4 + Pi] < 3/2 + Pi/2]},
      {(4 + Pi)/2 - Mod[x, 4 + Pi],
       And[Mod[x, 4 + Pi] >= 3/2 + Pi/2, Mod[x, 4 + Pi] < 5/2 + Pi/2]},
      {-(1/2) + 1/2 Sin[2 (Mod[x, 4 + Pi] - 5/2)],
       And[Mod[x, 4 + Pi] >= 5/2 + Pi/2,
        Mod[x, 4 + Pi] < 5/2 + (3 Pi)/4]},
      {-1, And[Mod[x, 4 + Pi] >= 5/2 + (3 Pi)/4,
        Mod[x, 4 + Pi] < 7/2 + (3 Pi)/4]},
      {-(1/2) + 1/2 Sin[2 (Mod[x, 4 + Pi] - 7/2)],
       And[Mod[x, 4 + Pi] >= 7/2 + (3 Pi)/4, Mod[x, 4 + Pi] < 7/2 + Pi]},
      {Mod[x, 4 + Pi] - (4 + Pi),
       And[Mod[x, 4 + Pi] >= 7/2 + Pi, Mod[x, 4 + Pi] < 4 + Pi]}
      }]];
  LoCos = Compile[{{x, _Real}}, LoSin[x + 1 + Pi/4]];
  
  

• The function that I showed at the beginning of the post is in fact not a "funny" sine function since its range is $[-2,2].$ Therefore, for the definitions of the funny trigonometric functions LoSin[] and LoCos[], I scaled both dependent and independent variables of the function given at the beginning. Below are the graphs of the newly defined "funny" trigonometric functions.
• As for all "funny" trigonometric functions we explore the funny unit circle the funny sphere the funny torus when we deal with tori whose cross-section is not a circle it is interesting to rotate the cross-section as it makes its turn to form a torus and the funny vase

---

Thursday, May 4, 2023

---

• I posted Assignment 1 today. You can find the assignment as notebook 202320_A1.nb in our shared Dropbox directory \307_Files\Assignments\. The essential notebook for Problem 1 is the notebook TheBeautyOfTrigonometry.nb. You can find this notebook in our shared Dropbox directory \307_Files\2023\. In this notebook I explore trigonometric functions Cos[t] and Sin[t] and how they are used in different settings in Mathematics. The most important feature of the functions Cos[t] and Sin[t] is that they provide a parametrization of the unit circle. The animation below illustrates how this parametrization is obtained.
• The main components of the animation are as follows
  • The black circle is the unit circle.
  • The values of t $\in [0,2\pi]$ are represented by orange lengths. In each scene there are three orange lengths: the horizontal length, the vertical length and the arc length on the unit circle.
  • The values of Cos[t] are green horizontal line segments.
  • The values of Sin[t] are blue vertical line segments.

Place the cursor over the image to start the animation.


• The principle presented above is the general principle of parametric equations of curves in the plane. Given two functions (one green and one blue) of the same independent variable t, taken as the coordinates of a moving point, then, as the independent variable t changes, the point does trace a curve in the plane.

---

Monday, March 27, 2023

---

• The Mathematica part of the class will start on Monday, May 1, 2023 in BH 215 at 2:00 pm.
• The information sheet
• We will use
• To get started with Mathematica see my Mathematica page. Please watch the videos that are on my Mathematica page before the first class. Watching the movies is essential for being able to organize your homework notebooks well! I will not discuss the basics of notebook structuring in class.

---