Math 1483 - Quiz 2

<=/Solutions\=>

Remember, ALT+7 gives a new text cell, be sure to explain your answers, if needed!

Problem 1

Your task for this problem will involve visualizing weather data

Part 1

Examine the weather data for Durant, OK over the month of August,  2021 as measured by the Accuweather site:

https://www.accuweather.com/en/us/durant/74701/august-weather/335176?year=2021

Store the data in two separate data sets:
(1) The first data set being ordered pairs consisting of the day of the month and the day’s high temperature.
(2) The second data set being ordered pairs consisting of the day of the month and the day’s low temperature.
Give each data set an appropriate name.

The low temps will be stored in the variable LowTempsAug, similarly for high tems -- HighTempsAug

LowTempsAug = {{1,77},{2,73},{3,70},{4,70},{5,70},{6,68},{7,70},{8,77},{9,79},{10,77},{11,75},{12,75},{13,73},{14,70},{15,72},{16,72},{17,72},{18,72},{19,73},{20,77},{21,77},{22,75},{23,72},{24,70},{25,72},{26,75},{27,73},{28,72},{29,70},{30,73},{31,73}};
HighTempsAug = {{1,95},{2,91},{3,92},{4,95},{5,93},{6,95},{7,97},{8,97},{9,99},{10,97},{11,99},{12,100},{13,100},{14,79},{15,97},{16,90},{17,88},{18,81},{19,90},{20,95},{21,97},{22,99},{23,99},{24,97},{25,100},{26,99},{27,95},{28,91},{29,93},{30,99},{31,100}};

Part 2

Create a plot of each of the data sets.  Your plot should include the following:
(1) Make sure the symbols for each set is distinct.
(2) Colour the high temp data set red.
(3) Colour the low temp data set blue.
(4) Add legends for each data set.
(5) Add the appropriate labels to both axes.
(6) Connect the points in each data set by lines. (Hint: This is an option in the ListPlot command)

HiLoTempPlot = ListPlot[{LowTempsAug ,HighTempsAug}, PlotLegends->{"Low Temps","High Temps"}, PlotStyle->{Blue, Red}, PlotMarkers->{{"▽",16},{"✶",12}}, AxesLabel->{"Day of August", "Temp (F)"}, Joined->{True, True}]

Part 3

Compute the average and median for the daily low temp data set.

We use the Mean and Median commands here.  The mean is 73.03, and the median is 73.

N[Mean[LowTempsAug[[All,2]]]]

N[Median[LowTempsAug[[All,2]]]]

Part 4

Compute the average and median for the daily high temp data set.

Same idea here, mean is 94.81, median is 97.

N[Mean[HighTempsAug[[All,2]]]]

N[Median[HighTempsAug[[All,2]]]]

Part 5

Construct a data set which is the difference between the daily high temp and daily low temp

DiffSet = Table[{HighTempsAug[[i]][[1]],HighTempsAug[[i]][[2]]-LowTempsAug[[i]][[2]]},{i,1,Length[HighTempsAug]}]

Part 6

Plot the difference data set along with the two data sets from Part 2, be sure to use a different colour for the new data set, and add a plot legend for it.

ListPlot[{LowTempsAug ,HighTempsAug,DiffSet}, PlotLegends->{"Low Temps","High Temps","Difference in Temp"}, PlotStyle->{Blue, Red, Cyan}, PlotMarkers->{{"▽",16},{"✶",12},{"◻",16}}, AxesLabel->{"Day of August", "Temp (F)"}, Joined->{True, True, True}]

Part 7

On what days in August were there the largest and smallest changes in daily temperature?

We can use the Max command, and the Position command to locate where the max value occurs.  Similarly, we can use the Min command.  The greatest change in temperature was 28 F, and it happened on August 25th, and the least change in daily temperature was 9 F on August 14th and 18th.

Max[DiffSet[[All,2]]]

Position[DiffSet[[All,2]],28]

{DiffSet[[28]]}

Min[DiffSet[[All,2]]]

Position[DiffSet[[All,2]],%]

{DiffSet[[14]], DiffSet[[18]]}

Problem 2

A common formula used for counting calories of a food consumed is given by:

TotCal(P,F,C,D) = 4P+9F+4(C-D)

Where T is the total number of calories, P is the number of grams of protein, F is the number of grams of fat, C the total number of grams carbohydrate, and D the number of grams of dietary fiber.

We define the function with the following command.  Be sure to execute it!

TotCal[P_,F_,C_,D_]:=4*P+9*F+4*(C-D)

Part 1

Explain what TotCal(24,12,15,3) represents, and then evaluate it.

This represents the total net calories from a food source with 24 grams of protein, 12 grams of fat, 15 total grams of carbohydrates with 3 of them being from dietary fiber.

TotCal[24,12,15,3]

Part 2

The following is the nutritional information for 2 fried catfish filets:


Express the total number of calories from a 2 filet (strips) serving of fried catfish in function notation using the function TotCal(P,F,C,D) .

This is simply TotCal(16,6,10,1) .

TotCal[16,6,10,1]

Part 3

Using your answer from Part 2, and being honest with yourself that you could not simply eat 2 fried catfish filets, this is Oklahoma after all! Compute the total number of calories in a 7 fried catfish filets.

We can multiply the answer from part 2 by 7/2:

7/2*TotCal[16,6,10,1]

Problem 3

The following table gives the number of people vaccinated per 100 in Oklahoma over a window of time in July of 2021:

({{Day (in July),  People Vaccinated Per 100}, {1, 44.91}, {2, 45.00}, {3, 45.07}, {4, 45.14}, {5,  }, {6, 45.20}, {7, 45.23}, {8, 45.30}, {9,  }, {10, 45.49}, {11, 45.59}, {12, 45.65}, {13, 45.69}, {14, 45.77}})

Go here for covid state data: https://github.com/owid/covid-19-data/tree/master/public/data/vaccinations

Part 1

Plot the data given in the table above.  Be sure to label your axes appropriately.

PeopleVacData = {{1, 44.91},{2,45.00},{3,45.07},{4,45.14},{6,45.20},{7,45.23},{8,45.30},{10,45.49},{11,45.59},{12,45.65},{13,45.69},{14,45.77}}

VaccDataPlot = ListPlot[PeopleVacData, PlotLegends->{"People Vaccinated"}, PlotStyle->Blue, PlotMarkers->{"✶",12}, AxesLabel->{"Day of July", "People Vaccinated Per 100"}, Joined->False]

Part 2

You will notice that data is missing for the dates of July 5th and July 9th.  For July 5th, use the data from July 4th and July 6th to extrapolate the number of people vaccinated per 100. Perform a similar extrapolation for July 9th using July 8th and July 10th.

We need to use entries 4 and 5, for July 5th, and entries 7 and 8 for July 9th.

PeopleVacData[[4]]

PeopleVacData[[5]]

AvgVaccineDaily1 = N[(PeopleVacData[[5]][[2]]-PeopleVacData[[4]][[2]])/(PeopleVacData[[5]][[1]]-PeopleVacData[[4]][[1]])]

The average rate of change from July 4th to July 6th is 0.03 people per 100/day.

PeopleVacData[[7]]

PeopleVacData[[8]]

AvgVaccineDaily2 = N[(PeopleVacData[[8]][[2]]-PeopleVacData[[7]][[2]])/(PeopleVacData[[8]][[1]]-PeopleVacData[[7]][[1]])]

The average rate of change from July 8th to July 10th is 0.095 people per 100/day.

MissingData = {{5,PeopleVacData[[4]][[2]]+AvgVaccineDaily1 },{9,PeopleVacData[[7]][[2]]+AvgVaccineDaily2}}

Part 3

Plot the missing data you computed along with the data from part 1.  Be sure to use a different symbol and colour for the missing data.

MissingVaccDataPlot = ListPlot[MissingData, PlotLegends->{"Missing Data"}, PlotStyle->Red, PlotMarkers->{"▽",12}, AxesLabel->{"Day of April", "People Vaccinated Per 100"}, Joined->False];

Show[VaccDataPlot,MissingVaccDataPlot]

Part 4

The data for July 10th is actually missing, however the data for July 10th is known to be 45.39 people per 100.  Compute the difference between  the extrapolated value and the true value.  Was the extrapolation an underestimate or an overestimate?

We simply compute the differences we found using the MissingData variable.

MissingData[[2]][[2]]-45.39

So it appears that the linear approximations was slight overestimate for July 10th.

Part 5

The difference you computed in Part 4 give you the amount the approximation was off, however it lacks context.  A better way to look at this differences is in terms of a relative difference.  A relative difference is the difference divided by the correct value, which gives us a percentage.  For instance, if a value is known to be 142, and we estimate it to be 128, the difference is:

142-128

While the relative difference is

(142-128)/142.0

This tells us that the relative difference is 0.985, or approximately a 9.85% deviation. 

Compute the relative differences between your estimate and the actual data from Part 4.  How far off, relatively, was your extrapolation?

(MissingData[[2]][[2]]-45.39)/45.39

The relative difference is off by 0.01%, which is a very small relative difference!

Part 6

Plot the correct data value which was given in Part 4 for July 9th, along with the two data sets you plotted in Part 3.  Once again, be sure to use a new symbol and colour!

CorrectData = {9,45.39};

CorrectMissingVaccDataPlot = ListPlot[MissingData, PlotLegends->{"Correct Missing Data"}, PlotStyle->Black, PlotMarkers->{"◻",12}, AxesLabel->{"Day of April", "People Vaccinated Per 100"}, Joined->False];

Show[VaccDataPlot,MissingVaccDataPlot,CorrectMissingVaccDataPlot]

Problem 4

Using the Graphics command to draw a blue disk of radius 1 centered at (2, 1), a green triangle with vertices at (-1, 2), (2, 1), and (1, -2) on the same graph, and your name in magenta coloured text at the point (0.5, 0.5).

Graphics[{Thick,Blue,Disk[{2,1},1],Green,Line[{{-1,2},{2,1},{1,-2},{-1,2}}], Magenta, Text["Karl",{0.5,0.5}]}]

Problem 5

A perfect number is a positive integer that is equal to the sum of its equal divisors.  Mathematica has a built in command to determine if a number is perfect, it is called PerfectNumberQ.  We can also use FactorInteger to verify if a number is perfect or not.

PerfectNumberQ[20]

Divisors[20]

Total[%]-20

PerfectNumberQ[28]

Divisors[28]

Total[%]-28

Notice that for n=20, its proper divisors are 1, 2, 4, 5, and 10, which sums to 22.  On the other hand, n=28 has proper divisors 1, 2, 4, 7, and 14, which do sum to 28.

Part 1

Create a list which contains the first 10 perfect numbers (there are only 51 known so far!), storing it in the variable named PerfectList.

We use the Table command to create the list, and the PerfectNumber command to compute the kth perfect number.

PerfectList = Table[PerfectNumber[k],{k,1,10}]

Part 2

Sum the entries of PerfectList.

Here we use the Total command, which sums the entries.  The sum of the first 10 perfect numbers is that very large number below.

Total[PerfectList]