Below is my code to generate a Pareto from a data set, based on selected dates by the user. When I run the app, I am only able to generate the date selection but no graphs. Any ideas why I am not seeing a graph? I want a graph that updates when the date range updates. Thanks. I assume the code in my ui is fine to output code. I just can't seem to get the server to output my graph.
#load libraries
library(shiny)
library(readr)
library(dplyr)
library(ggplot2)
#read in data
Rawdata <- read_csv("Rawdata.csv")
#change time from chr to Date
Rawdata$timestamp= as.Date(Rawdata$timestamp, format= "%m/%d/%Y")
#defining a ui
ui <- fluidPage(
# Application title
titlePanel("COCBRN Pareto"),
dateRangeInput("daterange",
label="Select the date range",
start=min(Rawdata$timestamp),
end=max(Rawdata$timestamp),
min=min(Rawdata$timestamp),
max=max(Rawdata$timestamp),
format="mm/dd/yyyy",
separator="to"
),
textOutput("startdate"),
textOutput("enddate"),
textOutput("range"),
tableOutput("subdata"),
#this is where I am trying to output the plot
mainPanel(plotOutput("pareto"))
)
#writing the server
server <- function(input, output,session) {
output$startdate<-renderText({
as.character(input$daterange[1])
})
output$enddate<-renderText({
as.character(input$daterange[2])
})
output$range<-renderText({
paste("Selected date range is", input$daterange[1], "to", input$daterange[2])
})
#Creating a vector to convert failure codes to text
srp.codes<-c("Reset"= "00","Blower leakage due to incomplete adhesive joint"="11A", "Uncured adhesive" ="11B", "Motor to fan cover installation incorrect"="11C", "Hood nonconformance cosmetic"="13D", "Retest after first time failure"="13AA", "Hood leak @ unknown location"="13A", "Neckdam holes/tears"="13B", "Blower leakage due to inc adhesive joint"="18B", "Leakage at filter crimp"="18A", "Impeller gap incorrect"="16A", "Blower outlet threads stripped"="13AF", "Uncured adhesive"="18C","NPF at hood"="18V", "Perimeter seal leak"="13P", "Hole in hood (not in seal)"="13E", "Exhaust valve cover missing or installed incorrectly"="13M", "Air flow fails on low side of tolerance"="12LVL", "Low Flow Motor Wires Reversed"= "17A", "No Problem Found (Blower Test)"="12V", "Crimp Nonconformance"="18G")
#removing a code from my data
Data_no_00<-subset(Rawdata, code!="00")
func_year<-as.numberic(format(input$daterange[1],"%Y"))
func_month<-as.numberic(format(input$daterange[1],"%m"))
func_days=c(as.numberic(format(input$daterange[1],"%d")):as.numberic(format(input$daterange[2],"%d")))
#filtering data based on user input
filt<-
subset(Data_no_00,test==0& Year==func_year& Month==func_month &Day%in%func_days)%>%
group_by(code)%>%
summarise(freq=n())%>%
arrange(desc(freq))
#matching failure codes to text
filt$code<-names(srp.codes)[match(filt$code, srp.codes)]
plotting<-filt[1:5,]%>%
mutate(relative_freq=freq/sum(freq), cumulative_freq=cumsum(relative_freq))
the_order<- plotting$code
p<-plotting%>%
ggplot(aes(x=code, weight= relative_freq))+
geom_bar(width=0.5,fill="blue")+
scale_x_discrete(limits=the_order)+
scale_y_continuous(label=scales::percent)+
geom_point(aes(x=code,y=cumulative_freq))+
geom_line(aes(x=code,y=cumulative_freq, group=1))+
labs(x="",y="Relative Frequency", title= "February COCBRN Pareto 2019")+
theme(plot.title=element_text(hjust=0.5))+
theme(axis.text.x=element_text(angle=270))
output$pareto<-renderPlot({p})
}
# Run the application
shinyApp(ui = ui, server = server)
as MrFlick said above, the issue lies in the use of reactive elements. There would be many different ways to implement your code with reactive elements. This would be one:
server <- function(input, output,session) {
output$startdate<-renderText({
as.character(input$daterange[1])
})
output$enddate<-renderText({
as.character(input$daterange[2])
})
output$range<-renderText({
paste("Selected date range is", input$daterange[1], "to", input$daterange[2])
})
#Creating a vector to convert failure codes to text
srp.codes<-c("Reset"= "00","Blower leakage due to incomplete adhesive joint"="11A", "Uncured adhesive" ="11B", "Motor to fan cover installation incorrect"="11C", "Hood nonconformance cosmetic"="13D", "Retest after first time failure"="13AA", "Hood leak @ unknown location"="13A", "Neckdam holes/tears"="13B", "Blower leakage due to inc adhesive joint"="18B", "Leakage at filter crimp"="18A", "Impeller gap incorrect"="16A", "Blower outlet threads stripped"="13AF", "Uncured adhesive"="18C","NPF at hood"="18V", "Perimeter seal leak"="13P", "Hole in hood (not in seal)"="13E", "Exhaust valve cover missing or installed incorrectly"="13M", "Air flow fails on low side of tolerance"="12LVL", "Low Flow Motor Wires Reversed"= "17A", "No Problem Found (Blower Test)"="12V", "Crimp Nonconformance"="18G")
#removing a code from my data
Data_no_00<-subset(Rawdata, code!="00")
#filtering data based on user input
filt<- reactive({
func_year<-as.numberic(format(input$daterange[1],"%Y"))
func_month<- as.numberic(format(input$daterange[1],"%m"))
func_days <- c(as.numberic(format(input$daterange[1],"%d")):as.numeric(format(input$daterange[2],"%d")))
df <- subset(Data_no_00,test==0& Year==func_year& Month==func_month &Day%in%func_days)%>%
group_by(code)%>%
summarise(freq=n())%>%
arrange(desc(freq))
df$code<-names(srp.codes)[match(df$code, srp.codes)]
df
})
output$pareto<-renderPlot({
#matching failure codes to text
plotting<-filt()[1:5,]%>%
mutate(relative_freq=freq/sum(freq), cumulative_freq=cumsum(relative_freq))
the_order<- plotting$code
p<-plotting%>%
ggplot(aes(x=code, weight= relative_freq))+
geom_bar(width=0.5,fill="blue")+
scale_x_discrete(limits=the_order)+
scale_y_continuous(label=scales::percent)+
geom_point(aes(x=code,y=cumulative_freq))+
geom_line(aes(x=code,y=cumulative_freq, group=1))+
labs(x="",y="Relative Frequency", title= "February COCBRN Pareto 2019")+
theme(plot.title=element_text(hjust=0.5))+
theme(axis.text.x=element_text(angle=270))
p
})
}
In addition to the webinar MrFlick posted above you can also look at the example in the Shiny gallery that explains reactivity: https://shiny.rstudio.com/gallery/reactivity.html
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.