我尝试使用R&#39的Shiny软件包创建应用程序,该软件包从Fred通过Quantmod提取时间序列 - 有点类似于使用Yahoo的示例(请参阅http://shiny.rstudio.com/tutorial/lesson6/处的stockVis)。 / p>
我想要的东西是Fred可供选择的系列列表。所以我希望用户能够指定时间序列频率和季节性调整的类型 - 而不是让用户猜测正确的代码。
经过大量的摆弄,我有一些功能,但我遇到的问题是它依赖于Fred在CSV下载中提供的信息文件,大文本文件是36MB。
这需要很长时间才能加载并准备好在应用中使用。我确信必须有更好的方法来做到这一点,花更少的时间;到目前为止,我已尝试fread()
,readRDS()
,并且最近尝试使用RSQlite
包。似乎没有解决长时间的延迟 - 太长而不实用,虽然一旦加载就可以很好地工作。
这里是代码: ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Download Fred Data"),
sidebarLayout(
sidebarPanel(
selectInput(
"freq", "Data Frequency",
c("Daily" = "D","Weekly" = "W","Bi-Weekly" = "BW","Monthly" = "M",
"Quarterly" = "Q","Semi-Annual" = "SA","Annual" = "A"),
selected="Q"),
selectInput(
"adj", "Data Adjustment",
c("Seasonally Adjusted" = "SA","Not Seasonally Adjusted" = "NSA",
"Seasonally Adjusted Annual Rate" = "SAAR","Smoothed Seasonally Adjusted" = "SSA",
"Not Applicable" = "NA"),
selected="SA"),
conditionalPanel(
condition = "input.freq == 'Q' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codeqsa", "Data series",
c(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codeqnsa", "Data series",
c(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codeqsaar", "Data series",
c(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codeqssa", "Data series",
c(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codeqna", "Data series",
c(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="Q" & fred.files$sa=="NA"],1)))),
conditionalPanel(
condition = "input.freq == 'M' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codemsa", "Data series",
c(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codemnsa", "Data series",
c(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codemsaar", "Data series",
c(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codemssa", "Data series",
c(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codemna", "Data series",
c(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="M" & fred.files$sa=="NA"],1)))),
conditionalPanel(
condition = "input.freq == 'A' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codeasa", "Data series",
c(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codeansa", "Data series",
c(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codeasaar", "Data series",
c(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codeassa", "Data series",
c(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codeana", "Data series",
c(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="A" & fred.files$sa=="NA"],1)))),
conditionalPanel(
condition = "input.freq == 'SA' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codesasa", "Data series",
c(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codesansa", "Data series",
c(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codesasaar", "Data series",
c(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codesassa", "Data series",
c(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codesana", "Data series",
c(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="SA" & fred.files$sa=="NA"],1)))),
conditionalPanel(
condition = "input.freq == 'D' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codedsa", "Data series",
c(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codednsa", "Data series",
c(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codedsaar", "Data series",
c(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codedssa", "Data series",
c(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codedna", "Data series",
c(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="D" & fred.files$sa=="NA"],1)))),
conditionalPanel(
condition = "input.freq == 'W' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codewsa", "Data series",
c(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codewnsa", "Data series",
c(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codewsaar", "Data series",
c(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codewssa", "Data series",
c(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codewna", "Data series",
c(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="W" & fred.files$sa=="NA"],1)))),
conditionalPanel(
condition = "input.freq == 'BW' ",
conditionalPanel(condition="input.adj == 'SA' ",
selectInput(
"codebwsa", "Data series",
c(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="SA"]),
selected=head(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="SA"],1))),
conditionalPanel(condition="input.adj == 'NSA' ",
selectInput(
"codebwnsa", "Data series",
c(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="NSA"]),
selected=head(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="NSA"],1))),
conditionalPanel(condition="input.adj == 'SAAR' ",
selectInput(
"codebwsaar", "Data series",
c(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="SAAR"]),
selected=head(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="SAAR"],1))),
conditionalPanel(condition="input.adj == 'SSA' ",
selectInput(
"codebwssa", "Data series",
c(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="SSA"]),
selected=head(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="SSA"],1))),
conditionalPanel(condition="input.adj == 'NA' ",
selectInput(
"codebwna", "Data series",
c(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="NA"]),
selected=head(fred.files$desc[fred.files$freq=="BW" & fred.files$sa=="NA"],1))))
),
mainPanel(
verbatimTextOutput("summary"),
plotOutput('plot')
)
)
))
server.R:
library(shiny)
library(zoo)
library(quantmod)
shinyServer(function(input, output) {
datasetInput <- reactive({
dataset <- new.env()
list.index <- fred.files[input$freq==fred.files$freq & input$adj==fred.files$sa,]
if(input$freq=="M" && input$adj=="SA") {fred.code <- input$codemsa}
if(input$freq=="M" && input$adj=="NSA") {fred.code <- input$codemnsa}
if(input$freq=="M" && input$adj=="SAAR") {fred.code <- input$codemsaar}
if(input$freq=="M" && input$adj=="SSA") {fred.code <- input$codemssa}
if(input$freq=="M" && input$adj=="NA") {fred.code <- input$codemna}
if(input$freq=="Q" && input$adj=="SA") {fred.code <- input$codeqsa}
if(input$freq=="Q" && input$adj=="NSA") {fred.code <- input$codeqnsa}
if(input$freq=="Q" && input$adj=="SAAR") {fred.code <- input$codeqsaar}
if(input$freq=="Q" && input$adj=="SSA") {fred.code <- input$codeqssa}
if(input$freq=="Q" && input$adj=="NA") {fred.code <- input$codeqna}
if(input$freq=="SA" && input$adj=="SA") {fred.code <- input$codesasa}
if(input$freq=="SA" && input$adj=="NSA") {fred.code <- input$codesansa}
if(input$freq=="SA" && input$adj=="SAAR") {fred.code <- input$codesasaar}
if(input$freq=="SA" && input$adj=="SSA") {fred.code <- input$codesassa}
if(input$freq=="SA" && input$adj=="NA") {fred.code <- input$codesana}
if(input$freq=="A" && input$adj=="SA") {fred.code <- input$codeasa}
if(input$freq=="A" && input$adj=="NSA") {fred.code <- input$codeansa}
if(input$freq=="A" && input$adj=="SAAR") {fred.code <- input$codeasaar}
if(input$freq=="A" && input$adj=="SSA") {fred.code <- input$codeassa}
if(input$freq=="A" && input$adj=="NA") {fred.code <- input$codeana}
if(input$freq=="D" && input$adj=="SA") {fred.code <- input$codedsa}
if(input$freq=="D" && input$adj=="NSA") {fred.code <- input$codednsa}
if(input$freq=="D" && input$adj=="SAAR") {fred.code <- input$codedsaar}
if(input$freq=="D" && input$adj=="SSA") {fred.code <- input$codedssa}
if(input$freq=="D" && input$adj=="NA") {fred.code <- input$codedna}
if(input$freq=="W" && input$adj=="SA") {fred.code <- input$codewsa}
if(input$freq=="W" && input$adj=="NSA") {fred.code <- input$codewnsa}
if(input$freq=="W" && input$adj=="SAAR") {fred.code <- input$codewsaar}
if(input$freq=="W" && input$adj=="SSA") {fred.code <- input$codewssa}
if(input$freq=="W" && input$adj=="NA") {fred.code <- input$codewna}
if(input$freq=="BW" && input$adj=="SA") {fred.code <- input$codebwsa}
if(input$freq=="BW" && input$adj=="NSA") {fred.code <- input$codebwnsa}
if(input$freq=="BW" && input$adj=="SAAR") {fred.code <- input$codebwsaar}
if(input$freq=="BW" && input$adj=="SSA") {fred.code <- input$codebwssa}
if(input$freq=="BW" && input$adj=="NA") {fred.code <- input$codebwna}
data.code <- head(list.index$file[list.index$desc==fred.code & is.na(list.index$desc)==F],1)
data.series.info <- list.index[list.index$desc==fred.code,]
getSymbols(data.code,src='FRED',return.class="zoo",env=dataset)
m <- get(data.code,dataset)
})
output$summary <- renderPrint({
list.index <- fred.files[input$freq==fred.files$freq & input$adj==fred.files$sa,]
if(input$freq=="M" && input$adj=="SA") {fred.code <- input$codemsa}
if(input$freq=="M" && input$adj=="NSA") {fred.code <- input$codemnsa}
if(input$freq=="M" && input$adj=="SAAR") {fred.code <- input$codemsaar}
if(input$freq=="M" && input$adj=="SSA") {fred.code <- input$codemssa}
if(input$freq=="M" && input$adj=="NA") {fred.code <- input$codemna}
if(input$freq=="Q" && input$adj=="SA") {fred.code <- input$codeqsa}
if(input$freq=="Q" && input$adj=="NSA") {fred.code <- input$codeqnsa}
if(input$freq=="Q" && input$adj=="SAAR") {fred.code <- input$codeqsaar}
if(input$freq=="Q" && input$adj=="SSA") {fred.code <- input$codeqssa}
if(input$freq=="Q" && input$adj=="NA") {fred.code <- input$codeqna}
if(input$freq=="SA" && input$adj=="SA") {fred.code <- input$codesasa}
if(input$freq=="SA" && input$adj=="NSA") {fred.code <- input$codesansa}
if(input$freq=="SA" && input$adj=="SAAR") {fred.code <- input$codesasaar}
if(input$freq=="SA" && input$adj=="SSA") {fred.code <- input$codesassa}
if(input$freq=="SA" && input$adj=="NA") {fred.code <- input$codesana}
if(input$freq=="A" && input$adj=="SA") {fred.code <- input$codeasa}
if(input$freq=="A" && input$adj=="NSA") {fred.code <- input$codeansa}
if(input$freq=="A" && input$adj=="SAAR") {fred.code <- input$codeasaar}
if(input$freq=="A" && input$adj=="SSA") {fred.code <- input$codeassa}
if(input$freq=="A" && input$adj=="NA") {fred.code <- input$codeana}
if(input$freq=="D" && input$adj=="SA") {fred.code <- input$codedsa}
if(input$freq=="D" && input$adj=="NSA") {fred.code <- input$codednsa}
if(input$freq=="D" && input$adj=="SAAR") {fred.code <- input$codedsaar}
if(input$freq=="D" && input$adj=="SSA") {fred.code <- input$codedssa}
if(input$freq=="D" && input$adj=="NA") {fred.code <- input$codedna}
if(input$freq=="W" && input$adj=="SA") {fred.code <- input$codewsa}
if(input$freq=="W" && input$adj=="NSA") {fred.code <- input$codewnsa}
if(input$freq=="W" && input$adj=="SAAR") {fred.code <- input$codewsaar}
if(input$freq=="W" && input$adj=="SSA") {fred.code <- input$codewssa}
if(input$freq=="W" && input$adj=="NA") {fred.code <- input$codewna}
if(input$freq=="BW" && input$adj=="SA") {fred.code <- input$codebwsa}
if(input$freq=="BW" && input$adj=="NSA") {fred.code <- input$codebwnsa}
if(input$freq=="BW" && input$adj=="SAAR") {fred.code <- input$codebwsaar}
if(input$freq=="BW" && input$adj=="SSA") {fred.code <- input$codebwssa}
if(input$freq=="BW" && input$adj=="NA") {fred.code <- input$codebwna}
head(list.index[list.index$desc==fred.code,],1)
})
output$plot <- renderPlot({
m <- datasetInput()
plot(m)
})
})
global.R:
fred.files <- read.csv("fred.csv",stringsAsFactors=F)
csv文件fred.csv位于:https://www.dropbox.com/s/0n2rfgya3chiezh/fred.csv?dl=0
它只是一个包含五列的文本文件,用于首先过滤选择以进行选择,然后确定使用以及超过200,000行下载Fred数据的正确代码。
很高兴接受有关此方面所有方面的所有提示,但最紧迫的是关于让应用程序运行所花费的时间问题。