Search code examples
rshinyquantmodshinyapps

rshiny dashboard by looping individual values

There is one dashboard where need to put the analysis for each of the element selected list. I have created a setup as below fot testing Need to generate the graphs for the date for the individual symbols as shown below. The date is selected from the drop down. The list of symbols is provided by df_rep_date for this date. This list is iterated and the graph is genereated for the symbols in the list as shown below.

install.packages('quantmod')
library('quantmod')

getSymbols("AAPL",  from = "2020/01/01",to = Sys.Date(), periodicity = "daily")
getSymbols("MSFT",  from = "2020/01/01",to = Sys.Date(), periodicity = "daily")
getSymbols("FB",  from = "2020/01/01",to = Sys.Date(), periodicity = "daily")
getSymbols("ORCL",  from = "2020/01/01",to = Sys.Date(), periodicity = "daily")
df_AAPL <- as.data.frame(AAPL)
df_AAPL$DATE <- index(AAPL)    
rownames(df_AAPL) <- NULL
names(df_AAPL) <- c('OPEN','HIGH','LOW','CLOSE','VOLUME','ADJUSTED','DATE')
df_AAPL$SYMBOL <- 'AAPL'

df_MSFT <- as.data.frame(MSFT)
df_MSFT$DATE <- index(MSFT)    
rownames(df_MSFT) <- NULL
names(df_MSFT) <- c('OPEN','HIGH','LOW','CLOSE','VOLUME','ADJUSTED','DATE')
df_MSFT$SYMBOL <- 'MSFT'

df_FB <- as.data.frame(FB)
df_FB$DATE <- index(FB)    
rownames(df_FB) <- NULL
names(df_FB) <- c('OPEN','HIGH','LOW','CLOSE','VOLUME','ADJUSTED','DATE')
df_FB$SYMBOL <- 'FB'

df_ORCL <- as.data.frame(ORCL)
df_ORCL$DATE <- index(ORCL)    
rownames(df_ORCL) <- NULL
names(df_ORCL) <- c('OPEN','HIGH','LOW','CLOSE','VOLUME','ADJUSTED','DATE')
df_ORCL$SYMBOL <- 'ORCL'

df_all <- rbind(df_AAPL, df_MSFT,df_FB,df_ORCL)
df_all[, c('SYMBOL','DATE','OPEN','HIGH','LOW','CLOSE','VOLUME','ADJUSTED')]
library(shiny)
#unique(df_all$DATE)
df_rep_date <- data.frame('RunDate'= character(),'ListStocks' = character(), stringsAsFactors=FALSE)
df_rep_date[1,] <-    c("2020-01-06", 'AAPL,MSFT')
df_rep_date[2,] <-    c("2021-01-04",'ORCL,AAPL')
df_rep_date[3,] <-    c("2022-01-04", 'FB,ORCL')
df_rep_date$RunDate <- as.Date(df_rep_date$RunDate)
v_lst_sel_dates <-c(df_rep_date$RunDate) 

func_1symb_plot <- function(p_symb){
    p_symb = 'AAPL'
    df_tmp_hist_dat = df_all[df_all$SYMBOL == p_symb,c("DATE" ,"OPEN","HIGH","LOW" ,"CLOSE","VOLUME" )]
    v_df_dly_dat_6mnth_xts <-  xts(df_tmp_hist_dat[, -1], order.by = df_tmp_hist_dat[, 1])
    v_grph_op <- candleChart( v_df_dly_dat_6mnth_xts,name = v_symb, type = "auto", up.col = "green", dn.col = "red",
                              theme = "white",plot = TRUE,TA = "addVo();addSMA(n = 1, on = 1, overlay = TRUE, col ='black');
    addSMA(n = 7, on = 1, overlay = TRUE, col ='gold'); addSMA(n = 14, on = 1, overlay = TRUE, col ='brown');addMACD(); addBBands();addRSI();addOBV();")
    return(v_grph_op)}


simpUI <- function(id) {
    tagList(selectInput(NS(id, 'RunDate'), "Run Date", v_lst_sel_dates),
            textOutput(NS(id,'date_output')),
            textOutput(NS(id,'lst_symb_output')),
            textOutput(NS(id,'test_text'))),
    fluidPage( for (v_symb in lst_symb_output){
        renderTex('v_symb_name')
        plotOutput(v_symb)
    })
    
    
    simpServer <- function(id) {
        moduleServer(id, function(input, output, session) {
            string <- reactive(input$RunDate)
            output$date_output <- renderText(string())
            v_lst_symbol <- reactive(df_rep_date[df_rep_date$RunDate == input$RunDate,]$ListStocks)
            output$lst_symb_output <- renderText(v_lst_symbol())
            for (v_symb in v_lst_symbol()){
                v_symb_name = paste0(v_symb, '_name')
                output$v_symb_name = v_symb
                output$v_symb <- renderPlot(func_1symb_plot(v_symb))
            }
        })
    }
    
    ui <- fluidPage(fluidRow(simpUI("par1")))
    
    server <- function(input, output, session) {
        simpServer("par1")
    }
    shinyApp(ui =  ui, server = server)
Solution

  • Try this

    df_rep_date <- data.frame('RunDate'= character(),'ListStocks' = character(), stringsAsFactors=FALSE)
df_rep_date[1,] <-    c("2020-01-06", 'AAPL')
df_rep_date[2,] <-    c("2021-01-04", 'ORCL')
df_rep_date[3,] <-    c("2022-01-04", 'FB,MSFT')
#df_rep_date[4,] <-    c("2022-01-07", 'MSFT')
df_rep_date$RunDate <- as.Date(df_rep_date$RunDate)
v_lst_sel_dates <-c(df_rep_date$RunDate) 

func_1symb_plot <- function(p_symb){
  #p_symb = 'AAPL'
  df_tmp_hist_dat = df_all[df_all$SYMBOL == p_symb,c("DATE" ,"OPEN","HIGH","LOW" ,"CLOSE","VOLUME" )]
  v_df_dly_dat_6mnth_xts <-  xts(df_tmp_hist_dat[, -1], order.by = df_tmp_hist_dat[, 1])
  v_grph_op <- candleChart( v_df_dly_dat_6mnth_xts,name = p_symb, type = "auto", up.col = "green", dn.col = "red",
                            theme = "white",plot = TRUE,TA = "addVo();addSMA(n = 1, on = 1, overlay = TRUE, col ='black');
    addSMA(n = 7, on = 1, overlay = TRUE, col ='gold'); addSMA(n = 14, on = 1, overlay = TRUE, col ='brown');addMACD(); addBBands();addRSI();addOBV();")
  return(v_grph_op)}


simpUI <- function(id) {
  tagList(selectInput(NS(id, 'RunDate'), "Run Date", v_lst_sel_dates),
          textOutput(NS(id,'date_output')),
          textOutput(NS(id,'lst_symb_output')),
          uiOutput(NS(id,"myplot"))
  )
}
  
simpServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    string <- reactive(input$RunDate)
    output$date_output <- renderText(string())
    v_lst_symbol <- reactive(df_rep_date[df_rep_date$RunDate == input$RunDate,]$ListStocks)
    output$lst_symb_output <- renderText(v_lst_symbol())
    observeEvent(input$RunDate, {
      print(v_lst_symbol())
      symbs <- read.table(text = v_lst_symbol(), sep = ",", colClasses = "character")
      print(symbs)
      lapply(symbs[1,], function(v_symb){
        v_symb_name = paste0(v_symb, '_name')
        output[[paste0(v_symb, '_name')]] = renderText(v_symb_name)
        output[[paste0(v_symb, '_plot')]] <- renderPlot(func_1symb_plot(v_symb))
      })
    })
    
    output$myplot <- renderUI({
      symbs <- read.table(text = v_lst_symbol(), sep = ",", colClasses = "character")
      tagList(
        lapply(symbs[1,], function(v_symb){
          id1 <- paste0(v_symb, '_name')
          id2 <- paste0(v_symb, '_plot')
          textOutput(ns(id1))
          plotOutput(ns(id2))
        })
      )
    })
    
  })
}

ui <- fluidPage(fluidRow(simpUI("par1")))

server <- function(input, output, session) {
  simpServer("par1")
}
shinyApp(ui =  ui, server = server)

    output