3.3 Modeling Data with Linear Functions

Example 3.6

Our goal here is to determine if either dataset is linear in nature.  First we enter and tabulate the data:

VoteData1 = {{0,28321},{1,28542},{2,29466},{3,30381},{4,30397},{5,31144}}

VoteData2 = {{0,28321},{1,28783},{2,29245},{3,29707},{4,30169},{5,30631}}

TableForm[VoteData1 ,TableHeadings->{None,{"Date","Registered Voters"}}]

TableForm[VoteData2 ,TableHeadings->{None,{"Date","Registered Voters"}}]

Now we steal code from previous notebooks to create tables of the rates of change for each:

ROCVoteData1 = Table[(VoteData1[[i+1]][[2]]-VoteData1[[i]][[2]]),{i,1,Length[VoteData1]-1}];

FancyVoteData1 = Prepend[{ROCVoteData1},{"0 to 1","1 to 2", "2 to 3", "3 to 4", "4 to 5"}];

SupFancyVoteData1= MapThread[Prepend,{FancyVoteData1,{"Change in d","Change in N"}}];

Grid[SupFancyVoteData1  ,Frame-> All]

ROCVoteData2 = Table[(VoteData2[[i+1]][[2]]-VoteData2[[i]][[2]]),{i,1,Length[VoteData2]-1}];

FancyVoteData2 = Prepend[{ROCVoteData2},{"0 to 1","1 to 2", "2 to 3", "3 to 4", "4 to 5"}];

SupFancyVoteData2= MapThread[Prepend,{FancyVoteData2,{"Change in d","Change in N"}}];

Grid[SupFancyVoteData2  ,Frame-> All]

It is clear the the second dataset is linear!  Thus, we can use this dataset to predict the number of registered voters in Payne County in 2018 by using a the slope of the line.  Since the slope is in units number of voters/year, we simply multiply the slope m=462 by 2, and add it to the number of registered voters in 2016:

462*2+VoteData2[[6]][[2]]

Thus, the estimate is that there will be 31,555 voters registered in 2018.

Example 3.7

Exploring Newton’s Second law with the follow dataset.  Each pair of numbers, an entry in the list MassForceData, is a (mass, force) pair.  Mass is measured in kg, force in Newtons.

MassForceData = {{1,5},{1.3,6.5},{1.6,8},{1.9,9.5},{2.2,11}}

Part 1

Once again, stealing code to verify that the data is linear.

TableForm[MassForceData ,TableHeadings->{None,{"Mass","Force"}}]

ROCMassForceDataF= Table[(MassForceData[[i+1]][[2]]-MassForceData[[i]][[2]]),{i,1,Length[MassForceData]-1}];
ROCMassForceDataM= Table[(MassForceData[[i+1]][[1]]-MassForceData[[i]][[1]]),{i,1,Length[MassForceData]-1}];

FancyROCMassForceData = Prepend[{ROCMassForceDataM,ROCMassForceDataF},{"1 to 1.3","1.3 to 1.6", "1.6 to 1.9", "1.9 to 2.2"}];

SupFancyROCMassForceData= MapThread[Prepend,{FancyROCMassForceData,{"mass interval","Change in m","Change in F"}}];

Grid[SupFancyROCMassForceData, Frame-> All]

Since each mass change is by 0.3 kg, and each change in force is 1.5 Netwons, the data is linear.

Part 2

The slope can be computed from any pair of points:

SlopemF = (MassForceData[[2]][[2]]-MassForceData[[1]][[2]])/(MassForceData[[2]][[1]]-MassForceData[[1]][[1]])

SlopemF = (MassForceData[[4]][[2]]-MassForceData[[1]][[2]])/(MassForceData[[4]][[1]]-MassForceData[[1]][[1]])

SlopemF = (MassForceData[[2]][[2]]-MassForceData[[5]][[2]])/(MassForceData[[2]][[1]]-MassForceData[[5]][[1]])

As we can see, the slope is 5 (N/kg) .  Be sure to recognize how which pair of points we chose did not change the resulting slope

Part 3

Now that we know the slope, we need the intercept.  Any point in the dataset can be used.  As seen below, we use the second and fourth, with the same results:

Clear[b]

Solve[MassForceData[[2]][[2]] == SlopemF*MassForceData[[2]][[1]]+b,b]

Solve[MassForceData[[4]][[2]] == SlopemF*MassForceData[[4]][[1]]+b,b]

N[%]

N[%,20]

NumberForm[%,{4,3}]

F[m_]:=SlopemF*m;

F[m]

Part 4

Now that we have our force model F(m), we simply evaluate F(1.43), which results in a force of 7.15 Newtons.

F[1.43]

Part 5

MFDPlot = ListPlot[MassForceData,  PlotStyle->Red, PlotMarkers->{"✶",16},PlotLegends->{"Pts",LegendMarkers->Automatic}];

MFLPlot = Plot[F[m],{m,0,3}, PlotStyle->{Blue, Thickness[0.004]},PlotLegends->{"Line",LegendMarkers->Automatic}];

Show[MFLPlot,MFDPlot, AxesLabel->{"Mass (kg)", "Force (N)"}, AxesOrigin-> {0,0}]

Part 6

The formula F=m*a seems to hold for this example, at least in the case a=5 (m/(s^2)).

Exercise 5

KindleData = {{0,349},{5,299},{10,249},{15,199}}

Part a.

ROCKindleData = Table[(KindleData[[i+1]][[2]]-KindleData[[i]][[2]]),{i,1,Length[KindleData]-1}];

FancyROCKindleData = Prepend[{ROCKindleData},{"0 to 5","5 to 10", "10 to 15"}];

SupFancyROCKindleData= MapThread[Prepend,{FancyROCKindleData,{"Change in months","Change in price"}}];

Grid[SupFancyROCKindleData  ,Frame-> All]

The data is linear.

Part b.

SlopeK = (KindleData[[3]][[2]]-KindleData[[2]][[2]])/(KindleData[[3]][[1]]-KindleData[[2]][[1]])

Solve[KindleData[[4]][[2]]==SlopeK*KindleData[[4]][[1]]+b,b]

K[m_]:=SlopeK*m+349

K[m]

So the linear equation which models the data is K(m) = -10m+349.

Part c.

K[35]

The price appears to be -$1, what a deal!

Exercise 18

TaxTableData = {{72000,9896},{72200,9926},{72400,9956},{72600,9986},{72800,10016},{73000,10046},{73200,10076},{73400,10106},{73600,10136},{73800,10169},{74000,10219},{74200,10269}}

Table[{TaxTableData[[i+1]][[1]]-TaxTableData[[i]][[1]],TaxTableData[[i+1]][[2]]-TaxTableData[[i]][[2]]},{i,1,Length[TaxTableData]-1}]

ROCTaxTableData = Transpose[Table[{TaxTableData[[i+1]][[1]]-TaxTableData[[i]][[1]],TaxTableData[[i+1]][[2]]-TaxTableData[[i]][[2]]},{i,1,Length[TaxTableData]-1}]]

FancyROCKindleData= MapThread[Prepend,{ROCTaxTableData ,{"Change in income","Change in tax"}}];

Grid[FancyROCKindleData  ,Frame-> All]

From the changes above, we see that the first 9 points have the same rate of change, and the last three points, 10-12 have the same rate of change.

FirstSlope = N[(TaxTableData[[3]][[2]]- TaxTableData[[1]][[2]])/(TaxTableData[[3]][[1]]- TaxTableData[[1]][[1]])]

SecondSlope = N[(TaxTableData[[12]][[2]]- TaxTableData[[11]][[2]])/(TaxTableData[[12]][[1]]- TaxTableData[[11]][[1]])]

Solve[TaxTableData[[3]][[2]]==0.15*TaxTableData[[3]][[1]]+b,b]

Solve[TaxTableData[[12]][[2]]==0.25*TaxTableData[[12]][[1]]+b,b]

FLine[In_]:=0.15*In-904;
SLine[In_]:=0.25*In-8281;

The first formula is given by FL(I) = 0.15*I-904, and the second is SL(I) = 0.25*I-8281.

TaxTableData[[1;;9;;1]]

TaxTableData[[10;;12;;1]]

TaxDataPlot = ListPlot[{TaxTableData[[1;;9;;1]],TaxTableData[[10;;12;;1]]}, PlotLegends->{"Set 1","Set2"}, PlotStyle->{Blue, Red}, PlotMarkers->{{"▽",16},{"✶",12}}];

PlotLines1= Plot[FLine[In],{In,71900,73700},PlotStyle->{Blue, Thickness[0.004]}, PlotLegends->{"First Line"}];

PlotLines2= Plot[SLine[In],{In,73700,74300},PlotStyle->{Red, Thickness[0.004]}, PlotLegends->{"Second Line"}];

Show[TaxDataPlot,PlotLines1,PlotLines2, AxesLabel-> {"Income ($)","Tax ($)"}]

FLine[73800]

SLine[73800]

TaxTableData[[10]]