I have the following code which gives me an output as a table:
Code:
library(tidyverse)
################################
# 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
unleveragedCapRateTableFunction = function(purchasePrice, capRate){
generalPotentialRev = mtsSqrd * rent
generalVacancy = generalPotentialRev * vacancy
effGrossRev = generalPotentialRev - generalVacancy
operatingExpenses = mtsSqrd * operatingExpensesPerc
netOpInc = effGrossRev - operatingExpenses
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
salePrice = netOpInc_T[T] / capRate
cashFlowOperations = c(netOpInc, netOpInc_T)[1:T]
cashFlowStreams = c(purchasePrice*-1, cashFlowOperations[1:T-1], cashFlowOperations[T] + salePrice)
internalRateOfRetrun = jrvFinance::irr(cashFlowStreams)
return(internalRateOfRetrun)
}
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)
))
map2(
.x = unleveragedCapRates$propertyPrices,
.y = unleveragedCapRates$capRates,
~unleveragedCapRateTableFunction(purchasePrice = .x, capRate = .y)
) %>%
unlist() %>%
matrix(ncol = 5, byrow = FALSE) %>%
data.frame() %>%
set_names(unique(unleveragedCapRates$propertyPrices)) %>%
add_column(capRates = unique(unleveragedCapRates$capRates)) %>%
relocate(capRates, everything()) %>%
round(4)
Output:
capRates 1100000 1050000 1000000 950000 900000
1 0.088 0.0697 0.0813 0.0936 0.1067 0.1208
2 0.084 0.0776 0.0892 0.1016 0.1148 0.1289
3 0.080 0.0860 0.0977 0.1101 0.1234 0.1376
4 0.076 0.0950 0.1068 0.1192 0.1326 0.1469
5 0.072 0.1047 0.1165 0.1290 0.1424 0.1568
However, when I try to include this function into a Shiny App I get a different result.
Shiny App:
library(tidyverse)
library(shiny)
library(shinyWidgets)
################################
# Shiny edits
setBackgroundColor(
color = "black",
gradient = c("linear", "radial"),
direction = c("bottom", "top", "right", "left"),
shinydashboard = FALSE
)
################################
# 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
unleveragedCapRateTableFunction = function(purchasePrice, capRate){
generalPotentialRev = mtsSqrd * rent
generalVacancy = generalPotentialRev * vacancy
effGrossRev = generalPotentialRev - generalVacancy
operatingExpenses = mtsSqrd * operatingExpensesPerc
netOpInc = effGrossRev - operatingExpenses
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
salePrice = netOpInc_T[T] / capRate
cashFlowOperations = c(netOpInc, netOpInc_T)[1:T]
cashFlowStreams = c(purchasePrice*-1, cashFlowOperations[1:T-1], cashFlowOperations[T] + salePrice)
internalRateOfRetrun = jrvFinance::irr(cashFlowStreams)
return(internalRateOfRetrun)
}
######################################################################
unleveragedCapRateTableFunction(purchasePrice = 1000000, capRate = 0.08)
percDecreaseIncreaseFunction = function(x, perc = perc, decrease = TRUE){
if(decrease == TRUE){
out = x + (x * - perc)
} else {
out = x + (x * perc)
}
return(out)
}
# Define UI for application that draws a histogram
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("capRate", label = "Capital Expenditure?", value = 0.08, min = 0, max = 1, step = 0.01),
actionButton("computeIRR", "Compute IRR!")
),
column(9,
dataTableOutput(("irrTable")),
dataTableOutput(("irrInputsTable"))
#textOutput({"irrTable"})
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
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)
)) %>%
data.frame()
})
# observeEvent(unleveredInputs(), {
# print(unleveredInputs())
# })
unleveredIRR <- eventReactive(unleveredInputs(), {
req(unleveredInputs())
map2(
.x = unleveredInputs()$propertyPrices,
.y = unleveredInputs()$capRates,
~unleveragedCapRateTableFunction(purchasePrice = .x, capRate = .y)
) %>%
unlist() %>%
matrix(ncol = 5, byrow = FALSE) %>%
data.frame() %>%
set_names(unique(unleveredInputs()$propertyPrices)) %>%
add_column(capRates = unique(unleveredInputs()$capRates)) %>%
relocate(capRates, everything()) %>%
round(4)
})
output$irrTable <- renderDataTable(unleveredIRR(), options = list(pageLength = 5))
output$irrInputsTable <- renderDataTable(unleveredInputs(), options = list(pageLength = 25))
# unleveredIRR <- eventReactive(input$computeIRR, {
# unleveragedCapRateTableFunction(purchasePrice = input$purchasePrice, capRate = input$capRate)
# })
#output$irrTable <- renderText(unleveredIRR())
}
# Run the application
shinyApp(ui = ui, server = server)
Where am I going wrong in the Shiny App? It runs and computes a table after clicking the COmpute IRR! button. However, using the default values I don't get the same table...
Table from Shiny App:
capRates 1100000 1050000 1000000 950000 900000
0.088 0.0812 0.0928 0.1052 0.1185 0.1327
0.084 0.0892 0.1009 0.1134 0.1267 0.1409
0.08 0.0977 0.1095 0.122 0.1354 0.1497
0.076 0.1068 0.1187 0.1313 0.1447 0.1591
0.072 0.1166 0.1285 0.1412 0.1547 0.1692
EDIT:
Output from Shiny:
EDIT2:
Added sessionInfo()
> sessionInfo()
R version 3.5.0 (2018-04-23)
Platform: x86_64-suse-linux-gnu (64-bit)
Running under: openSUSE Leap 15.3
Matrix products: default
BLAS: /usr/lib64/R/lib/libRblas.so
LAPACK: /usr/lib64/R/lib/libRlapack.so
locale:
[1] LC_CTYPE=es_ES.UTF-8 LC_NUMERIC=C LC_TIME=ca_ES.UTF-8 LC_COLLATE=ca_ES.UTF-8 LC_MONETARY=ca_ES.UTF-8 LC_MESSAGES=es_ES.UTF-8
[7] LC_PAPER=es_ES.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C LC_MEASUREMENT=ca_ES.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] shinyWidgets_0.6.2 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.9 purrr_0.3.4 readr_2.1.1 tidyr_1.2.0 tibble_3.1.7
[9] ggplot2_3.3.6 tidyverse_1.3.1 shiny_1.7.2
loaded via a namespace (and not attached):
[1] Rcpp_1.0.8.3 lubridate_1.8.0 assertthat_0.2.1 digest_0.6.29 utf8_1.2.2 mime_0.12 R6_2.5.1 cellranger_1.1.0
[9] plyr_1.8.6 backports_1.4.0 reprex_2.0.1 httr_1.4.2 pillar_1.7.0 rlang_1.0.5 readxl_1.3.1 rstudioapi_0.13
[17] jquerylib_0.1.4 FinCal_0.6.3 bit_4.0.4 RCurl_1.98-1.4 munsell_0.5.0 broom_0.7.10 compiler_3.5.0 httpuv_1.6.3
[25] modelr_0.1.8 pkgconfig_2.0.3 htmltools_0.5.2 sourcetools_0.1.7 tidyselect_1.1.2 fansi_1.0.3 crayon_1.5.1 tzdb_0.2.0
[33] dbplyr_2.1.1 withr_2.5.0 later_1.3.0 bitops_1.0-7 grid_3.5.0 jsonlite_1.7.2 xtable_1.8-4 gtable_0.3.0
[41] lifecycle_1.0.1 DBI_1.1.2 jrvFinance_1.4.3 magrittr_2.0.3 scales_1.2.0 vroom_1.5.7 cli_3.3.0 stringi_1.7.6
[49] cachem_1.0.6 reshape2_1.4.4 fs_1.5.2 promises_1.2.0.1 xml2_1.3.2 bslib_0.3.1 ellipsis_0.3.2 generics_0.1.2
[57] vctrs_0.4.1 FinancialMath_0.1.1 tools_3.5.0 bit64_4.0.5 glue_1.6.2 hms_1.1.1 parallel_3.5.0 fastmap_1.1.0
[65] colorspace_2.0-3 rvest_1.0.2 haven_2.4.3 sass_0.4.0