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)
}
})
}
Your app https://rajarshibhadra.shinyapps.io/Test_Doubts/ shows the following error message in the "Plot Dependant" box:
Error: can not calculate periodicity of 1 observation
I have loaded your script and ran the app locally: I am able to reproduce it and obtain the same error message.
It is due to the as.Date conversions: %b is not converted which results in NA in xts and dygraph packages. This is due to the locale (see here and here).
It is easily fixed by using more common Date specifications such as "%d/%m/%Y":
raw_init<-data.frame(wek_end_fri=c("06/07/2012","13/07/2012","20/07/2012","27/07/2012","03/08/2012","06/07/2012","13/07/2012","20/07/2012","27/07/2012","03/08/2012"),
and
#Interpret Date
raw_init_date<-reactive({
mutate(raw_init_filter(),wek_end_fri=as.Date(wek_end_fri,"%d/%m/%Y"))
})
and
dumlist<-reactive({
data.frame(Dummies=paste("Dummy_",as.character(format(as.Date(input$dummies,"%d/%m/%Y"),"%d/%m/%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/%m/%Y"))
})
The resulting app is here: https://faidherbard.shinyapps.io/Test_Doubts/