Problema

¿Cómo calcular la Tasa de Interés Anual Efectiva (EAR) y la Tasa de Porcentaje Anual (APR) con tarifas (en R)?

Estoy interesado en saber cuánto estoy pagando realmente de interés cuando se toman en cuenta las tarifas y asumo que EAR es el camino a seguir, pero corríjame si me equivoco.

Traté de implementar la APR a continuación como en la descripción de investopedia, pero la APR es más baja que el interés nominal, por lo que ciertamente no es correcta (debería estar alrededor del 3,5%).

lo que he probado

Debajo de un MVE que también explica el problema con más detalle:

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 # ????

^{Creado el 2022-01-20 por el paquete reprex (v2.0.1)}

Definiciones de investopedia:

ABR

EAR, no se tienen en cuenta las tasas

EDIT2:

Según las sugerencias de base64 , creo que ahora está funcionando, aunque el código es feo. ¿Crees que ahora da apr & apy correctos?

Agregué una opción para predefinir el pago mensual o calcularlo en función del pago final (al establecer el pago mensual en FALSO, se aproximará). También existe la opción de elegir cuándo se capitaliza el interés (p. ej., 1:12 para mensual, 1 para el primer mes del año, c(6,12) para el 6.° y 12.° mes del año, desde el comienzo del periodo de préstamo).

Después de ejecutar el código, puede simplemente ingresar los valores en la interest.Ffunción. Ver los dos ejemplos al final ( 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

^{Creado el 2022-02-13 por el paquete reprex (v2.0.1)}