How to use vector functions, instead of FOR loop, in this simple R code?

This is an extension of my similarly-titled question posted yesterday. Yesterday I over-simplified my example, as there are additional variables that drive this amortization example. I´d like to use a vector function instead of a FOR loop in the below R code. Below works fine (I also show the correct output below), but I understand as the model grows the vector functions will prove much faster.

I have an Excel/VBA background, am new to R, and am trying to get my head around R vectors.

Amortization = begin_bal*((1+npr)(1-mpr)(1-co/12)) = end_bal. Fin (yield) below doesn´t figure into ending balances.

Below is the FOR loop code:

n_periods <- 8
begin_bal <- 10000
yld <- .20
npr <- .09
mpr <- .10           
co <- .10            

period <- seq(0, n_periods, 1)
fin <- 0
pur <- 0
pmt <- 0
ch_off <- 0
end_bal <- begin_bal

for (i in 1:n_periods) {
  fin[i + 1] <- end_bal[i]*yld / 12
  pur[i + 1] <- end_bal[i]*npr
  pmt[i + 1] <- end_bal[i]*mpr
  ch_off[i + 1] <- end_bal[i]*co / 12
  end_bal[i + 1] <- end_bal[i] + pur[i + 1] - pmt[i + 1] - ch_off[i + 1]
}

amort <- data.frame(period, fin, pur, pmt, ch_off, end_bal)

And here´s the (correct) output:

print(amort,row.names=FALSE)
 period      fin      pur       pmt   ch_off   end_bal
      0   0.0000   0.0000    0.0000  0.00000 10000.000
      1 166.6667 900.0000 1000.0000 83.33333  9816.667
      2 163.6111 883.5000  981.6667 81.80556  9636.694
      3 160.6116 867.3025  963.6694 80.30579  9460.022
      4 157.6670 851.4020  946.0022 78.83351  9286.588
      5 154.7765 835.7929  928.6588 77.38823  9116.334
      6 151.9389 820.4700  911.6334 75.96945  8949.201
      7 149.1534 805.4281  894.9201 74.57668  8785.132
      8 146.4189 790.6619  878.5132 73.20944  8624.072

Upvotes: 0

Views: 92

Answers (1)

AnilGoyal
AnilGoyal

Reputation: 26218

Not that difficult, once you'll stop thinking Excel way (I also faced similar problems when I started R 5-6 months back and that's why suggesting you). You need to convert your logic into a mathematical way only.

  • Actually your monthly/periodical payment comprises of three items, pur, pmt and ch_off which are dependent of previous balance only.
  • Thus, if we calculate (mpr + co/12 - npr) for every period our payment can be calculated.
  • That is further easy as period here start from 0 and we can use mathematical formula using ^ to calculate end_bal for each period.
  • Rest of the values are easy to calculate, thereafter.

BaseR version

n_periods <- 8
begin_bal <- 10000
yld <- .20
npr <- .09
mpr <- .10           
co <- .10

amort <- data.frame(period = seq(0, n_periods, 1))
amort$end_bal <- begin_bal * (1 - (mpr + co/12 - npr))^amort$period
amort$fin <- c(0, (amort$end_bal * yld/12)[-nrow(amort)])
amort$pur <- c(0, (amort$end_bal * npr)[-nrow(amort)])
amort$pmt <- c(0, (amort$end_bal * mpr)[-nrow(amort)])
amort$ch_off <- c(0, (amort$end_bal * co/12)[-nrow(amort)])

amort
#>   period   end_bal      fin      pur       pmt   ch_off
#> 1      0 10000.000   0.0000   0.0000    0.0000  0.00000
#> 2      1  9816.667 166.6667 900.0000 1000.0000 83.33333
#> 3      2  9636.694 163.6111 883.5000  981.6667 81.80556
#> 4      3  9460.022 160.6116 867.3025  963.6694 80.30579
#> 5      4  9286.588 157.6670 851.4020  946.0022 78.83351
#> 6      5  9116.334 154.7765 835.7929  928.6588 77.38823
#> 7      6  8949.201 151.9389 820.4700  911.6334 75.96945
#> 8      7  8785.132 149.1534 805.4281  894.9201 74.57668
#> 9      8  8624.072 146.4189 790.6619  878.5132 73.20944

dplyr version

n_periods <- 8
begin_bal <- 10000
yld <- .20
npr <- .09
mpr <- .10           
co <- .10
library(dplyr)

seq(0, n_periods, 1) %>% as.data.frame() %>%
  setNames('period') %>%
  mutate(end_bal = begin_bal * (1 - (mpr + co/12 - npr))^period,
         payment = -1 * c(0, diff(end_bal)),
         fin = c(0, (end_bal * yld/12)[-nrow(.)]),
         pur = c(0, (end_bal * npr)[-nrow(.)]),
         pmt = c(0, (end_bal * mpr)[-nrow(.)]),
         ch_off = c(0, (end_bal * co/12)[-nrow(.)]))

#>   period   end_bal  payment      fin      pur       pmt   ch_off
#> 1      0 10000.000   0.0000   0.0000   0.0000    0.0000  0.00000
#> 2      1  9816.667 183.3333 166.6667 900.0000 1000.0000 83.33333
#> 3      2  9636.694 179.9722 163.6111 883.5000  981.6667 81.80556
#> 4      3  9460.022 176.6727 160.6116 867.3025  963.6694 80.30579
#> 5      4  9286.588 173.4337 157.6670 851.4020  946.0022 78.83351
#> 6      5  9116.334 170.2541 154.7765 835.7929  928.6588 77.38823
#> 7      6  8949.201 167.1328 151.9389 820.4700  911.6334 75.96945
#> 8      7  8785.132 164.0687 149.1534 805.4281  894.9201 74.57668
#> 9      8  8624.072 161.0608 146.4189 790.6619  878.5132 73.20944

Created on 2021-05-13 by the reprex package (v2.0.0)

Note extra column payment created can be deleted too

seq(0, n_periods, 1) %>% as.data.frame() %>%
  setNames('period') %>%
  mutate(end_bal = begin_bal * (1 - (mpr + co/12 - npr))^period,
         fin = c(0, (end_bal * yld/12)[-nrow(.)]),
         pur = c(0, (end_bal * npr)[-nrow(.)]),
         pmt = c(0, (end_bal * mpr)[-nrow(.)]),
         ch_off = c(0, (end_bal * co/12)[-nrow(.)]))

  period   end_bal      fin      pur       pmt   ch_off
1      0 10000.000   0.0000   0.0000    0.0000  0.00000
2      1  9816.667 166.6667 900.0000 1000.0000 83.33333
3      2  9636.694 163.6111 883.5000  981.6667 81.80556
4      3  9460.022 160.6116 867.3025  963.6694 80.30579
5      4  9286.588 157.6670 851.4020  946.0022 78.83351
6      5  9116.334 154.7765 835.7929  928.6588 77.38823
7      6  8949.201 151.9389 820.4700  911.6334 75.96945
8      7  8785.132 149.1534 805.4281  894.9201 74.57668
9      8  8624.072 146.4189 790.6619  878.5132 73.20944

dplyr::lag may also be used

seq(0, n_periods, 1) %>% as.data.frame() %>%
  setNames('period') %>%
  mutate(end_bal = begin_bal * (1 - (mpr + co/12 - npr))^period,
         fin = lag(end_bal, default = 0) * yld/12,
         pur = lag(end_bal, default = 0) * npr,
         pmt = lag(end_bal, default = 0) * mpr,
         ch_off = lag(end_bal, default = 0) * co/12)

Upvotes: 2

Related Questions