rshinyfinancenumeric-input

R Shiny: Creating X numbers of numericInput boxes equal to number of variables


I'm trying to create a finance-related R Shiny application. As of right now, I have a tab to create a custom portfolio, which requires me to have a numericInput for each variable in the original source_file. This is how the sample source_file looks like:

Date CSI500 Shanghai CSI300 HSI STI
2016-01-01 +5% -2% +5% +10% +12%
2016-01-08 +3% +13% -8% -3% +10%
2016-01-15 +2% +11% -3% +4% -15%

Currently, I have to manually hardcode each numericInput box for each variable like shown:

tabPanel("Custom Portfolio by Weight",
                           sidebarPanel(
                             tags$h3("Create your own Custom Portfolio by Asset Weight"),
                             tags$h4("Input:"),
                             numericInput(inputId = "custom_csi500", "CSI500 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_shanghai", "Shanghai Stock Exchange (%)",  min = 0, max = 100),
                             numericInput(inputId = "custom_csi300", "CSI300 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_hsi", "HSI (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_sti", "STI (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_twse", "TWSE (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_msciw", "MSCI World (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_sp500", "S&P500 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_n225", "Nikkei 225 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_lse", "London Stock Exchange (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_asx", "ASX (%)", min = 0, max = 100),

However, I would like to create something which could be extensible to any dataframe with different numbers of variables I specify without having to manually hard code them in. I hope anyone will be able to help me out to write a code which is able to read the number of variables in my dataframe (except the Date column) and create that many numericInput boxes for each variable. Thank you so much for helping out! I attached my App.R and Global.R below for reference if needed. Cheers!

App.R

# Load packages
library(shiny)
library(shinythemes)
source("./global.R")

# Defining UI
ui <- fluidPage(theme = shinytheme("darkly"),
                navbarPage(
                  "Test App",
                  tabPanel("Custom Portfolio by Weight",
                           sidebarPanel(
                             tags$h3("Create your own Custom Portfolio by Asset Weight"),
                             tags$h4("Input:"),
                             numericInput(inputId = "custom_csi500", "CSI500 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_shanghai", "Shanghai Stock Exchange (%)",  min = 0, max = 100),
                             numericInput(inputId = "custom_csi300", "CSI300 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_hsi", "HSI (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_sti", "STI (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_twse", "TWSE (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_msciw", "MSCI World (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_sp500", "S&P500 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_n225", "Nikkei 225 (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_lse", "London Stock Exchange (%)", min = 0, max = 100),
                             numericInput(inputId = "custom_asx", "ASX (%)", min = 0, max = 100),
                             mainPanel(
                             plotOutput(outputId = "custom_returns"),
                           ), #mainPanel
                ), #tabpanel
                ) #navbarPage
) #fluidPage

server <- function(input, output, session) {

#to output custom_returns for Custom Portfolio by Asset Weight
    output$custom_returns <- renderPlot({
      calculate_portfolio_returns(
        customrange = input$customrange,
        asset_weights = c(input$custom_csi500/100,
          input$custom_shanghai/100,                
          input$custom_csi300/100,
          input$custom_hsi/100,
          input$custom_sti/100,
          input$custom_twse/100,
          input$custom_msciw/100,
          input$custom_sp500/100,
          input$custom_n225/100,
          input$custom_lse/100,
          input$custom_asx/100,
          input$custom_custom/100))
    })
}
  
# Create Shiny Object
  shinyApp(ui = ui, server = server)

Global.R

# Load packages
library(tidyverse)
library(ggcorrplot)
library(zoo)
library(xts)
library(testit)
library(PerformanceAnalytics)

#choose source file to work with
file_name = file.choose()
source_file = read_csv(file_name)
source_file$Date = as.Date(source_file$Date, format = "%Y-%m-%d")

########################
calculate_portfolio_returns = function(customrange, asset_weights)
{
  #filter source file by date range specified
  source_file_filtered <- source_file %>% 
    filter(Date >= customrange[1] & Date <= customrange[2])
  
  source_file_filtered_no_date <- source_file_filtered[,2:length(source_file_filtered)]
  
  #create new column called Cumulative_Returns to convert % daily returns
  Cumulative_Returns <- cumsum(source_file_filtered_no_date)
  
  # Extract necessary parameters
  n_cols = ncol(Cumulative_Returns)
  n_assets = n_cols
  
  #To ensure portfolio is always weighted at 100% at all times
  assert(length(asset_weights) == n_assets)
  assert(abs(sum(asset_weights)-1) <= 0.001)
  
  portfolio_returns = data.matrix(Cumulative_Returns) %*% asset_weights
  portfolio_returns_with_date = cbind(source_file_filtered[,1], portfolio_returns)
  g = ggplot(data = portfolio_returns_with_date, mapping = aes(x=Date, y=portfolio_returns)) +
   geom_line(color="blue") + ggtitle(paste("Custom Portfolio Returns from", customrange[1], "to", customrange[2])) +
   geom_hline(yintercept = 0, linetype = "dashed") + theme(plot.title = element_text(hjust=0.5)) +
    ylab("Portfolio Returns (%)")
  print(g)
}


Solution

  • Here is a demo that may be helpful for you.

    You can upload a .csv file to the shiny app. It will ignore the first column (or you can modify to specifically remove a date column).

    The numeric inputs will be dynamically generated based on the header column names read in.

    The demo has a calc button, that will store the input data and for further processing (calculating returns). Also added a table to show the entered data.

    Edit: If upon pressing the calc button you want to call your custom function (calculate_portfolio_returns), you can add the call to that function in eventReactive, since that is dependent on the input button. To pass on the values from the numeric inputs, you can store these values temporarily in a vector vals, and then pass vals as an argument to the function (see modified code below). In the demo, I call a custom function calc_sum that will print the sum of the numeric inputs in the console. One final note, I added an explicit return at the end of input_vals(), so that vals can be shared for use in output$table.

    library(shiny)
    
    ui <- fluidPage(
      fileInput(inputId = "upload_file", "", accept = '.csv'),
      uiOutput("num_inputs"),
      actionButton("calc", "Calculate"),
      tableOutput("table")
    )
    
    server <- function(input, output, session) {
      
      data <- reactive({
        infile <- input$upload_file
        if (is.null(infile))
          return(NULL)
        read.csv(infile$datapath, header = TRUE, sep = ",")
      })
      
      header_vars <- reactive({
        names(data()[-1])
      })
      
      output$num_inputs <- renderUI({
        vars <- length(header_vars())
        if (vars > 0) {
          div(
            lapply(seq(vars), function(x) {
              numericInput(inputId = paste0("var_", x), label = header_vars()[x], value = 0, min = 0, max = 100)
            })
          )
        }
      })
      
      input_vals <- eventReactive(input$calc, {
        n_vars <- length(header_vars())
        vals <- c()
        if (n_vars > 0) {
          vals <- sapply(seq(n_vars), function(i) {
            input[[paste0("var_", i)]]
          }) 
        }
        calc_sum(vals)
        return(vals)
      })
      
      calc_sum <- function(vals) {
        print(sum(vals))
      }
      
      output$table <- renderTable({
        data.frame(
          vars = header_vars(),
          vals = input_vals()
        )
      })
      
    }
    
    shinyApp(ui = ui, server = server)