r 闪亮的仪表板通过循环单个值
rshiny dashboard by looping individual values
有一个仪表板需要对每个元素选择列表进行分析。
我创建了一个如下的测试设置
需要为各个符号的日期生成图表，如下所示。
从下拉列表中选择日期。此日期的符号列表由 df_rep_date 提供。
迭代此列表并为列表中的符号生成图表，如下所示。
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)
试试这个
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)
有一个仪表板需要对每个元素选择列表进行分析。 我创建了一个如下的测试设置 需要为各个符号的日期生成图表，如下所示。 从下拉列表中选择日期。此日期的符号列表由 df_rep_date 提供。 迭代此列表并为列表中的符号生成图表，如下所示。
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)
试试这个
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)