Project Help Notebook by Keith Stroyan

Help NoteBook Copyright 1998 by Academic Press, Inc. - All rights reserved.
Modify this Notebook to prepare your project report.

Project 14: 
Newton's Law of Cooling 
or The Canary Resurected

by A. Student and B. Pupil

with technical help from Da LabMonitor and Help Notebook

Initialization

Needs["Graphics`Colors`"];

My Project Introduction

Write this section last.  Begin with the basic question and state your main finding clearly, but with few technical details.  Read the print project and the Beginning Explortations section in this notebook to help get started.  You should modify the title of this section to make it more interesting.  Remove this cell when you are done.  Following is a start.

This project compares the theoretical predictions of a model for the cooling of a small warm inanimate object in a large cool environment whose temperature is un-affected by the small object.  The basic model is given by the "change law"

(dT/dt) = k ((Subscript[T, a]) - T)

where  T  is ___ and  t  is time.  The constant  k  is ___ that depends on ___ .

We explain why this is a reasonable model for cooling and show that the model predicts that  T  is given as a function of time by the explicit formula

\(TextForm
    \`T[t]\  = 
      \((\ T\_0 - T\_a)\) e\^\(\(-k\)\ t\)\  + \ T\_a\)

where  (Subscript[T, 0]) is ___  and  (Subscript[T, a]) is the fixed ambient temperature, or temperature of the large surrounding environment.

The primary purpose of this project is to verify that this law is scientifically accurate.  We compare the theroetically predicted formula to cooling of a hot cup of water in a large room and ___.

Derivation of the Exponential Model

Derivation of the Law  dU = -k U dt

Read the text sections 4.1 and 4.2 and Problem 4.1.  Explain why the differential equation

(dU/dt) =  - k U

is a reasonable description of the way the temperature of a warm inanimate object changes.  Give units and say why is  U  the difference between the temperature of the object and the ambient tempreature?  See Problems 8.2 & 8.3 of the text.  Show that this is equivalent to the change law

(dT/dt) = k ((Subscript[T, a]) - T)

where T ___ and   (Subscript[T, a])____ .

The Predicted Formula

If  (Subscript[U, 0]) is the value of  U  at the beginning of measured cooling, the solution to the change law starting at  (Subscript[U, 0])

U[0]  =  (Subscript[U, 0])
(dU/dt)[t] =  - k U[t]

is given by the explicit formula  U[t] = ___.  This is because ___.  (See text Exercise 8.2.1 and Problems 8.1.)

Mathematica can solve this initial value problem as follows. (<Enter> the commands.)

\(Clear[t, k, U, U0]; 

    soln = DSolve[{\ U[0]\  == \ U0, \(U'\)[t] == \ \(-k\)\ U[t]}, U[t], t]; 
    
U[t_] = U[t] /. soln[\([1]\)]\)

If  (Subscript[T, 0]) is the value of  T  at the beginning of measured cooling, the solution to the change law starting at  (Subscript[T, 0])

T[0]  =  (Subscript[T, 0])
(dT/dt)[t]=  k( (Subscript[T, a])- T[t])

is given by the explicit formula  T[t] = ___.  This is because ___.  (See text Problems 8.2, 8.3.)

In particular, if  T[0] = 68,  T[t] = ___ .

Mathematica can solve this initial value problem as follows. (<Enter> the commands.)

\(Clear[t, k, T, T0, TA]; 

    solnT = DSolve[{\ T[0]\  == \ T0, \(T'\)[t] == \ k \((TA - \ T[t])\)}, 
        T[t], t]; 
T[t_] = T[t] /. solnT[\([1]\)]\)

Semi-Log Theory, HINT 14.1

Explain this hint in the written project.

\(TextForm
    \`\(τ[t]\  = \ Log[\(U\_0\) e\^\(\(-k\)\ t\)]\ \)\)

τ[t]  =  (Subscript[τ, 0]) -  k t

...

τ[t_]  =  Log[U[t]]

Beginning Explorations: The First Experiment

This section uses three basic approaches to the theory to try to find a good fit of theory and data.

Some students heated water and put it in a plastic cup, then measured the temperature in 5 minute intervals.  They had the cup in a warm room of temperature 26° C.

Data from a previous experiment <Enter> it.

\(temps\  = \ {94. , \ 88. , \ 84. , \ 80. , \ 76. , \ 73. , \ 70. }; 

    times\  = \ {0.0, \ 5.0, \ 10. , \ 15. , \ 20. , \ 25. , \ 30. }; 

    firstDataPlot = 
      ListPlot[Transpose[{times, temps}], AxesLabel -> {"t", "T"}, 
        PlotStyle -> Blue, Prolog -> AbsolutePointSize[4]]; \)

Since it is easier to work with the difference in temperature above ambient or  U, we

temps = temps - 26.

tTdata = Transpose[{times,temps}]

tTplot=ListPlot[tTdata,PlotRange->{40,68},AxesLabel->{"t","T"},PlotStyle->Red,Prolog->AbsolutePointSize[3]];

If we assume for the moment that the real process makes exponential decline in temperature, we can proceed in several ways to measure the cooling parameter  k.  Following are three ways.

Computation of  k  with Logs

You explained above in the explanation of HINT 14.1 why scientists take logs of data when they compare it with exponentials.  Remind us why you want to plot your experiemntal data as follows and illustrate the Mathematica list computations with a few of your own single computations.

logTemps  =  Log[temps]

Now make {time,Log[temp]} pairs, so we can make a semilog plot of temperature vs time.

logTtData  =  Transpose[{times, logTemps}]

Make the semilog plot.

dataPlot = 
      ListPlot[logTtData, PlotStyle -> Brown, PlotRange -> {0, 5}, 
        AxesLabel -> {"t", "LogTemp"}, 
        Prolog -> AbsolutePointSize[3]];

Use Mathematica to fit a line to your data.

best = Fit[logTtData, {1, t}, t]

Compare graphically.

\(fitPlot = 
      Plot[best, {t, 0, 30}, PlotStyle -> Green, 
        AxesLabel -> {"t", "LogTemp"}]; 

    fitComparison = Show[fitPlot, dataPlot]; \)

Comparison of Data with Theory for The "Fit" k & T0

Now that we have measured values of the predicted exponential constants, we compare theory and experiment.

\(k = 0.0143453; 
U0\  = \ E\^4.20695; 

    curve = Plot[U[t], {t, 0, 30}, PlotStyle -> Blue]; 

    firstComparison = Show[tTplot, curve]; \)

We can also compare the semilog versions of data and theory.

\(k = 0.0143453; 
U0\  = \ E\^4.20695; 

    logCurve = 
      Plot[τ[t], {t, 0, 30}, PlotStyle -> SteelBlue, 
        AxesLabel -> {"time", "LogTemp"}]; 

    Show[logCurve, dataPlot]; 
Show[fitComparison]; 
U0\)

The last two graphs look the same because ___ .

Observations

Do you notice anything that doesn't seem very good?  What might explain this experimentally or mathematically in approximating  k  from data?

The Ratio Measurement of  k

The approach to measuring the cooling constant  k  and comparing the data to a theoretical exponential in HINT 14.2 is __ . So we do the following list computations.

68/temps

We compute list of ratios __  because.  Following is the whole computation with Mathematica.

logRatios = Log[68/temps]

We can fit a straight line to the log ratio data in two possible ways...

\(logRatioTt = Transpose[{times, logRatios}]; 

    secondBest = Fit[logRatioTt, {1, t}, t]\)thirdBest = Fit[logRatioTt, {t}, t]

\(lines = 
      Plot[{secondBest, thirdBest}, {t, 0, 30}, 
        PlotStyle -> {Turquoise, Purple}]; 

    ratioDataPlot = ListPlot[logRatioTt, PlotStyle -> Green]; 

    Show[lines, ratioDataPlot, Prolog -> AbsolutePointSize[4]]; \)

If our temperatures are exactly exponential, then

Log[(68/U)[t]]  =  k t,  for  t = 0,  5,  10,   ... , 
     30

Hence, except when  t = 0, we can solve for  k.  Mathematica computes the list of approximate k's as follows.

klist = Log[68/temps]/times

klist = Delete[klist, 1]

ListPlot[klist,PlotJoined->True,PlotStyle->Green];

We can average the determined values to obtain another "best" approxiamtion to  k.  Mathematica adds the elements of a list as follows.

Apply[Plus,  {a,  b,  c,  d}]

Mathematica knows the length of a list with a built-in function.

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

Now we compute the average of our k-list.

average = Apply[Plus, klist]/Length[klist]

kgraf = ListPlot[klist,PlotJoined->True,PlotRange->{0.012,0.02},PlotStyle->Red];
kgraf=Show[kgraf,Graphics[{Pink,AbsoluteThickness[3],Line[{{1,average},{6,average}}]}]];

Comparison of Data with Theory for The "Fit" k &U0

\(k = average; 
U0\  = \ 68; 

    curve = Plot[U[t], {t, 0, 30}, PlotStyle -> Turquoise]; 

    secondComparison = Show[tTplot, curve, firstComparison]; \)

Observations

Do you notice anything that doesn't seem very good?  What might explain this?   Which  method of approximating the exponential parameters most closely agrees with experiment?

Computation of  k  with Differences

Explain the following computations finding an approximation to  k  by using basic concepts of calculus.

Definition of differences[ datalist ] (from the Gravity.ma NtBk)

differences[ datalist_List ] :=
	Block[ {diffs},
		diffs = {} ;
		Do[
			AppendTo[ diffs,
				(datalist[[i, 2]] - datalist[[i-1, 2]])/
				(datalist[[i, 1]] - datalist[[i-1, 1]]) ],
			{i, 2, Length[datalist]}
		] ;
		diffs
	]

Explain why we want:

rates = differences[tTdata]

We drop the first temperature so that we have lists of rates and temperatures of the same length.

temps = Drop[temps,1]

Explain why we want the ratios:

k2list = -rates/temps

average2 = Apply[Plus, k2list]/Length[k2list]

ListPlot[k2list,PlotJoined->True,PlotRange->{0,.02}];

k2graf = ListPlot[k2list,PlotJoined->True,PlotRange->{0.012,0.02},PlotStyle->Brown];

\(fit1k = 0.0143453; 

    Show[kgraf, k2graf, 
      Graphics[{Sienna, AbsoluteThickness[3], 
          Line[{{1, average2}, {6, average2}}]}], 
      Graphics[{Blue, Line[{{1, fit1k}, {6, fit1k}}]}]]; \)

Exponential and Data Comparison for this approximate  k

\(k = average2; 
U0\  = \ 68; 

    logCurve = Plot[Log[U[t]], {t, 0, 30}, PlotStyle -> SandyBrown]; 

    Show[logCurve, dataPlot]; \)

\(k = average2; 
U0\  = \ 68; 

    curve = Plot[U[t], {t, 0, 30}, PlotStyle -> Brown]; 

    thirdComparison = Show[firstComparison, curve]; \)

allThree = Show[thirdComparison, secondComparison];

Observations on the Approaches to the First Experiment

Which is best?

Accuracy

Given the accuracy of our original data, which is __, we can only claim that the best approximations to  k and  U0 are __ .

Summary of the First Experiment

The best exponential approximation to the hot cup data above is

\(TextForm
    \`T[t]\  = \ 
      T\_a + \ \((T\_0 - T\_a)\)\ e\^\(\(-k\)\ t\)\)

with  (Subscript[T, a])= ?, (Subscript[T, 0])  =  ?? , and  k = ???

\(k = 
      \(?? ;
TA = 26. ; 

        T0 = \ \(?? ;
firstFinalCurve = 
              Plot[T[t], {t, 0, 60}, 
                AxesLabel -> {"time", "Celcius Temp"}, 
                PlotStyle -> Red]; 
Show[firstDataPlot, firstFinalCurve]; 

            T[60.0]\)\)\)

Comparison of The Mathematical Model and Scientific Data

The hot cup experiment shows that

Newton's Law of cooling is a good mathematical model of real cooling.

or
Newton's Law of cooling does not predict cooling

Temporary Findings

The blue comparison seems to work best overall, but it is least accurate near zero.    Which approach is next best?

Mathematical Improvement

How could we re-estimate  k  ignoring the early data of the first experiment?

Scientific Improvement

What might have gone wrong in the First Student's experiment to make the early measurements less accurate?  How can you improve the experiment?  Add your own data to the project.

A Prediction Based on Verified Experiments

Use your best approxiamtion to the data to compute the temperature of the cup after one hour.

Use your approximation to predict the time when the cup reaches  50° C.

Your Own Experiment

If you believe there might have been a small technical error in the first student's experiment or you feel you can repeat the experiment more accurately, collect your own data and use the best procedure to compare your experiment with exponential theory.

Final Conclusions

The First Student's Data

The hot cup experiment shows that

Newton's Law of cooling is a good mathematical model of real cooling.

or
Newton's Law of cooling does not predict cooling

Your Own Data

If you improve the experiment, make your comparison.

A Non-Exponential Example

Compare and contrast your conclusions with Bugs Bunnie's Law, Problem 8.5 of the text.