Maxi-Project
for
Calculus and Mathematica
Workshop

Name:  Don Anglen

Title:  Equal Areas of Irregular Shapes

Description:  This lesson graphs areas between curves.  It finds areas between curves, also.  The Mathematica  language is discussed as well.

Areas Under A Curve

We are going to shade in some areas, so we will enter the Mathematica "Package" "Needs Graphics`FilledPlot`".

Needs["Graphics`FilledPlot`"]

This project is an extension of the mini-project:
   "Area Under a Curve".

We are going to graph a parabola and a horizontal line and have these two shaded areas equal.

Clear[f, g, h, x]; f[x_] = -3 (x^2) + 7 x; g[h_] = 3; h = 3; FilledPlot[{f[x], g[x]}, {x, 0, 1.75}, 
      PlotRange -> {-1, 5}];

We will find the equation of the horizontal linethat makes these two areas equal.  The curve does not have to be a parabola, but we will use one:
   A parabola:  y = a (x^2) + bx + c; and a horizontal line y = h.  We will use the parabola y
    = -3 (x^2) + 7x and find the value of h.

First, let's look at the parabola and a line y = 3.

Great!

Clear[f, g, h, x]; f[x_] = -3 (x^2) + 7 x; g[x_] = h; h = 3; Plot[{f[x], g[h]}, {x, -2, 3}, PlotRange -> {-1, 5}, 
      AspectRatio -> Automatic];

The Plot funtion graphs the curve, the PlotRange Function gives the range, and the step "AspectRatio->Automatic" makes the units on the axes uniform.

Solve for the points of intersection of the curve and the line.

Solve[f[x] == g[x], x]

NSolve[f[x] == g[x], x]

Fine.

Solve for x in the f(x) function to find the x intercepts.

Solve[-3 (x^2) + 7 x == 0]

These two areas are not equal because we just chose h = 3.

Solve for the points of intersection of the parabola y = -3 (x^2) + 7x   and the horizontal line y = h in terms of "h".

Clear[f, g, h, x]; f[x_] = -3 (x^2) + 7 x; g[x_] = h; Solve[f[x] == g[x], x]

Great! Let's call them a and b.

a = (1/6) (7 - (Sqrt[49 - 12 h])); b = (1/6) (7 + (Sqrt[49 - 12 h]));

Integrate these two areas "and" set their areas equal.

Clear[h]a = (1/6) (7 - (Sqrt[49 - 12 h])); b = (1/6) (7 + (Sqrt[49 - 12 h])); Solve[
      (∫_a^b)(f[x] - g[h]) \[DifferentialD]x == 
        (∫_0^a)(g[h] - f[x]) \[DifferentialD]x, h]

Wow!  h=49/16

Find a and b if h = 49/16.

(1/6) (7 - (Sqrt[49 - ((12 49)/16)]))(1/6) (7 + (Sqrt[49 - ((12 49)/16)]))

Wow, wow!!

a = 7/12, b = 7/4.

Now use 49/16 for h to look at the areas.

Clear[f, g, h, x]; f[x_] = -3 (x^2) + 7 x; g[h_] = (49/16); h = (49/16); FilledPlot[{f[x], g[x]}, {x, 0, 1.75}, 
      PlotRange -> {-1, 5}];

We can find these areas to see if 49/16 is correct.

Find the area between the curve and the line.

Clear[a, b, f, g, h, x]; f[x_] = -3 (x^2) + 7 x; g[h_] = (49/16); h = (49/16); a = (7/12); b = (7/4); (∫_a^b)(f[x] - g[h]) \[DifferentialD]x

Find the area between the line the curve and the y-axis.

Clear[a, b, f, g, h, x]; f[x_] = -3 (x^2) + 7 x; g[h_] = (49/16); h = (49/16); a = (7/12); b = (7/4); (∫_0^a)(g[h] - f[x]) \[DifferentialD]x

Voila!!!

The areas are equal.

Try other  values of "a", "b", and "c" in a parabola y = ax¤ + bx + c and then find "h". Or maybe be given "h", "b", and "c" and find "a".

Clear[a, b, c, f, g, h, x]; f[x_] = a (x^3) + b (x^2) + c x; g[h_] = h; a = -3; b = 0; c = 2; Plot[{f[x], g[h]}, {x, 0, 1}, PlotRange -> {-5, 5}, 
      AspectRatio -> Automatic]; Clear[a, b, c, f, g, h, x]; f[x_] = a (x^3) + b (x^2) + c x; a = -3; b = 0; c = 2; Solve[{a (x^3) + b (x^2) + c x == 0}, x]{{x -> 0}, {x -> -(Sqrt[(2/3)])}, {x -> (Sqrt[(2/3)])}}

Clear[a, b, c, f, g, h, x]; f[x_] = a (x^3) + b (x^2) + c x; a = -3; b = 0; c = 2; NSolve[{a (x^3) + b (x^2) + c x == 0}, x]

x intercepts  j=0 and k =.816497

Clear[f, g, h, x]; f[x_] = -3 (x^3) + 2 x; g[x_] = h; Solve[f[x] == g[x], x]

d = (2*2^(1/3))/
 
      (-243*h + (-23328 + 59049*h^2)^(1/2))^(1/3) + 
 
     (-243*h + (-23328 + 59049*h^2)^(1/2))^(1/3)/
     
     (9*2^(1/3))\
 
   
 
 e = -((2^(1/3)*(1 - I*3^(1/2)))/
 
        (-243*h + (-23328 + 59049*h^2)^(1/2))^(1/3)) - 
 
     ((1 + I*3^(1/2))*(-243*h + (-23328 + 
     
     59049*h^2)^(1/2))^(1/3))/(18*2^(1/3))

Clear[h]d = 
      ((2 (2^(1/3)))/(((-243 h + (Sqrt[-23328 + 59049 (h^2)]))
              )^(1/3))) + 
        ((((-243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3))/(9 
            (2^(1/3))))e = 
      -(((2^(1/3)) 
                (1 - I (Sqrt[3])))/(((
                  -243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3
                  ))) - 
        (((1 + I (Sqrt[3])) 
            (((-243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3
                )))/(18 (2^(1/3))))Solve[
      (∫_d^e)(f[x] - g[h]) \[DifferentialD]x == 
        (∫_0^d)(g[h] - f[x]) \[DifferentialD]x, h]

Clear[h]d = 
      ((2 (2^(1/3)))/(((-243 h + (Sqrt[-23328 + 59049 (h^2)]))
              )^(1/3))) + 
        ((((-243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3))/(9 
            (2^(1/3))))e = 
      -(((2^(1/3)) 
                (1 - I (Sqrt[3])))/(((
                  -243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3
                  ))) - 
        (((1 + I (Sqrt[3])) 
            (((-243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3
                )))/(18 (2^(1/3))))Solve[
      (∫_d^e)(f[x] - g[h]) \[DifferentialD]x == 
        (∫_0^d)(g[h] - f[x]) \[DifferentialD]x, h]

Clear[h]d = 
      ((2 (2^(1/3)))/(((-243 h + (Sqrt[-23328 + 59049 (h^2)]))
              )^(1/3))) + 
        ((((-243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3))/(9 
            (2^(1/3))))e = 
      -(((2^(1/3)) 
                (1 - I (Sqrt[3])))/(((
                  -243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3
                  ))) - 
        (((1 + I (Sqrt[3])) 
            (((-243 h + (Sqrt[-23328 + 59049 (h^2)])))^(1/3
                )))/(18 (2^(1/3))))FindRoot[
      (∫_d^e)(f[x] - g[h]) \[DifferentialD]x == 
        (∫_0^d)(g[h] - f[x]) \[DifferentialD]x, {
        h,  .395,  .390,  .400}]