Calculating Effective Annual Interest Rate & Annual Percentage Rate with fees (in R)

Question

Problem

How to calculate Effective Annual Interest Rate (EAR) and Annual Percentage Rate (APR) with fees (in R) ?

I am interested in getting to know how much I am actually paying interest when fees are taken into account and I assume EAR is the way to go, but correct me if I am wrong.

I tried to implement APR below as in the investopedia description but APR is lower than nominal interest so it is certainly not correct (should be around 3.5%)

What I have tried

Below an MVE which also explains the problem in more detail:

rm(list=ls())
library(reprex)

# define costs, fees and interests
price <- 24800
monthly_payment <- 280
deposit <- 4000
loan_term <- 5*12 #in months
initial_fee <- 300
monthly_fee <- 12
nominal_interest <- 2/100
monthly_interest <- nominal_interest/12

# initiate fixed costs, interest fees and total costs for the loop
handling_charges <- initial_fee
interest_fees <- 0
total_costs <- handling_charges

# substracting initial payment from the what is left variable
left <- price - deposit

#calculating how much of dept is left after loan period and how much interest has accumulated
for (i in 1:loan_term) {
  left_last_month   <- left
  left              <- left*(1+monthly_interest)
  interest_fees_mo  <- (left-left_last_month)
  interest_fees     <- interest_fees + interest_fees_mo 
  handling_charges  <- handling_charges + monthly_fee
  total_costs       <- total_costs+ interest_fees_mo + monthly_fee
  left              <- left+monthly_fee-monthly_payment
}

#https://www.investopedia.com/terms/a/apr.asp
#https://www.investopedia.com/terms/e/effectiveinterest.asp
 
apr_100 <- 
  ((
    (total_costs/price)
    /(loan_term*30.4375) # number of days in the loan term
    )
   *365.25)             # number of days in a year

apr <- apr_100*100

# ear ???


share_of_loan_100 <- (total_costs/price)*100
share_of_loan_100
#> [1] 9.632864

left # after loan period ends
#> [1] 6088.95
interest_fees
#> [1] 1368.95
handling_charges
#> [1] 1020
total_costs
#> [1] 2388.95
apr   # wrong
#> [1] 1.926573
# ear # ????

^{Created on 2022-01-20 by the reprex package (v2.0.1)}

Definitions from investopedia:

APR

EAR, no fees taken into account

EDIT2:

Based on base64's suggestions, I think it is working now, albeit the code is ugly. Do you think it now give correct apr & apy ?

I added an option to either predifine monthly payment or calculate it based on the final payment (by setting monthly payment to FALSE, it will be approximated). There is also an option to choose when the interest compounds (eg. 1:12 for monthly, 1 for the first month of the year, c(6,12) for the 6th and 12th month of the year, since the beginning of the loan period).

After running the code, you can just plug in the values in the interest.F-function. See the two examples at the end (stack_example_monthly & stack_example_annual)

rm(list=ls())
library(reprex)
library(gtools)

# We need 3 helper functions
# 1. a precise enough binary search function
# 2. Payments function to calculate payments during the loan period
# 3. Apr to calculate the real interest rate

##########################################################
# 1. Binary search - helper function
##########################################################
# gtools binsearch-function modified for more accurate search results
# source: Gregory R. Warnes, Ben Bolker and Thomas Lumley (2021). gtools: Various R Programming Tools. R package version 3.9.2. https://CRAN.R-project.org/package=gtools

binsearch_decimal <- function(fun, range, ..., target = 0, lower = ceiling(min(range)),
                             upper = floor(max(range)), maxiter = 1000, showiter =FALSE) 
{
 lo <- lower
 hi <- upper
 counter <- 0
 val.lo <- fun(lo, ...)
 val.hi <- fun(hi, ...)
 if (val.lo > val.hi) {
   sign <- -1
 }
 else {
   sign <- 1
 }
 if (target * sign < val.lo * sign) {
   outside.range <- TRUE
 }
 else if (target * sign > val.hi * sign) {
   outside.range <- TRUE
 }
 else {
   outside.range <- FALSE
 }
 while (counter < maxiter && !outside.range) {
   counter <- counter + 1
   if (hi - lo <= 0.00001 || lo < lower || hi > upper) # 1 -> 0.00001
     break
   center <- round((hi - lo)/2 + lo, 6) # 0 -> 6
   val <- fun(center, ...)
   if (showiter) {
     cat("--------------\n")
     cat("Iteration #", counter, "\n")
     cat("lo=", lo, "\n")
     cat("hi=", hi, "\n")
     cat("center=", center, "\n")
     cat("fun(lo)=", val.lo, "\n")
     cat("fun(hi)=", val.hi, "\n")
     cat("fun(center)=", val, "\n")
   }
   if (val == target) {
     val.lo <- val.hi <- val
     lo <- hi <- center
     break
   }
   else if (sign * val < sign * target) {
     lo <- center
     val.lo <- val
   }
   else {
     hi <- center
     val.hi <- val
   }
   if (showiter) {
     cat("new lo=", lo, "\n")
     cat("new hi=", hi, "\n")
     cat("--------------\n")
   }
 }
 retval <- list()
 retval$call <- match.call()
 retval$numiter <- counter
 if (outside.range) {
   if (target * sign < val.lo * sign) {
     warning("Reached lower boundary")
     retval$flag <- "Lower Boundary"
     retval$where <- lo
     retval$value <- val.lo
   }
   else {
     warning("Reached upper boundary")
     retval$flag <- "Upper Boundary"
     retval$where <- hi
     retval$value <- val.hi
   }
 }
 else if (counter >= maxiter) {
   warning("Maximum number of iterations reached")
   retval$flag <- "Maximum number of iterations reached"
   retval$where <- c(lo, hi)
   retval$value <- c(val.lo, val.hi)
 }
 else if (val.lo == target) {
   retval$flag <- "Found"
   retval$where <- lo
   retval$value <- val.lo
 }
 else if (val.hi == target) {
   retval$flag <- "Found"
   retval$where <- hi
   retval$value <- val.hi
 }
 else {
   retval$flag <- "Between Elements"
   retval$where <- c(lo, hi)
   retval$value <- c(val.lo, val.hi)
 }
 return(retval)
}


##############################################3
# 2.payments - helper function 
##############################################
#calculating how much of dept is left after loan period and how much interest has accumulated
# includes an option to calculate monthly payment with binary search
payments.F <- function(monthly_payment, #
                      binary_search, 
                      monthly_fee, #
                      nominal_interest,
                      price, #
                      deposit, #
                      initial_fee,
                      loan_term,
                      compounding) {#
 
 # substracting initial payment and initial fees to get principal    
 principal <- price - deposit                     
 left <- principal                                      
 
 
 # initiate parameters for the loop
 handling_charges <- initial_fee
 interest_fees <- 0
 total_costs <- handling_charges
 monthly_interest <- nominal_interest/12
 month <- 1
 no_of_compoundings <- length(compounding)
 compounding_period_interest <- nominal_interest/length(compounding)
 
 #defining a "not in" operator
 `%!in%` <- Negate(`%in%`)
 
 if ( (sum(compounding %in% 1:12) >0) & (sum(compounding %!in% 1:12) ==0) ) {
   #print('--a valid compounding period set--')
 } else {
   stop("Error: Invalid compoumding value. Set it to a vector of months when you want it to compound, e.g. 1:12, c(6,12),5")
 }
 
 for (i in 1:loan_term) {
   left_last_month   <- left
   
   if (month %in% compounding) {
     left <-left*(1+compounding_period_interest) 
   }
   interest_fees_mo  <- (left-left_last_month)
   interest_fees     <- interest_fees + interest_fees_mo
   handling_charges  <- handling_charges + monthly_fee
   total_costs       <- total_costs+ interest_fees_mo + monthly_fee
   left              <- left+monthly_fee-monthly_payment
   
   # incrementing or resetting monthly counter
   month <- month+1
   if (i %% 12 == 0) {
     month <- 1
   }
   
 }
 if (binary_search==T) {
   return(left)
 } else {
   return(list("principal"=principal,
               "left"=left,
               "total_costs"=total_costs,
               "interest_fees"=interest_fees,
               "handling_charges"=handling_charges
   ))
 }
}


############################################################################
# 3. APR - helper function
############################################################################
#apr will be later solved with binary search

apr.F <- function(APR,PMT,N,FV,PV) {
 (PMT*((1-(1/(1+(APR/12))^N))/(APR/12)))+(FV/(1+(APR/12))^N)-(PV)
}


###########################################################################
# main function where we plug in the values

interest.F <- function(price,
                      loan_term=5*12,
                      initial_fee=0,
                      nominal_interest=2/100,
                      monthly_fee=12,
                      deposit=4000,
                      monthly_payment=F, # Set to false if you want to calculate monthly payment
                      final_payment=0, # If monthly payment is set, it will overrun this
                      compounding=1:12
) {
 
 
 
 # running binary search to monthly cost if we have not defined it
 if (monthly_payment==F) {
   print('--Calculating monthly payment by binary search--')
   (binsearch_monthly_payment <- binsearch_decimal(function(x) 
                                                   payments.F(x, #
                                                   binary_search=T, 
                                                   monthly_fee=monthly_fee, #
                                                   nominal_interest=nominal_interest,
                                                   price=price, #
                                                   deposit=deposit, #
                                                   initial_fee=initial_fee,
                                                   loan_term=loan_term,
                                                   compounding=compounding), 
                                 range = c(0,2000),
                                 target=final_payment,
                                 showiter = F))
   
   
   monthly_payment <- mean(binsearch_monthly_payment$where)
   
 } else {
   print('--Using pre-fixed monthly payment amount--')
 }

 # assigning a payment scheme based on monthly payment (binary search or predefined)
 (payments <- payments.F(monthly_payment,
                         binary_search = F,
                         monthly_fee=monthly_fee, #
                         nominal_interest=nominal_interest,
                         price=price, #
                         deposit=deposit, #
                         initial_fee=initial_fee,
                         loan_term=loan_term,
                         compounding=compounding))
 
 
 paid_excluding_fees <- payments$principal-payments$left

 # running a binary search to find apr given that we know how much we have repayed the loan (excluding fees)
 (binsearch_apr <- binsearch_decimal(function(x) 
                                     apr.F(x,
                                     PMT=monthly_payment,
                                     N=loan_term,
                                     FV=payments$left,
                                     PV=payments$principal-initial_fee)
                   , range = c(-1,100),target=0))
 
 #taking the mean value of the binary search to approximate apr
 apr <- mean(binsearch_apr$where)

 apr <- apr
 
 #calculating apy based on apr
 #https://www.investopedia.com/terms/a/apy.asp
 apy <- (1+apr/12)^12-1
 
 
 
 share_of_price <- (payments$total_costs/(price-initial_fee))*100
 #payments$paid_excluding_fees <- paid_excluding_fees
 payments$all_payments <- payments$total_costs + paid_excluding_fees +deposit
 payments$monthly_payments <- monthly_payment
 payments$share_of_price <- share_of_price
 payments$apr <- apr*100
 payments$apy <- apy*100

 return(payments)
}


(stack_example_monthly <- interest.F(
 price=24800,
 loan_term=5*12,
 initial_fee=300,
 nominal_interest=2/100,
 monthly_fee=12,
 deposit=4000,
 monthly_payment=F, # 280 # Set to false to estimate monthly payment
 final_payment=6088.95, #  6088.95 If monthly payment is set, it will overrun this
 compounding=1:12 # a vector, eg. 1:12, c(6,12), 5.
))
#> [1] "--Calculating monthly payment by binary search--"
#> $principal
#> [1] 20800
#> 
#> $left
#> [1] 6088.95
#> 
#> $total_costs
#> [1] 2388.95
#> 
#> $interest_fees
#> [1] 1368.95
#> 
#> $handling_charges
#> [1] 1020
#> 
#> $all_payments
#> [1] 21100
#> 
#> $monthly_payments
#> [1] 280
#> 
#> $share_of_price
#> [1] 9.750817
#> 
#> $apr
#> [1] 3.5069
#> 
#> $apy
#> [1] 3.56382
 
(stack_example_annual <- interest.F(
   price=24800,
   loan_term=5*12,
   initial_fee=300,
   nominal_interest=2/100,
   monthly_fee=12,
   deposit=4000,
   monthly_payment=280, # 280 # Set to false to estimate monthly payment
   final_payment=NA, #  6088.95 If monthly payment is set, it will overrun this
   compounding=12 # a vector, eg. 1:12, c(6,12), 5.
 ))
#> [1] "--Using pre-fixed monthly payment amount--"
#> $principal
#> [1] 20800
#> 
#> $left
#> [1] 5921.857
#> 
#> $total_costs
#> [1] 2221.857
#> 
#> $interest_fees
#> [1] 1201.857
#> 
#> $handling_charges
#> [1] 1020
#> 
#> $all_payments
#> [1] 21100
#> 
#> $monthly_payments
#> [1] 280
#> 
#> $share_of_price
#> [1] 9.068805
#> 
#> $apr
#> [1] 3.2841
#> 
#> $apy
#> [1] 3.333986

^{Created on 2022-02-13 by the reprex package (v2.0.1)}

Answer 1

First, you can throw that Investopedia APR formula out of the window. That formula is only for one-time payment under 1 year e.g. Credit Card Payment.

Second, for the current code, I can confirm the following is correct:

• 2% Nominal Interest Rate per year, compounded monthly, does result in $268 Monthly Payment (Excluding Fee) on a Loan of 24800-4000=20800. $268 + $12 Monthly Fee = $280 which is consistent.
• After 60 months, taking into account of Monthly Interest, but excluding Initial Fee and ignoring Monthly Fee, results in $6088.95 remaining principal for the purpose of calculating next monthly interest.

What went wrong is that (1) You used the wrong formula for APR (actually there is no formula) and (2) You ignored the $300 Initial Fee.

• (1): APR for a monthly payment loan (especially exceeding 12 months), according to different consumer lending regulations around the world, are calculated by finding the correct APR (known as I/Y) that results in Principal = Present Value of All Payments, i.e. the amortization table. This answer explains why it cannot be "solved by hand" or by formula. It must be done using financial libraries (pretty sure R has third party package), "brute force", "binary search", or RATE() of Excel.

• (2): The $300 Initial Fee should be deducted from the Beginning Principal of $20800, because while the bank gave you $20800 on Day 0, the Bank took away $300 on Day 0 too, albeit from another transaction entry. Therefore, the actual amount that went out of the bank was $20500. However, there is no need to change "left <- price - deposit" as it will distort your "left # after loan period ends". As the 2% Nominal Interest Rate is applied to the Gross Loan of 20800, the Initial Fee of $300 is not capitalized as a principal.

Considering (1) and (2), the result of APR across 60 months using financial calculator is 3.507%, assuming that the $300 Initial Fee is amortized over 60 months only (i.e. early termination of the loan where the bank agrees that the outstanding principal is 6088.95), instead of over 83.181 months (Reverse Engineered Total Months from 2% Nominal and $268 Monthly Payment). If you do amortize the $300 over 83.181 months, the APR is 3.723% over 83.181 months, which is a higher % due to more frequent $12 Monthly Fee. Here is further proof that 3.723% APR according to US regulation is correct assuming 83.181 months.

The Effective APR (including Initial Fee and Monthly fee), also known as APY, is (1+0.03507/12)^12-1 = 3.564% for amortizing $300 over 60 months only, and is (1+0.03723/12)^12-1 = 3.787% if amoritizing $300 over 83.181 months.

Edit

In my answer above, I explicitly stated there is no need to change "left <- price - deposit".

There are 2 tables in the universe.

• One according to bank, where the "Outstanding Principal" (i.e. FV) depends on the 2% Nominal Interest Rate, does not depend on Initial Fee of $300, and the Monthly Fee is fixed at $12 regardless of the "Outstanding Principal".

• Another according to the law, where the finance people says that all interest and fees must depend on "Outstanding Principal". As the "Outstanding Principal" decreases, the "interest and fees" must also decrease over time. Everything that is not Principal is called Interest (not Fees, Charges, Costs etc).

If you notice carefully in the 3.507% link, the page said Total Interest: $2,388.95. This "coincidentally" equal to your 1st attempted code:

interest_fees
#> [1] 1368.95
handling_charges
#> [1] 1020
total_costs
#> [1] 2388.95

An amortization table is only there to appropriate (i.e. assign) the portion of Principal and portion of Interest (including Fees) for each Fixed Monthly Payment. It's just a uniform way of appropration that every finance people accepts. The amortization never changed the Total Payment nor Total Interest (including Fees) over the period.

Therefore I stress again, do not change the code section "# substracting initial payment from the what is left variable", because you need it to calculate the "Outstanding Principal after 60 months" according to bank, not according to the law.

Once you got this correct "Outstanding Principal after 60 months":

left # after loan period ends
#> [1] 6088.95

You would try all possible values (or selectively by binary search) of r from 0.0000000 to 1.0000000 for:

(280*((1-(1/(1+(r/12))^60))/(r/12)))+(6088.95/(1+(r/12))^60)-20500

The goal is to find the r that results to 0 in this formula. Note that even Wolfram Alpha doesn't know how to solve it unless you specify 0 < r < 1. But if you insert r = 0.03507 into above (0.035068 to be more accurate), you will understand that this formula is correct.

All those links associated with each percentage of the answer assumes that you fully understand Time Value of Money, including when to include fees in payment (i.e. PMT), when to deduct upfront fees from Initial Principal (i.e. PV).

The general equation is:

(PMT*((1-(1/(1+(r/12))^N))/(r/12)))+(FV/(1+(r/12))^N)-PV=0

Where:

PMT = Fixed Monthly Payment
      (Including fixed and variable interest and fees, whatever "costs" you call doesn't matter, as long as entire monthly payment is FIXED)
r = APR
N = Months paid so far
FV = Outstanding Principal according to the Bank at the end of N ($0 if fully repaid)
PV = Initial Principal - Upfront Fees paid by the borrower

Note the difference between using Geometric Series (i.e. above) or plain Summation.

(PMT*((1-(1/(1+(r/12))^N))/(r/12))) = Sum of PMT/(1+(r/12))^n where n = 1 to N

After getting the r (APR), if you want to know the appropriated portion of Principal and portion of Interest (including Fees) for each Fixed Monthly Payment according to the law, just run your original code with:

# define costs, fees and interests
**upfront_interest <- 300**
price <- 24800 **-upfront_interest**
monthly_payment <- 280
deposit <- 4000
loan_term <- 5*12 #in months
initial_fee <- **0**
monthly_fee <- **0**
nominal_interest <- **r**
monthly_interest <- nominal_interest/12

share_of_loan_100 <- (total_costs/(price**+upfront_interest-deposit**))*100

The result which echos "Everything that is not Principal is called Interest (not Fees, Charges, Costs etc)" and "The amortization never changed the Total Payment nor Total Interest (including Fees) over the period".

share_of_loan_100
#> [1] 11.48533
left # after loan period ends
#> [1] 6088.948
interest_fees
#> [1] 2388.948
handling_charges
#> [1] 0
total_costs
#> [1] 2388.948

The $300 "upfront_interest" was already spread across 60 months by embedding into APR. No need to add $300 to Total Interest manually.

Edit 2

Actually for EU, it looks like the compounding is yearly in decimals instead of monthly, despite that the payment is monthly. So all you need to do is arrive at 6088.95 first, then modify in the binary search as:

D=280
target=0
apr_100: ... + (6088.95*(1+APR/(100*100))^-(MONTHS/12)) - 20500

However, by knowing this EU APR, you can't really directly make a meaningful amortization table and appropriating the monthly interest. Even Europeans would have to convert this back to an interest rate over 1 month to create a monthly amortization table.

"Whenever payment and compounding periods differ with each other, it is recommended to compute the effective interest rate per payment period. The reason is that, to proceed with equivalency analysis, the compounding and payment periods must be the same."

https://wps.prenhall.com/ecs_park_fee_2/87/22279/5703599.cw/content/index.html

Anyway EU APR = US APY with 12 Payment Periods per Year & 1 Compounding per Year.

Convert US APY into US APR and you will have the same amortization table as my initial Edit.

$call
binsearch(fun = apr_100, range = c(0, 100 * 100), target = 0)
$numiter
[1] 14
$flag
[1] "Between Elements"
$where
[1] 3.56 3.57
$value
[1]  2.282236 -3.853403
[1] 3.565

2 decimal places for interest rate is not enough though.

Answer 2

Pretty sure this is the answer after reviewing these calculations. In you're apr_100 calculation, the 'price' is incorrect. It should be equal to the beginning principal of the debt, which is 'price minus deposit' in your example. The amount borrowed is $20,800, which is what the interest + fees should be calculated against, not the debt + equity (ie 'price').

If you adjust that, than the APR equals 2.3% with fees taken into account. If you then plug that 2.3% into the EAR formula, it should result in 2.32% adjusting to monthly from annual.