Calculus Lab #4:  Functions & Concavity

Goals:	1.  Introduce functional modeling (and regression analysis)
	2.  Practice fitting models
	3.  Learn the concept of concavity
	4.  Evaluate the concavity of a function via the 2nd derivative test

1.  Functional Modeling (simple cases)

We're going to take a slight detour for the first half of this lab to discuss a topic that won't be covered in-depth until you take MATH 301 (Probability & Statistics II, taught by this really great instructor).

We often want to model real-world situations through functions.  Consider this simple example:

You've decided to open a calculus tutoring business on campus.  Your start-up costs (for office space, supplies, and advertising) were $200.  For every client you take on, you figure it will cost you $20.

What function can we use to model your costs?
What should the function look like?
What is the domain of this function?

"SOLUTIONS"
"It should be linear for all x>0"
Clear[x]
f[x_] = 200 + 20  x
Plot[f[x], {x, 0, 100}]

That function was fairly simple to model.  Often times we won't have such a clear cut story to follow.  Suppose we're interested in modeling the relationship between an individual's height and arm span.  We gather data from 28 subjects and find the following values: (input this syntax)

\(\(\(Off[General::spell1]\)\(
\)
    \)\)
\(\(xvalues\  = \ {60, \ 65, \ 68, \ 72, \ 61, \ 63, \ 70, \ 75, \ 71, \ 
          62, \ 65, \ 66, \ 62, \ 72, \ 70, \ 69, \ 69, \ 60, \ 63, \ 64, \ 
          71, \ 68, \ 69, \ 70, \ 65, \ 64, \ 71, \ 67};\)
\)
\(\(yvalues\  = \ {61, \ 65, \ 67, \ 73, \ 62, \ 63, \ 71, \ 74, \ 72, \ 
          60, \ 65, \ 68, \ 62, \ 73, \ 70, \ 68, \ 70, \ 61, \ 63, \ 64, \ 
          71, \ 67, \ 70, \ 72, \ 65, \ 63, \ 70, \ 67};\)
\)
TableForm[{xvalues, yvalues},  
      TableHeadings -> {{"Duration, x ", "Interval, y "},  None}, 
      TableSpacing -> {2, 1}]
Show[{ListPlot[
            Table[{Part[xvalues, i], Part[yvalues, i]},  {i, 
                Length[xvalues]}],  DisplayFunction -> Identity]},  
        DisplayFunction -> $DisplayFunction,  
        Frame -> 
          True,   FrameLabel -> {StyleForm["Height (in inches)",  
              FontSize -> 10],  
            StyleForm["Arm span (inches)",  
              FontSize -> 10]},   GridLines -> Automatic,  
        PlotLabel -> StyleForm["Scatterplot",  FontSize -> 12],  
        PlotRange -> {{50, 80},  {58, 78}},  
        Prolog -> AbsolutePointSize[5]];

The scatterplot shows this relationship.  What type of function looks like it would fit this data the best?

We would have to use regression analyses to find the equation for the best-fitting function.

2.  Functional Modeling (a bit more difficult)

Fitting models to data is an art that requires experience (more experience than I have) and a few assumptions.  Suppose we have the following situation:

A boy throws a ball 20 feet high to his dog who catches the ball in his teeth 30 feet away.  Find a function which describes the path of the ball.

Obviously, the ball will follow a parabolic path -- it will go up for awhile and then come down.  What type of function can we use to model this behavior?
What is the domain of this function

f[x_] = -((x^2));

    Plot[f[x], {x, 0,  30}]

We know this model isn't perfect (right now, it says the ball is at a negative height throughout the domain).  Let's make a few assumptions:
	1.  The ball is thrown at time t=0
	2.  The ball is released at a height of 5 feet (reasonable for a boy)
	3.  The ball is caught at a height of 3 feet (reasonable for a dog)
	
What adjustments can we make to our graph?
1.  First, let's shift the vertex of the graph halfway between the boy and the dog.  How can we shift the graph 15 units to the right?

f2[x_] = -(((x - 15))^2);
Plot[f2[x], {x, 0, 30}]

2.  Now let's make the maximum height 20 feet instead of zero feet.  How can we do this?

f3[x_] = -(((x - 15))^2) + 20;
Plot[f3[x], {x, 0, 30}]

3.  This parabola is decreasing much too rapidly, leading to negative values.  The parabola decreases roughly 220 feet, where we only want to decrease about 15 feet.  We can fix this by scaling the decreasing term by (15/220)

f4[x_] = 
        20 - (15/220) (((x - 15))^2); 
Plot[f4[x], {x, 0, 30}]

4.  This is pretty good, except it's 5 feet high at both ends, instead of 5 feet high at the beginning and 3 feet high at the end.  To arrange that, we would have to move the vertex and make further adjustments.

Based on our previous function, we now have a template

y = 20 - a (x - h)^2.

If we can solve for a and h, we'll be able to find the exact model for this situation.

We know this function passes through the points (0,5) and (30,3).  If we substitute those values into the function, we get the following pair of equations:

(0,5):     5 = 20 - a (0 - h)^2.
(30,3):   3=20-a(30 - h)^2.

All we need to do now is solve the two equations for a and h. This is messy algebra which I’m sure you can do just fine (cough), but let’s use Mathematica  so we don’t get bogged down.

answer = 
      Solve[{5 == 20 - a (((0 - h))^2), 
          3 == 20 - a (((30 - h))^2)}]

{{a -> (1/450) (16 - (Sqrt[255])), 
        h -> 15 (-15 - (Sqrt[255]))},  {a -> 
          (1/450) (16 + (Sqrt[255])), 
        h -> 15 (-15 + (Sqrt[255]))}}

Were you expecting nice answers? Sorry about that! Let’s make them decimals.

answer=N[answer]

The second solution is the one we want, since h is close to 15 and a is close to (15/220), our previous answer for a.

Let’s substitute these values from the first solution into our template function.

ffinal[x_] = 20 - (0.0710416*(x - 14.5308)^2)

Does this function do the job? Let’s see:

ffinal[0]
ffinal[30]
Plot[ffinal[x], {x, 0, 30}];

3.  Read RPG Hand-out

Try another function that could model this situation:

	f(x)=((e^(1.7  x))/(1 + (e^(1.7  x))))

Plot this function and compare it to the arctan function.  Would this function (which is called a logistic function) work for RPG battles?

4.  Concavity

Last class, we learned how to create wiggle graphs, using the first derivative test to locate:
	1.  Intervals over which a function is increasing
	2.  Intervals over which a function is decreasing
	3.  Relative extrema
We're now going to take this process one step further.  We want to locate:
	1.  Intervals over which a function is concave up
	2.  Intervals over which a function is concave down
	
What is meant by concave up and concave down?
Determine if the following functions are concave up, concave down, both, or neither:

Plot[(x^2) - 1, {x, -3, 3}]
Plot[- .5 (x^6), {x, -1, 1}]
Plot[(1/3) (x^3) - x, {x, -2, 2}]
Plot[x - 1, {x, -2, 2}]

A function is concave up if it's slope is increasing over an interval.  In other words, if the first derivative of a function is increasing, the function is concave up.

Remember that a derivative measures the rate of change of a function.  So if we take the derivative of the first derivative, we can determine if the slope is increasing.

In other words, taking the second derivative of a function tells us about that function's concavity.
1.  If the second derivative is positive over an interval, the function is concave up.
2.  If the 2nd derivative is negative over an interval, the function is concave down.
3.  If the 2nd derivative equals zero, the function is changing from concave up to concave down (an inflection point).

For the following functions, find:
1.  The extrema
2.  The intervals over which the function is increasing
3.  The intervals over which the function is decreasing
4.  The inflection points of the function
5.  The intervals over which the function is concave up
6.  The intervals over which the function is concave down.

1.  f(x) = (6/((x^2) + 3))

2.  f(x) = (((x^2) + 1)/((x^2) - 4))

3.  f(x) = (x^4) - 4  (x^3)

4.  f(x) = -3 (x^5) + 5  (x^3)

f[x_] = (6/((x^2) + 3)); 
Plot[f[x], {x, -2, 2}]
"f'(x) = "
FullSimplify[f'[x]]
"Critical values"
Solve[f'[x] == 0, x]
"f''(x) = "
FullSimplify[f''[x]]
"Inflection Points"
Solve[f''[x] == 0, x]

SOLUTIONS

f[x_] = (6/((x^2) + 3));
Plot[f[x], {x, -2, 2}]
"f'(x) = "
FullSimplify[f'[x]]
"Critical values"
Solve[f'[x] == 0, x] 
"f''(x) = "
FullSimplify[f''[x]]
"Inflection Points"
Solve[f''[x] == 0, x]

f[x_] = (((x^2) + 1)/((x^2) - 4));
Plot[f[x], {x, -6, 6}] 
"f'(x) = "
FullSimplify[f'[x]]
"Critical values"
Solve[f'[x] == 0, x]
"f''(x) = "
FullSimplify[f''[x]]
"Inflection Points"
Solve[f''[x] == 0, x]

f[x_]=(x^4) - 4  (x^3);
Plot[
      f[x], {x, -3, 3}]
"f'(x) = "
FullSimplify[f'[
        x]]
"Critical values"
Solve[f'[
          x] == 0, x]
"f''(x) = "
FullSimplify[f''[
        x]]
"Inflection Points"
Solve[f''[
          x] == 0, x]

f[x_]=-3 (x^5) + 5  (x^3);
Plot[
      f[x], {x, -2, 2}]
"f'(x) = "
FullSimplify[f'[
        x]]
"Critical values"
Solve[f'[
          x] == 0, x]
"f''(x) = "
FullSimplify[f''[
        x]]
"Inflection Points"
Solve[f''[
          x] == 0, x]

5.  Questions to turn in

1.  Read the RPG hand-out and complete the question in section 3 of this lab.
2.  Do all the problems in section 4 of the lab.

6.  Reflection

At the end of each Mathematica session, I want you to write a sentence or two describing what you learned (or just list important concepts from this lab).  You can later use these reflections as a reference for other Mathematica Labs.

Print out your answers to the lab questions and turn them in for credit.