I am using shinydashboard for the first time and it is brilliant. However I am stuck at an odd problem. I have the following code which is running on my browser. However when deployed on shinyapps.io it simply refuses to work.I have provided the code below. The dashboard is intended to do 3 things:
1. Visualize dependent variable
2.Automatically mark spikes with date dummies on graph with red vertical lines
3.See the independent variables and dummy variables selected
This is the link to the app in shinyapps.io http://rajarshibhadra.shinyapps.io/Test_Doubts
The code is as follows
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)
}
})
}
