【发布时间】：2015-04-22 00:46:01
【问题描述】：
我是第一次使用 shinydashboard，它很棒。但是我遇到了一个奇怪的问题。我有以下代码在我的浏览器上运行。但是，当部署在 shinyapps.io 上时，它根本无法工作。我提供了下面的代码。仪表板旨在做 3 件事：
1. 可视化因变量
2.在图表上用红色竖线自动标记带有日期假人的尖峰
3.查看选择的自变量和虚拟变量
这是shinyapps.io http://rajarshibhadra.shinyapps.io/Test_Doubts中的应用链接
代码如下
ui.R
library(shiny)
library(shinydashboard)
library(dygraphs)
dashboardPage(
dashboardHeader(title="Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard",tabName="dashboard",icon=icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
column(12,
box(title = "Plot Dependant", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
dygraphOutput("final_plot",width = "100%", height = "300px"),width=8),
box(title="Model Specifications",status="warning",solidHeader= TRUE,
collapsible= TRUE,
uiOutput("mg"),width=4
)),
column(12,
tabBox(title="Independants and Dummies",
tabPanel("Independants",verbatimTextOutput("modelvars")),
tabPanel("Dummies",verbatimTextOutput("modeldummies")),width=8
),
box(title = "Inputs", status = "warning", solidHeader = TRUE,
collapsible = TRUE,
uiOutput("dependant"),
uiOutput("independant"),
uiOutput("dummies"),
sliderInput("spikes","Magnitude of strictness of crtiteria for spike",min=1,max=5,value=3,step=1),
sliderInput("dips","Magnitude of strictness of crtiteria for dips",min=1,max=5,value=3,step=1),width=4)
))
)
)
))
server.R
library(shiny)
library(stats)
library(dplyr)
library(dygraphs)
##
library(shinydashboard)
function(input, output) {
raw_init<-data.frame(wek_end_fri=c("06Jul2012","13Jul2012","20Jul2012","27Jul2012","03Aug2012","06Jul2012","13Jul2012","20Jul2012","27Jul2012","03Aug2012"),
Var1=c(468.9,507.1,447.1,477.1,452.6,883113.7,814778.0,780691.2,793416.6,833959.6),
Var2=c(538672.6,628451.4,628451.4,628451.4,359115.8,54508.8,56036.1,57481.0,58510.0,59016.7),
MG= c("Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2")
)
#Select Category
output$mg<-renderUI({
selectInput("Category","Select Category",c("Cat1","Cat2"))
})
raw_init_filter<-reactive({
filter(raw_init,MG == input$Category)
})
#Interpret Date
raw_init_date<-reactive({
mutate(raw_init_filter(),wek_end_fri=as.Date(wek_end_fri,"%d%b%Y"))
})
#Get variable Names
Variable_list<-reactive({
colnames(raw_init_date())
})
#Get potential dummy list
Dummy_List<-reactive({
raw_init_date()$wek_end_fri
})
#Load dependant
output$dependant<-renderUI({
selectInput("deplist","Select Dependant Variable",Variable_list(),selected="Var1")
})
#load independant
output$independant<-renderUI({
selectInput("indeplist","Select Independant Variable",Variable_list(),multiple=TRUE)
})
#Sepereate out Dependant
dep<-reactive({
raw_init_date()[input$deplist]
})
#Spike detection
plot_data<-reactive({
data.frame(Time=raw_init_date()$wek_end_fri,dep())
})
plot_data_mut<-reactive({
f <- plot_data()
colnames(f)[colnames(f)==input$deplist] <- "Volume"
f
})
dep_vec<-reactive({
as.vector(plot_data_mut()$Volume)
})
#Calculating mean
dep_mean<-reactive({
mean(dep_vec())
})
dep_sd<-reactive({
sd(dep_vec())
})
transformed_column<-reactive({
(dep_vec()-dep_mean())/dep_sd()
})
detected_index_spike<-reactive({
which(transformed_column()>input$spikes/2)
})
detected_index_trough<-reactive({
which(transformed_column()<(input$dips/(-2)))
})
detected_index<-reactive({
c(detected_index_spike(),detected_index_trough())
})
detected_dates<-reactive({
raw_init_date()$wek_end_fri[detected_index()]
})
output$dummies<-renderUI({
validate(
need(raw_init, 'Upload Data to see controls and results')
)
selectInput("dummies","Suggested Dummy Variable",as.character(Dummy_List()),selected=as.character(detected_dates()),multiple=TRUE)
})
indlist<-reactive({
data.frame(Independant_Variables=input$indeplist)
})
output$modelvars<-renderPrint({
indlist()
})
dumlist<-reactive({
data.frame(Dummies=paste("Dummy_",as.character(format(as.Date(input$dummies,"%Y-%b-%d"),"%d%b%y")),sep=""))
})
output$modeldummies<-renderPrint({
dumlist()
})
#-----------------------------------------------------------------------------------------#
library(xts)
plot_data_xts<-reactive({
xts(dep(),order.by=as.Date(raw_init_filter()$wek_end_fri,"%d%b%Y"))
})
##
getDates <- reactive({
as.character(input$dummies)
})
addEvent <- function(x,y) {
dyEvent(
dygraph=x,
date=y,
"",
labelLoc = "bottom",
color = "red",
strokePattern = "dashed")
}
basePlot <- reactive({
if (length(getDates()) < 1) {
dygraph(
plot_data_xts(),
main="Initial Visualization and dummy detection") %>%
dyAxis(
"y",
label = "Volume") %>%
dyOptions(
axisLabelColor = "Black",
digitsAfterDecimal = 2,
drawGrid = FALSE)
} else {
dygraph(
plot_data_xts(),
main="Initial Visualization and dummy detection") %>%
dyAxis(
"y",
label = "Volume") %>%
dyOptions(
axisLabelColor = "Black",
digitsAfterDecimal = 2,
drawGrid = FALSE) %>%
dyEvent(
dygraph=.,
date=getDates()[1],
"",
labelLoc = "bottom",
color = "red",
strokePattern = "dashed")
}
})
##
output$final_plot <- renderDygraph({
res <- basePlot()
more_dates <- getDates()
if (length(more_dates) < 2) {
res
} else {
Reduce(function(i,z){
i %>% addEvent(x=.,y=z)
}, more_dates[-1], init=res)
}
})
}
【问题讨论】：
标签： r shiny dygraphs shiny-server