# R/capitalR.R In capitalR: Capital Budgeting Analysis, Annuity Loan Calculations and Amortization Schedules

#### Documented in annuityearfvgeometricipmtirregularppmtpvr.calcschedule

```#' Present Value
#'
#' Calculates the present value of a given future value
#'
#' @param fv Future Value
#' @param r Discount Rate
#' @param n Number of Compounding Periods
#'
#' @return Returns the Present Value
#' @export
#'
#' @examples pv(5000, 0.08/12, 5*12)
pv <- function(fv, r, n) { fv/(1+r)^(n)}

#' Future Value
#'
#' Calculates the Future Value given a Present Value
#'
#' @param pv Present Value
#' @param r Discount Rate
#' @param n Number of Compounding Periods
#'
#' @return Returns the Future Value
#' @export
#'
#' @examples fv(5000, 0.08/12, 5*12)
fv <- function(pv, r, n) {pv*(1 + r)^(n)}

#' Geometric Mean Return
#'
#' @param c Periodic returns in decimal form
#'
#' @return Returns the Geometric Mean Return
#' @export
#'
#' @examples geometric(c(0.05, 0.02, -0.03, 0.09, -0.02))
geometric <- function(c) {

c2 <- c + 1
(prod(c2))^(1/length(c)) - 1

}

#' Return Calculation
#'
#' @param vector Vector from which to calculate the periodic return
#'
#' @return Returns the Periodic Percent Return
#' @export
#'
#' @examples r.calc(c(100, 75, 50, 80, 125))
r.calc <- function(vector){
DIFF <- c(0,diff(vector))
n <- length(vector)
DIV <- rep(0,n)

for(i in 2:n){
DIV[i-1] <- DIFF[i]/vector[i-1]
}
r <- DIV[1:n-1]
r <- c(0,r)
return(r)
}

#' Annuity Loan Calculation
#'
#' Calculates the payment, present value, future value, rate, or the number of periods
#'
#' @param type Loan parameter to return. ("pv", "fv", "pmt", "nper", "rate")
#' @param pv Present Value
#' @param fv Future Value
#' @param pmt Periodic Payment
#' @param n Number of Periods
#' @param r Rate
#' @param end Logical, set to TRUE. If FALSE, payments are made at the beginning the period.
#'
#' @return Returns the selected Annuity Loan Parameter
#' @export
#'
#' @examples annuity(type = "pmt", pv = -2000, fv = 0, n  = 4 * 12, r = 0.06/12, end = TRUE)
annuity <- function(type = c("pv", "fv", "pmt", "nper", "rate"), pv, fv = 0, pmt, n, r, end = TRUE) {

if(end == TRUE){
t <- 0
} else {
t <- 1
}

if(type == "pmt"){

(-pv*(1+r)^n - fv) / ((((1+r)^n-1)/r)*(1+r*t))

} else if(type == "pv"){

(-pmt*((((1+r)^n)-1)/r)*(1+r*t) - fv) / (1+r)^n

} else if(type == "fv"){

-pv*(1+r)^n - pmt*(((1+r)^n-1)/r)*(1+r*t)

} else if(type == "nper"){

annuity <- data.frame(N = c(0:2000))
annuity\$value <- abs(pv*(1+r)^annuity\$N + pmt*((((1+r)^annuity\$N)-1)/r)*(1+r*t)+fv)
annuity\$N[match(min(annuity\$value), annuity\$value)]

}else if(type == "rate"){

annuity <- data.frame(R = seq(0.0001, 2, 0.0001))
annuity\$value <- abs(pv*(1+annuity\$R)^n + pmt*((((1+annuity\$R)^n)-1)/annuity\$R)*(1+annuity\$R*t)+fv)
annuity\$R[match(min(annuity\$value), annuity\$value)]

}else{

}
}

#' Interest Payment
#'
#' Calculates the interest portion of the payment in period "x"
#'
#' @param pv Present Value
#' @param fv Future Value
#' @param n Number of Periods
#' @param r Rate
#' @param x Period in which to calculate the interest portion of the payment
#' @param end If FALSE, payments are made at the beginning of the period
#'
#' @return Returns the Interest Portion of the Payment in Period "x"
#' @export
#'
#' @examples ipmt(pv = 20000, fv = 0, n = 5 * 12, r = 0.05/12, x = 12, end = TRUE)
ipmt <- function(pv, fv = 0, n, r, x, end = TRUE){

if(end == TRUE){
t <- 0
} else {
t <- 1
}

pmt <- (-pv*(1+r)^n - fv) / ((((1+r)^n-1)/r)*(1+r*t))

if(end == TRUE) {

-r*pv*(1+r)^(x-1) - pmt*((1+r)^(x-1)-1)

}else{

-r*(pv+pmt)*(1+r)^(x-2) - pmt*((1+r)^(x-2)-1)

}
}

#' Principal Payment
#'
#' Calculates the principal of the payment in period "x"
#'
#' @param pv Present Value
#' @param fv Future Value
#' @param n Number of Periods
#' @param r Rate
#' @param x Period in which to calculate the principal portion of the payment
#' @param end If FALSE, payments are made at the beginning of the period
#'
#' @return Returns the Principal Portion of the Payment in Period "x"
#' @export
#'
#' @examples ppmt(pv  = 5000, fv = 0, n = 4 * 12, r = 0.06/12, x = 12, end = TRUE)
ppmt <- function(pv, fv = 0, n, r, x, end = TRUE){

if(end == TRUE){
t <- 0
} else {
t <- 1
}

pmt <- (-pv*(1+r)^n - fv) / ((((1+r)^n-1)/r)*(1+r*t))

if(end == TRUE) {

ipmt <- (-r*pv*(1+r)^(x-1) - pmt*((1+r)^(x-1)-1))

}else{

ipmt <- (-r*(pv+pmt)*(1+r)^(x-2) - pmt*((1+r)^(x-2)-1))

}

pmt - ipmt
}

#' Amortization Schedule
#'
#' Creates an amortization schedule of a loan
#'
#' @param r Rate
#' @param n Number of Periods
#' @param pv Present Value
#' @param fv Future Value, set = 0
#' @param end If FALSE, payments are made at the beginning of the period
#'
#' @return Returns the Amortization Schedule in a dataframe
#' @export
#'
#' @examples schedule(r = 0.06/12, n = 10 * 12, pv = -5000, fv = 0, end = TRUE)
schedule <- function(r, n, pv, fv = 0, end = TRUE) {
Payment_Schedule <- data.frame(Period = c(1:n))
Payment_Schedule\$Payment <- round(-1 * annuity(type = "pmt", n = n, r = r, pv = pv, end = end, fv = fv),2)
Payment_Schedule\$Cum.Pmt <- round(cumsum(Payment_Schedule\$Payment),2)
Payment_Schedule\$Interest <- round(-1 * ipmt(pv = pv, n = n, r = r, x = Payment_Schedule\$Period, fv = fv, end = end),2)
Payment_Schedule\$Cum.Int <- round(cumsum(Payment_Schedule\$Interest),2)
Payment_Schedule\$Principal <- round(-1 * ppmt(pv = pv, n = n, r = r, x = Payment_Schedule\$Period, fv = fv, end = end),2)
Payment_Schedule\$Cum.Prin <- round(cumsum(Payment_Schedule\$Principal),2)
Payment_Schedule\$Rem.Bal <- round(pv - Payment_Schedule\$Cum.Prin,2)

overlay <- c(0, 0, 0, 0, 0, 0, 0, pv)
Payment_Schedule <- rbind(overlay, Payment_Schedule)

Payment_Schedule
}

#' Amortization Schedule With Irregular Payments
#'
#' Creates an amortization schedule of a loan with irregular payments and withdrawals
#'
#' @param payments Vector of payments, the first payment must be 0
#' @param dates Vector of dates, the first date is the date of origination
#' @param apr Annual rate
#' @param pv Present Value
#' @param info Logical, if set to 'TRUE' information about the dataframe arrangement will be printed
#'
#' @return Returns the irregular Amortization Schedule in a Dataframe
#' @export
#'
#' @examples irregular(payments = c(0, 200, -100), dates = c("2019-01-01", "2019-02-08", "2019-03-20"),
#' apr = 0.05, pv = 2000, info = FALSE)
#'
irregular <- function(payments, dates, apr, pv, info = TRUE){

Info <- data.frame(Header = rep(0,10), Details = rep(0,10))
Info\$Details <- "origination date and payment dates"
Info\$Details <- "individual payments"
Info\$Details <- "cumulative payments, running total of payments"
Info\$Details <- "interest portion of payment for the period"
Info\$Details <- "cumulative interest, running total of interest payments"
Info\$Details <- "interest which has accrued between this payment period and the last period"
Info\$Details <- "interest due, interest which has accrued and has yet to be paid"
Info\$Details <- "principal portion of the payments, reduces the balance of the loan"
Info\$Details <- "cumulative principal, running total of the principal payments"
Info\$Details <- "remaining balance of the loan"

if(!payments==0){
stop("The initial payment must be zero. If a payment was made on the origination date,
insert that date again in the 'dates' vector along with the payment in the 'payments' vector")
}

if(length(payments)!=length(dates)){
stop("There is a difference of length between the 'payments' vector and the 'dates' vector.
Remember the first date must be the date of origination and the first payment must
be 0.")
}

dates <- as.Date(dates, origin = "1970-01-01")
Schedule <- data.frame(Dates = dates, Payments = 0, Cum.Pmts = 0, Interest = 0, Cum.Int = 0,
Accrued.Int = 0, Int.Due = 0, Principal = 0, Cum.Prin = 0, Balance = pv)

for(i in 2:length(payments)){
Schedule\$Dates[i] <- dates[i]
Schedule\$Payments[i] <- payments[i]
Schedule\$Cum.Pmts <- cumsum(Schedule\$Payments)

if(payments[i]< ((as.numeric(dates[i])-as.numeric(dates[i-1]))/365
*apr*Schedule\$Balance[i-1]) + Schedule\$Int.Due[i-1]){
Schedule\$Interest[i] <- payments[i]
}else{
Schedule\$Interest[i] <- ((as.numeric(dates[i])-as.numeric(dates[i-1]))/365 *apr*Schedule\$Balance[i-1]
+ Schedule\$Int.Due[i-1])
}
Schedule\$Cum.Int <- cumsum(Schedule\$Interest)
Schedule\$Accrued.Int[i] <- ((as.numeric(dates[i])-as.numeric(dates[i-1]))/365
*apr*Schedule\$Balance[i-1]) #- Schedule\$Cum.Int[i]
Schedule\$Int.Due[i] <-  round(Schedule\$Accrued.Int[i] - Schedule\$Interest[i] + Schedule\$Int.Due[i-1],2)
Schedule\$Principal[i] <- Schedule\$Payments[i]-Schedule\$Interest[i]
Schedule\$Cum.Prin <- cumsum(Schedule\$Principal)

if(payments[i]< (((as.numeric(dates[i])-as.numeric(dates[i-1]))/365
*apr*Schedule\$Balance[i-1]) + Schedule\$Int.Due[i-1])){

Schedule\$Balance[i] <- Schedule\$Balance[i-1] - Schedule\$Principal[i] +
(Schedule\$Accrued.Int[i] - payments[i])

}else{
Schedule\$Balance[i] <- Schedule\$Balance[i-1] - Schedule\$Principal[i]
}

}

Irregular <- list(Info, Schedule)
if(info == TRUE){
print(Irregular)
}else{

print(Schedule)
}

}

#' Effective Annual Rate
#'
#' @param apr Annual Rate (Nominal Interest Rate)
#' @param n Number of compounds in a year
#' @param p Calculates the EAR to the (1/10^p) decimal place
#'
#' @return Effective Annual Rate
#' @export
#'
#' @examples ear(apr= 0.05, n = 12)
ear <- function(apr, n, p = 5){

x <- 0

df <- data.frame(x = seq(0,2,(1/10^p)))
df\$y <- ((1+df\$x)^(1/n)-1)*n
df\$diff <- abs(apr-df\$y)

df[match(min(df\$diff),df\$diff),1]
}
```

## Try the capitalR package in your browser

Any scripts or data that you put into this service are public.

capitalR documentation built on Dec. 1, 2019, 1:23 a.m.