I am trying to build a basic Shiny App. I have the following fixed variables and a function.
################################
# Fixed variables
mtsSqrd = 10000
rent = 20 # per square foot
# Variables & Assumptions
# in mts squared
operatingExpensesPerc = 10
# general vacancy
vacancy = 0.10
purchasePrice = 1000000
capRate = 0.08
growthRateInc = 0.03
growthRateExp = 0.02
leveragedCapRateTableFunction = function(purchasePrice, capRate, equity){
####################################################
# First year
generalPotentialRev = mtsSqrd * rent
generalVacancy = generalPotentialRev * vacancy
effGrossRev = generalPotentialRev - generalVacancy
operatingExpenses = mtsSqrd * operatingExpensesPerc
netOpInc = effGrossRev - operatingExpenses
# Subsequent years
T = 5
generalPotentialRev_T = generalPotentialRev*(1 growthRateInc)^(1:T)
generalVacancy_T = generalPotentialRev_T * vacancy # we assume the vacancy rate is fixed over the years
effGrossRev_T = generalPotentialRev_T - generalVacancy_T
operatingExpenses_T = operatingExpenses*(1 growthRateExp)^(1:T)
netOpInc_T = effGrossRev_T - operatingExpenses_T
# Valuation at Sale
# NOI at year 6
salePrice = netOpInc_T[T] / capRate
####################################################
#loanToValuePerc = loanToValue
#loanToValue = purchasePrice * loanToValuePerc
#equity = purchasePrice - loanToValue
loanToValue = purchasePrice - equity
interestRate = 0.06
amortisationPeriod = 25 # years
interestRate_monthly = interestRate/12
amortisationPeriod_monthly = amortisationPeriod*12
years = 30
months = years*12
payment = FinCal::pmt(r = interestRate_monthly, n = amortisationPeriod_monthly, pv = loanToValue, fv = 0)
amortTable = FinancialMath::amort.table(Loan = loanToValue, pmt = payment*-1, i = 0.06, ic = 12, pf = 12, plot = FALSE)
amortSchedule = amortTable$Schedule %>%
data.frame() %>%
mutate(
year = rep(1:amortisationPeriod, each = 12)
)
amortScheduleCalcs = amortSchedule %>%
group_by(year) %>%
summarise(
sumInterestPaid = sum(Interest.Paid),
sumPrincipal = sum(Principal.Paid)
) %>%
mutate(
monthlyPayments = sumInterestPaid/12,
#monthlyPrincipal = sumPrincipal/12
InterestPrincipal = sumInterestPaid sumPrincipal,
monthlyInterestPrincipal = InterestPrincipal /12
)
cashFlows = bind_cols(
amortScheduleCalcs[1:6, ],
netOpInc = c(netOpInc, netOpInc_T)
) %>%
mutate(
cashFlowAfterDebtService = netOpInc - InterestPrincipal
)
NOI_Year_6 = cashFlows$netOpInc[6]
mortgageBalanceEOY_5 = amortSchedule$Balance[60]
netSaleProceeds = salePrice - mortgageBalanceEOY_5
# Leveraged returns
cashFlowStreamsLeveraged = c(equity*-1, cashFlows$cashFlowAfterDebtService[1:T-1], cashFlows$cashFlowAfterDebtService[T] netSaleProceeds)
internalRateOfRetrunLeveraged = jrvFinance::irr(cashFlowStreamsLeveraged)
return(internalRateOfRetrunLeveraged)
}
Running the function I can compute the following:
leveragedCapRateTableFunction(purchasePrice = 1000000, equity = 200000, capRate = 0.08)
[1] 0.2908751
However, I want to expand the function over to different combinations/scenarios of the capRate and purchasePrice. (Keeping the equity variable fixed.
In R I can define a new perc increase / decrease function and use expand grid to create the different combinations
percDecreaseIncreaseFunction = function(x, perc = perc, decrease = TRUE){
if(decrease == TRUE){
out = x (x * - perc)
} else {
out = x (x * perc)
}
return(out)
}
unleveragedCapRates = expand_grid(
propertyPrices = c(percDecreaseIncreaseFunction(purchasePrice, 0.10, FALSE),
percDecreaseIncreaseFunction(purchasePrice, 0.05, FALSE),
purchasePrice,
percDecreaseIncreaseFunction(purchasePrice, 0.05, TRUE),
percDecreaseIncreaseFunction(purchasePrice, 0.10, TRUE)),
capRates = c(
percDecreaseIncreaseFunction(capRate, 0.10, FALSE),
percDecreaseIncreaseFunction(capRate, 0.05, FALSE),
capRate,
percDecreaseIncreaseFunction(capRate, 0.05, TRUE),
percDecreaseIncreaseFunction(capRate, 0.10, TRUE)
))
However, when I try to use pmap I
- can't get it to work in R.
pmap(list( ...1 = leveragedCapRates$propertyPrices, ...2 = leveragedCapRates$capRates, ...3 = equity, ), ~leveragedCapRateTableFunction(..1, ..2, ..3) ) unlist() %>% matrix(ncol = 5, byrow = FALSE) %>% data.frame() %>% set_names(unique(leveragedCapRates$propertyPrices)) %>% add_column(capRates = unique(leveragedCapRates$capRates)) %>% relocate(capRates, everything()) %>% round(4)
- How can I pass an
input$equitywhen I pass it through aneventReactive()?
In the following App.R - I am having difficulty at the following point in the eventReactive() part of the server function.
pmap(list(
...1 = unleveredInputs()$propertyPrices,
...2 = unleveredInputs()$capRates,
...3 = input$equity,
),
~leveragedCapRateTableFunction(..1, ..2, ..3)
The output should be a 5 x 5 matrix looking something like (but not the same numbers)
Code / App.R
library(tidyverse)
library(shiny)
library(shinyWidgets)
################################
# Fixed variables
mtsSqrd = 10000
rent = 20 # per square foot
# Variables & Assumptions
# in mts squared
operatingExpensesPerc = 10
# general vacancy
vacancy = 0.10
purchasePrice = 1000000
capRate = 0.08
growthRateInc = 0.03
growthRateExp = 0.02
#leveragedCapRateTableFunction(purchasePrice = 1000000, equity = 200000, capRate = 0.08)
leveragedCapRateTableFunction = function(purchasePrice, capRate, equity){
####################################################
# First year
generalPotentialRev = mtsSqrd * rent
generalVacancy = generalPotentialRev * vacancy
effGrossRev = generalPotentialRev - generalVacancy
operatingExpenses = mtsSqrd * operatingExpensesPerc
netOpInc = effGrossRev - operatingExpenses
# Subsequent years
T = 5
generalPotentialRev_T = generalPotentialRev*(1 growthRateInc)^(1:T)
generalVacancy_T = generalPotentialRev_T * vacancy # we assume the vacancy rate is fixed over the years
effGrossRev_T = generalPotentialRev_T - generalVacancy_T
operatingExpenses_T = operatingExpenses*(1 growthRateExp)^(1:T)
netOpInc_T = effGrossRev_T - operatingExpenses_T
# Valuation at Sale
# NOI at year 6
salePrice = netOpInc_T[T] / capRate
####################################################
#loanToValuePerc = loanToValue
#loanToValue = purchasePrice * loanToValuePerc
#equity = purchasePrice - loanToValue
loanToValue = purchasePrice - equity
interestRate = 0.06
amortisationPeriod = 25 # years
interestRate_monthly = interestRate/12
amortisationPeriod_monthly = amortisationPeriod*12
years = 30
months = years*12
payment = FinCal::pmt(r = interestRate_monthly, n = amortisationPeriod_monthly, pv = loanToValue, fv = 0)
amortTable = FinancialMath::amort.table(Loan = loanToValue, pmt = payment*-1, i = 0.06, ic = 12, pf = 12, plot = FALSE)
amortSchedule = amortTable$Schedule %>%
data.frame() %>%
mutate(
year = rep(1:amortisationPeriod, each = 12)
)
amortScheduleCalcs = amortSchedule %>%
group_by(year) %>%
summarise(
sumInterestPaid = sum(Interest.Paid),
sumPrincipal = sum(Principal.Paid)
) %>%
mutate(
monthlyPayments = sumInterestPaid/12,
#monthlyPrincipal = sumPrincipal/12
InterestPrincipal = sumInterestPaid sumPrincipal,
monthlyInterestPrincipal = InterestPrincipal /12
)
cashFlows = bind_cols(
amortScheduleCalcs[1:6, ],
netOpInc = c(netOpInc, netOpInc_T)
) %>%
mutate(
cashFlowAfterDebtService = netOpInc - InterestPrincipal
)
NOI_Year_6 = cashFlows$netOpInc[6]
mortgageBalanceEOY_5 = amortSchedule$Balance[60]
netSaleProceeds = salePrice - mortgageBalanceEOY_5
# Leveraged returns
cashFlowStreamsLeveraged = c(equity*-1, cashFlows$cashFlowAfterDebtService[1:T-1], cashFlows$cashFlowAfterDebtService[T] netSaleProceeds)
internalRateOfRetrunLeveraged = jrvFinance::irr(cashFlowStreamsLeveraged)
return(internalRateOfRetrunLeveraged)
}
percDecreaseIncreaseFunction = function(x, perc = perc, decrease = TRUE){
if(decrease == TRUE){
out = x (x * - perc)
} else {
out = x (x * perc)
}
return(out)
}
ui <- fluidPage(
tags$h2("Change shiny app background"),
setBackgroundColor("white"),
# Application title
titlePanel("Internal Rate of Return Computations"),
fluidRow(
column(3,
numericInput("purchasePrice", label = "Price?", value = 1000000, min = 1),
numericInput("equity", label = "Equity?", value = 200000, min = 1), # the max should be dependent on the max of the purchasePrice input
numericInput("capRate", label = "Capital Expenditure?", value = 0.08, min = 0, max = 1, step = 0.01),
actionButton("computeIRR", "Compute IRR!")
),
column(9,
dataTableOutput(("leveredirrTable"))
)
)
)
################################################################################
server <- function(input, output) {
############ Unlevereaged inputs #########################################
unleveredInputs <- eventReactive(input$computeIRR, {
expand_grid(
propertyPrices = c(
percDecreaseIncreaseFunction(x = input$purchasePrice, 0.10, FALSE),
percDecreaseIncreaseFunction(input$purchasePrice, 0.05, FALSE),
input$purchasePrice,
percDecreaseIncreaseFunction(input$purchasePrice, 0.05, TRUE),
percDecreaseIncreaseFunction(input$purchasePrice, 0.10, TRUE)
),
capRates = c(
percDecreaseIncreaseFunction(input$capRate, 0.10, FALSE),
percDecreaseIncreaseFunction(input$capRate, 0.05, FALSE),
input$capRate,
percDecreaseIncreaseFunction(input$capRate, 0.05, TRUE),
percDecreaseIncreaseFunction(input$capRate, 0.10, TRUE)
)
# equity = c(
# input$equity
# )
) %>%
data.frame()
})
leveredIRR <- eventReactive(unleveredInputs(), {
req(unleveredInputs())
pmap(list(
...1 = unleveredInputs()$propertyPrices,
...2 = unleveredInputs()$capRates,
...3 = input$equity,
),
~leveragedCapRateTableFunction(..1, ..2, ..3)
) %>%
unlist() %>%
matrix(ncol = 5, byrow = FALSE) %>%
data.frame() %>%
set_names(unique(unleveredInputs()$equity)) %>%
add_column(capRates = unique(unleveredInputs()$capRates)) %>%
relocate(capRates, everything()) %>%
round(4)
})
output$leveredirrTable <- renderDataTable(leveredIRR(), options = list(pageLength = 5))
observeEvent(unleveredInputs(), {
print(leveredIRR())
})
}
shinyApp(ui = ui, server = server)
CodePudding user response：
Try this
server <- function(input, output, session) {
############ Unlevereaged inputs #########################################
unleveredInputs <- eventReactive(input$computeIRR, {
expand_grid(
propertyPrices = c(
percDecreaseIncreaseFunction(x = input$purchasePrice, 0.10, FALSE),
percDecreaseIncreaseFunction(input$purchasePrice, 0.05, FALSE),
input$purchasePrice,
percDecreaseIncreaseFunction(input$purchasePrice, 0.05, TRUE),
percDecreaseIncreaseFunction(input$purchasePrice, 0.10, TRUE)
),
capRates = c(
percDecreaseIncreaseFunction(input$capRate, 0.10, FALSE),
percDecreaseIncreaseFunction(input$capRate, 0.05, FALSE),
input$capRate,
percDecreaseIncreaseFunction(input$capRate, 0.05, TRUE),
percDecreaseIncreaseFunction(input$capRate, 0.10, TRUE)
)
, equity = c(
input$equity
)
) %>%
data.frame()
})
leveredIRR <- eventReactive(unleveredInputs(), {
req(unleveredInputs())
A = unleveredInputs()$propertyPrices
B = unleveredInputs()$capRates
C = input$equity
vars <- list(A, B, C)
pmap(vars, ~leveragedCapRateTableFunction(..1, ..2, ..3)
) %>%
unlist() %>%
matrix(ncol = 5, byrow = FALSE) %>%
data.frame() %>%
set_names(unique(unleveredInputs()$equity)) %>%
add_column(capRates = unique(unleveredInputs()$capRates)) %>%
relocate(capRates, everything()) %>%
round(4)
})
output$leveredirrTable <- renderDataTable(leveredIRR(), options = list(pageLength = 5))
observeEvent(unleveredInputs(), {
print(leveredIRR())
})
}
