Page 8: #10

Your grandparents have an annuity. The value of the annuity increases each month by an automatic deposit of 1% interest on the previous month’s balance. Your grandparents withdraw $1000 at the beginning of each month for living expenses. Currently, they have $50,000 in the annuity. Model the annuity with a dynamical system. Model the annuity with dynamic system.
Will the annuity run out of money? When? Hint: What value will \(a_n\) have when the annuity is depleted?

Answer: Page 8: #10

Model the annuity with dynamic system:

By definition, for each positive integer n, the nth first different is: \[ \Delta a_n = a_{n+1} - a_n \]
However, if we were to withdraw $1000 from the annuity each month, the change during a period would be the interest earned in our case 1% during that period minus the monthly withdrawal, or:

\[ \Delta a_n = a_{n+1} - a_n \] \[ \Delta a_n = .01a_n - 1000 \]

Hence: \[ \begin{aligned} a_{n+1} - a_n =&& .01a_n - 1000 \\ a_{n+1} =&& a_n + .01a_n - 1000 \\ a_{n+1} =&& a_n (1 + .01) - 1000 \\ a_{n+1} =&& 1.01 a_n - 1000 \\ \end{aligned} \]

Will the annuity run out of money? When? Hint: What value will \(a_n\) have when the annuity is depleted?

annuity <- data.frame(month=0, amount=50000)

while(tail(annuity,1)[2] > 0){
  month =  tail(annuity,1)$month+1
  amount = 1.01*tail(annuity,1)$amount - 1000
  
  annuity <- rbind(annuity, c(month, amount))
  }

annuity
##    month     amount
## 1      0 50000.0000
## 2      1 49500.0000
## 3      2 48995.0000
## 4      3 48484.9500
## 5      4 47969.7995
## 6      5 47449.4975
## 7      6 46923.9925
## 8      7 46393.2324
## 9      8 45857.1647
## 10     9 45315.7364
## 11    10 44768.8937
## 12    11 44216.5827
## 13    12 43658.7485
## 14    13 43095.3360
## 15    14 42526.2893
## 16    15 41951.5522
## 17    16 41371.0678
## 18    17 40784.7784
## 19    18 40192.6262
## 20    19 39594.5525
## 21    20 38990.4980
## 22    21 38380.4030
## 23    22 37764.2070
## 24    23 37141.8491
## 25    24 36513.2676
## 26    25 35878.4002
## 27    26 35237.1843
## 28    27 34589.5561
## 29    28 33935.4517
## 30    29 33274.8062
## 31    30 32607.5542
## 32    31 31933.6298
## 33    32 31252.9661
## 34    33 30565.4957
## 35    34 29871.1507
## 36    35 29169.8622
## 37    36 28461.5608
## 38    37 27746.1764
## 39    38 27023.6382
## 40    39 26293.8746
## 41    40 25556.8133
## 42    41 24812.3815
## 43    42 24060.5053
## 44    43 23301.1103
## 45    44 22534.1214
## 46    45 21759.4626
## 47    46 20977.0573
## 48    47 20186.8278
## 49    48 19388.6961
## 50    49 18582.5831
## 51    50 17768.4089
## 52    51 16946.0930
## 53    52 16115.5539
## 54    53 15276.7095
## 55    54 14429.4766
## 56    55 13573.7713
## 57    56 12709.5090
## 58    57 11836.6041
## 59    58 10954.9702
## 60    59 10064.5199
## 61    60  9165.1651
## 62    61  8256.8167
## 63    62  7339.3849
## 64    63  6412.7787
## 65    64  5476.9065
## 66    65  4531.6756
## 67    66  3576.9923
## 68    67  2612.7623
## 69    68  1638.8899
## 70    69   655.2788
## 71    70  -338.1684
plot(annuity, type = 'S', col = "red", lwd = 5, main = "Annuity Dynamical System Model", 
     xlab ="Month" , ylab = "Amount")

The annuity will run out of money in month 69 as it will only have $655.2788.

Page 17, Question 9

The data in the accompanying table show the speed \(n\) (in increments of \(5 mph\)) of an automobile and the associated distance \(a_n\) in feet required to stop it once the brakes are applied. 

For instance, \(n = 6\) (representing \(6 × 5 = 30mph\)) requires a stopping distances of \(a_6\) = \(47ft\)

  1. Calculate and plot the change \(\Delta a_n\) versus \(n\). Does the graph reasonably approximate a linear relationship?

  2. Based on your conclusions in part (a), find a difference equation model for the stopping distance data. Test your model by plotting the errors in the predicted values against n. Discuss the appropriateness of the model

n an
1 3
2 6
3 11
4 21
5 32
6 47
7 65
8 87
9 112
10 140
11 171
12 204
13 241
14 282
15 325
16 376

Answer: Page 17, Question 9
a. Calculate and plot the change \(\Delta a_n\) versus \(n\). Does the graph reasonably approximate a linear relationship?

By definition, for each positive integer n, the nth first different is: \[ \Delta a_n = a_{n+1} - a_n \]
Therefore,

\[ \Delta a_0 = a_1 - a_0 = 6 - 3 = 3 \]   \[ \Delta a_1 = a_2 - a_1 = 11 - 6 = 5 \]   \[ \Delta a_2 = a_3 - a_2 = 21 - 11 = 10 \]   \[ etc..\]

brakes <- data.frame(speed=1:16, feet=c(3,6,11,21,32,47,65,87,112,140,171,204,241,282,325,376))

deltas<- c(0,tail(brakes$feet,-1)-head(brakes$feet,-1))
brakes$deltas = deltas
brakes$speed= brakes$speed*5
brakes
##    speed feet deltas
## 1      5    3      0
## 2     10    6      3
## 3     15   11      5
## 4     20   21     10
## 5     25   32     11
## 6     30   47     15
## 7     35   65     18
## 8     40   87     22
## 9     45  112     25
## 10    50  140     28
## 11    55  171     31
## 12    60  204     33
## 13    65  241     37
## 14    70  282     41
## 15    75  325     43
## 16    80  376     51
library(ggplot2)
qplot(speed, deltas, data=brakes, geom=c("point", "smooth"), 
      method="lm", formula=y~x, color=feet, 
      main="Regression of Stopping Distance on Speed", 
      xlab="Speed", ylab="Stopping Distance")

From the above, the graph reasonably approximates a linear relationship

brakes$speed = brakes$speed / 5
model1<- lm(brakes$speed~ brakes$deltas)
summary(model1)
## 
## Call:
## lm(formula = brakes$speed ~ brakes$deltas)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.0407 -0.1299  0.0591  0.1811  0.5117 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    1.30887    0.17872   7.324 3.77e-06 ***
## brakes$deltas  0.30847    0.00646  47.751  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.385 on 14 degrees of freedom
## Multiple R-squared:  0.9939, Adjusted R-squared:  0.9935 
## F-statistic:  2280 on 1 and 14 DF,  p-value: < 2.2e-16
coefficients(model1)
##   (Intercept) brakes$deltas 
##     1.3088714     0.3084666
layout(matrix(c(1,2,3,4),2,2)) # optional 4 graphs/page 
plot(model1)

Forcing the intercept to be 0. We get better model as below.

brakes$speed = brakes$speed / 5
model2<- lm(brakes$speed~ 0+brakes$deltas)
summary(model2)
## 
## Call:
## lm(formula = brakes$speed ~ 0 + brakes$deltas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.35297  0.03585  0.08418  0.16401  0.25167 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## brakes$deltas 0.069666   0.001477   47.16   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1635 on 15 degrees of freedom
## Multiple R-squared:  0.9933, Adjusted R-squared:  0.9929 
## F-statistic:  2224 on 1 and 15 DF,  p-value: < 2.2e-16
coefficients(model2)
## brakes$deltas 
##    0.06966604
layout(matrix(c(1,2,3,4),2,2)) # optional 4 graphs/page 
plot(model2)

Page 34, Question 13

Consider the spreading of a rumor through a company of 1000 employees, all working in the same building. We assume that the spreading of a rumor is similar to the spreading of a contagious disease (See Example 3, Section 1.2) in that the number of people hearing the rumor each day is proportional to the product of the number who have heard the rumor previously and the number who have not heard the rumor. This is given by \[ r_{n+1} = r_n + kr_n(1000 - n) \]
Where k is a parameter that depends on how fast the rumor spreads and n is the number of days.
Assume k = 0.001 and further assume that four people initially have heard the rumor.
How soon will all 1000 employees have heard the rumor?

Answer: Page 34, Question 13

# The number of people who have heard the rumor, rumor
# The number of days, n. 
# k is a parameter that depends on how fast the rumor spreads and n is the number of days

rumors <- data.frame(n=0, ppl_rumor=4)
k <- 0.001
all = 1000

for(i in 1:20){
  
  rumors <- rbind(rumors, c(i, rumors$ppl_rumor[i] + k*rumors$ppl_rumor[i]*(1000 - rumors$ppl_rumor[i])
                                )
  )
}
rumors
##     n  ppl_rumor
## 1   0    4.00000
## 2   1    7.98400
## 3   2   15.90426
## 4   3   31.55557
## 5   4   62.11538
## 6   5  120.37244
## 7   6  226.25535
## 8   7  401.31922
## 9   8  641.58132
## 10  9  871.53605
## 11 10  983.49701
## 12 11  999.72765
## 13 12  999.99993
## 14 13 1000.00000
## 15 14 1000.00000
## 16 15 1000.00000
## 17 16 1000.00000
## 18 17 1000.00000
## 19 18 1000.00000
## 20 19 1000.00000
## 21 20 1000.00000
plot(rumors, col ="red")

From the above table and graph, we can conclude that after day 12, all 1000 employees would have heard the rumor

Page 55, Question 6

An economist is interested in the variation of the price of a single product. It is observed that a high price for the product in the market attracts more suppliers. However, increasing the quantity of the product supplied tends to drive the price down.   Over time, there is an interaction between price and supply. The economist has proposed the following model, where \(P_n\) represents the price of the product at year n, and \(Q_n\) represents the quantity. Find the equilibrium values for this system, \[ P_{n+1} = P_n - 0.1(Q_n -500) \] \[Q_{n+1} = Q_n + 0.2(P_n - 100) \]  

  1. Does the model make sense intuitively? What is the significance of the constants 100 and 500?  Explain the significance of the sign of constants -0.1 and 0.2.

  2. Test the initial conditions in the following table and predict the long-term behavior.

Case Price Quantity
A 100 500
B 200 500
C 100 600
D 100 400

Answer: Page 55, Question 6

  1. Does the model make sense intuitively?

YEs, Intuitively the model make sense…

What is the significance of the constants 100 and 500?

The constants 100 and 500 are the equilibrium values. in other if we call the equilibrium values, we must \(P_n = P_{n+1}\) and \(Q_n= Q{n+1}\) simultaneously. Substituing into thesystem yeilds

\[ P = P - 0.1(Q - 500) \] \[ Q = Q + 0.2(P - 100) \]  

Hence: \[ \begin{aligned} P -P =&& - 0.1(Q - 500) \\ 0 = && -0.1(Q - 500) \\ 0 =&& (Q - 500) \\ Q =&& 500 \\ \end {aligned} \\ \]

Similarly
\[ \begin{aligned} Q -Q = && 0.2(P - 100) \\ 0 = && 0.2(P - 100) \\ 0 =&& (P-100) \\ P =&& 100 \\ \end {aligned} \\ \]

The negative and positive signs in the equation indicate the negative and positive price-quantity relationship.. It refers to the degree of responsiveness in quantity in relation to changes in price. If a curve is more elastic, then small changes in price will cause large changes in quantity. If a curve is less elastic, then it will take large changes in price to effect a change in quantity.

  1. Test the initial conditions in the following table and predict the long-term behavior.
Case Price Quantity
A 100 500
B 200 500
C 100 600
D 100 400
# writing function to test the initial conditions

test_conditions<- function ( initprice, initquantity ) {

  conditions <- data.frame( n= 0, p = initprice, q= initquantity)
  count <- 100
  
for(i in 1:count){
  conditions <- rbind(conditions, c(i, tail(conditions$p,1) - 0.1*(tail(conditions$q,1) - 500),
                    tail(conditions$q,1) + 0.2*(tail(conditions$p,1) - 100)))
}
  conditions
}


case_A <- test_conditions(100, 500)
case_B <- test_conditions(200, 500)
case_C <- test_conditions(100, 600)
case_D <- test_conditions(100, 400)
# Plotting all the test conditions

library(ggplot2)
library(grid)
library(gridExtra)


p1<- ggplot(case_A, aes(x=n, y = value, color = variable)) + 
  geom_line(aes(y = p, col = "price")) + 
  geom_line(aes(y = q, col = "quantity"))+
  ggtitle("Case A, price=100 Quantity=500")+
  theme(plot.title=element_text(family="Times", face="bold", size=8))
##
p2<- ggplot(case_B, aes(x=n, y = value, color = variable)) + 
  geom_line(aes(y = p, col = "price")) + 
  geom_line(aes(y = q, col = "quantity"))+
  ggtitle("Case B, price=200 Quantity=500")+
  theme(plot.title=element_text(family="Times", face="bold", size=8))
##
p3<- ggplot(case_C, aes(x=n, y = value, color = variable)) + 
  geom_line(aes(y = p, col = "price")) + 
  geom_line(aes(y = q, col = "quantity"))+
  ggtitle("Case C, price=100 Quantity=600")+
  theme(plot.title=element_text(family="Times", face="bold", size=8))
##
p4<- ggplot(case_D, aes(x=n, y = value, color = variable)) + 
  geom_line(aes(y = p, col = "price")) + 
  geom_line(aes(y = q, col = "quantity"))+
  ggtitle("Case D, price=100 Quantity=400")+
  theme(plot.title=element_text(family="Times", face="bold", size=8))
##
grid.arrange(p1, p2,p3,p4, ncol = 2)