<<
payments <- function(loan, apr, months) {
rate <- 1 + apr / 100 / 12
loan * rate^months * (rate - 1) / (rate^months - 1)
}
amortize <- function(loan, apr, months,
payment = payments(loan, apr, months)) {
rate <- 1 + apr / 100 / 12
month <- 0:months
balance <- loan * rate^month - payment * (rate^month - 1) / (rate - 1)
complete <- match(TRUE, balance <= 0)
balance <- ifelse(month < month[complete], balance, 0)
principal <- loan - balance
interest <- payment * month - principal
interest <- ifelse(month < month[complete], interest,
interest[complete-1])
amrt <- list(month = month[-1], balance=balance[-1],
principal = principal[-1], interest = interest[-1],
paid = principal[-1] + interest[-1], loan=loan,
payment=payment, apr=apr)
class(amrt) <- "amortization"
return(amrt)
}
refinance <- function(old_amrt, new_amrt, fees) {
oldint <- old_amrt$interest
oldpri <- old_amrt$principal
newint <- new_amrt$interest
newpri <- new_amrt$principal
month <- new_amrt$month
oldlen <- length(oldint)
newlen <- length(newint)
padlen <- oldlen - newlen
if(padlen > 0) {
newint <- c(newint, rep(newint[newlen], padlen))
newpri <- c(newpri, rep(newpri[newlen], padlen))
month <- old_amrt$month
} else if(padlen < 0) {
oldint <- c(oldint, rep(oldint[oldlen], padlen))
oldpri <- c(oldpri, rep(oldpri[oldlen], padlen))
month <- new_amrt$month
}
keep <- which(newpri < new_amrt$loan | oldpri < old_amrt$loan)
newint <- newint[keep]
oldint <- oldint[keep]
month <- month[keep]
breakeven <- month[as.logical(diff((newint + fees) >= oldint))]
savings <- oldint - newint - fees
refi <- list(month = month, savings = savings,
oldint = oldint, newint = newint,
fees = fees, breakeven = breakeven)
class(refi) <- "refinance"
return(refi)
}
plot.refinance <- function(refi, ...) {
# icol <- rgb(189, 215, 231, 127, maxColorValue=255)
# pcol <- rgb(8, 81, 156, 127, maxColorValue=255)
pcol <- rgb(255, 0, 0, 127, maxColorValue=255)
icol <- rgb(0, 0, 255, 127, maxColorValue=255)
year <- refi$month / 12
refi$fees <- refi$fees / 1000
refi$oldint <- refi$oldint / 1000
refi$newint <- refi$newint / 1000 + refi$fees
updn <- which(refi$newint > refi$oldint)
par(mar = c(4, 1, 1, 5))
plot(0, 0, xlim=range(year), ylim=range(c(refi$oldint,refi$newint)),
type="n", las=1, yaxt="n", main="", cex.main=3,
xlab="Year", cex.axis=1.5, cex.lab=1.5, bty="n", ...)
axis(4, las=1, cex.axis=1.5, at=pretty(c(refi$oldint, refi$newint)),
labels=paste("$",pretty(c(refi$oldint, refi$newint)),"k",sep=""))
polygon(c(year,max(year),min(year)), c(refi$newint,0,0),
border=NA, col=pcol)
polygon(c(year,max(year),min(year)), c(refi$oldint,0,0),
border=NA, col=icol)
text(x=0,y=max(c(refi$oldint,refi$newint)),adj=c(0,1), cex=2.3,
col=icol, font=2, paste("existing $", round(max(refi$oldint)),
"k", sep=""))
text(x=0,y=max(c(refi$oldint,refi$newint)),adj=c(0,2.5), cex=2.3,
col=pcol, font=2, paste("refinance $", round(max(refi$newint)),
"k", sep=""))
}
# Default quantities
dloan <- 150000
dprin <- 130000
dfees <- 3000
dold_rate <- 4.5
dnew_rate <- 3.7
dold_years <- 30
dnew_years <- 30
dold_minpay <- payments(dloan, dold_rate, dold_years*12)
dnew_minpay <- payments(dprin, dnew_rate, dnew_years*12)
dold_paymt <- dold_minpay
dnew_paymt <- dnew_minpay
# Read POST data, draw graphic
if(!is.null(POST)) {
floan <- as.numeric(POST$loan)
if(length(floan) == 1 && !is.na(floan) && floan > 0)
dloan <- floan
dprin <- dloan
fprin <- as.numeric(POST$prin)
if(length(fprin) == 1 && !is.na(fprin) && fprin > 0 &&
fprin <= dloan)
dprin <- fprin
ffees <- as.numeric(POST$fees)
if(length(ffees) == 1 && !is.na(ffees) && ffees > 0)
dfees <- ffees
fold_rate <- as.numeric(POST$old_rate)
if(length(fold_rate) == 1 && !is.na(fold_rate) && fold_rate >= 0)
dold_rate <- fold_rate
fold_years <- as.numeric(POST$old_years)
if(length(fold_years) == 1 && !is.na(fold_years) && fold_years > 0)
dold_years <- fold_years
dold_minpay <- payments(dloan, dold_rate, dold_years*12)
dold_paymt <- dold_minpay
fold_paymt <- as.numeric(POST$old_paymt)
if(length(fold_paymt) > 0 && !is.na(fold_paymt) &&
fold_paymt >= dold_minpay && fold_paymt < dprin)
dold_paymt <- fold_paymt
fnew_rate <- as.numeric(POST$new_rate)
if(length(fnew_rate) == 1 && !is.na(fnew_rate) && fnew_rate >= 0)
dnew_rate <- fnew_rate
fnew_years <- as.numeric(POST$new_years)
if(length(fnew_years) == 1 && !is.na(fnew_years) && fnew_years > 0)
dnew_years <- fnew_years
dnew_minpay <- payments(dprin, dnew_rate, dnew_years*12)
dnew_paymt <- dnew_minpay
fnew_paymt <- as.numeric(POST$new_paymt)
if(length(fnew_paymt) > 0 && !is.na(fnew_paymt) &&
fnew_paymt >= dnew_minpay && fnew_paymt < dprin)
dnew_paymt <- fnew_paymt
}
old_amrt <- amortize(dprin, dold_rate, dold_years*12, dold_paymt)
new_amrt <- amortize(dprin, dnew_rate, dnew_years*12, dnew_paymt)
filename <- paste(paste(sample(letters, 16, replace=TRUE),collapse=''),
'amort.png', sep='', collapse='')
refi <- refinance(old_amrt, new_amrt, dfees)
dirname <- '/srv/www/biostatmatt.com/public_html/R/RefiCalcCache/'
png(file=paste(dirname, filename, sep='', collapse=''),
type="cairo", height=400, width=600)
plot(refi)
dev.off()
setContentType("text/html; charset=utf-8")
>>
The red region represents the cumulative interest paid after refinancing your home mortgage. The blue area represents the cumulative remaining interest to be paid under your existing mortage. The purple region is where the two regions overlap. Hence, red regions represent the periods where the interest (including the cost of refinance, e.g., appraisal fees, insurance premiums, points) is greater after refinance. The break-even points are where red and blue borders cross. In the current scenario, <= if(length(refi$breakeven) > 1) cat('the break-even points are months') else if(length(refi$breakeven) == 1) cat('the break-even point is month') else cat('there are no break-even points') >> <= cat(paste(refi$breakeven + 1, sep='', collapse=' and ')) >>.