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?
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 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\)
Calculate and plot the change \(\Delta a_n\) versus \(n\). Does the graph reasonably approximate a linear relationship?
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 |
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")
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)
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)
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?
# 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")
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) \]
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.
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 |
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.
| 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)