Shiny App the coding difference between a reactive object and wide scoping - r

Example might look long but it's really simple.
My issue is around having a reactive object and the use of <<-.
I have another shiny app which works great using:
blah <- reactive({
dat <<- etcetc
)
And then successfully using dat later in dataTable and plot components. But with the below I'm failing hard.
Question: What is the difference between item1 <- reactive({etc}) and item2 <<- etc
As I understand it, you can put a reactive dataset into an object (item1) and then use it later by putting item1() in your code. The scoping rules suggest you can use item2 <<- etc and then just use item2 later in your code.
contents2 <- reactive({
datp <- data.frame(mean = c(r1, r2),
chosen = c(rep("A", length(r1)), rep("B", length(r2))))
datp
})
I know I can break up my code below into the form above (with datp and datci being their own reactive objects (say contents2 and contents3), and it works) but shouldn't the scoping <<- below work?
Example:
library(ggplot2)
ui <- navbarPage("Test",
tabPanel("Panel A",
sidebarLayout(
sidebarPanel(
sliderInput("n1", "N sample 1:",
min=2, max=30, value=3),
sliderInput("n2", "N sample 2:",
min=2, max=30, value=3),
numericInput("mean1", label = h5("Mean 1"), value = 100),
numericInput("mean2", label = h5("Mean 2"), value = 80),
numericInput("sd1", label = h5("Std Dev 1"), value = 10),
numericInput("sd2", label = h5("Std Dev 2"), value = 10),
radioButtons("cilevel", "Confidence Interval",
c("99%" = 0.99,
"95%" = 0.95,
"90%" = 0.90),
selected = 0.95)
)
,
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Panel B",
sidebarLayout(
sidebarPanel(
)
,
mainPanel(
)
)
)
)
server <- function(input, output, session) {
contents1 <- reactive({
r1 <- rnorm(input$n1, input$mean1, input$sd1)
r2 <- rnorm(input$n2, input$mean2, input$sd2)
# Note the change to << now
cimult <<- qt(as.numeric(input$cilevel)/2 + .5, length(r1))
datp <<- data.frame(mean = c(r1, r2),
chosen = c(rep("A", length(r1)), rep("B", length(r2))))
datci <<- data.frame(mean = c(mean(r1), mean(r2)),
sd = c(sd(r1), sd(r2)),
n = c(length(r1), length(r2)),
se = c(sd(r1)/sqrt(length(r1)), sd(r2)/sqrt(length(r2))),
chosen = c("A", "B"))
})
output$plot <- renderPlot({
ggplot(datci, aes(x = factor(chosen),
y = mean)) +
geom_errorbar(aes(ymin = mean - cimult * se,
ymax = mean + cimult * se,
color = factor(chosen))) +
geom_point(aes(color = factor(chosen)), alpha = 0.8) +
geom_point(data = contents1(), alpha = 0.8) +
coord_flip()
})
}
shinyApp(ui = ui, server = server)

Related

Create graph based on selection of input and output

New to shiny. I am trying to create a plot based on chosen x and y values. Basically, whatever the user selects for the select1 and select2 selectInput function will graph it accordingly. My original data has many columns, not just two. When I try to graph very specific things, my code works great, but when I try to graph what the user "selects" it does not work.
library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
data0 <- rnorm(n = 10, mean = 100, sd = 5)
data1 <- rnorm(n = 10, mean = 50, sd = 10)
data2 <- data.frame(data0, data1)
attach(data2)
ui <- fluidPage(
selectInput(inputId = "select1",
label = "select the x-axis",
choices = c(" ", "data0", "data1")
),
selectInput(inputId = "select2",
label = "select the y-axis",
choices = c(" ", "data0", "data1")
),
submitButton(text = "Apply Changes", icon = NULL, width = NULL),
plotOutput(outputId = "myplot")
)
server <- function(input, output) {
output$myplot <- renderPlot({
data2 %>%
ggplot(aes(input$select1 ~ input$select2))+
geom_point(alpha = 0.8)
})
}
shinyApp(ui = ui, server = server)
I had to add ggplot(aes(x = get(paste(input$select1)), y = get(paste(input$select2)) to make the input selects work.
library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
data0 <- read_csv("DeltaX_Soil_Properties_Fall2020_Spring2021_Fall2021.csv")
data1 <- data0[!(data0$time_marker_sampled == "-9999"),]
attach(data1)
ui <- fluidPage(
selectInput(inputId = "select1",
label = "select the x-axis",
choices = c(" ", "elevation_navd88", "sediment_accretion", "days_between_sampling_and_deployment", "normalized_accretion", "soil_bulk_density", "soil_organic_matter_content", "soil_organic_carbon", "soil_organic_carbon_density")
),
selectInput(inputId = "select2",
label = "select the y-axis",
choices = c(" ", "elevation_navd88", "sediment_accretion", "days_between_sampling_and_deployment", "normalized_accretion", "soil_bulk_density", "soil_organic_matter_content", "soil_organic_carbon", "soil_organic_carbon_density")
),
submitButton(text = "Apply Changes", icon = NULL, width = NULL),
plotOutput(outputId = "myplot")
)
server <- function(input, output) {
output$myplot <- renderPlot({
data1 %>%
ggplot(aes(x = get(paste(input$select1)), y = get(paste(input$select2)), col = hydrogeomorphic_zone))+
geom_point(alpha = 0.8)
})
}
shinyApp(ui = ui, server = server)
If you want to use a variable as x or y, you can alternatively use aes_() instead of aes().
This would then result in:
ggplot(aes_(x = input$select1, y = input$select2))
Beware, that you need to add a tilde if you want to use a normal column name with aes_(), e.g.:
ggplot(aes_(x = ~elevation_navd88, y = input$select2))

Barplot in shiny: when click the actionbutton, the second barplot always appear delay and the previous figure appears

I create a barplot shiny app.
The biggest problem I met now is when I click the acitonbutton to get a new picture ,
the barplot appear delay and when I choose another input and click actionbutton again, the last barplot will appear but instantly disappear and the second picture appear.
But the input first and second time is different. Why the first picture will appear twice?
Here is my sample code,it is normal because it's a small sample.
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot")
#uiOutput("all")
)
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
My real data is huge and I don't know if it is the main reason.
Or I should change the reactive() and EventReactive() or adjust the parameters ??
My sample data here is simple. You may not meet what the problem I met in my code.
I will show you some details, just like this:
That's ok.Though it may appeare slowly.
But when I choose another gene as input,
the first "Gene_1" result will appear again and then the "Gene_2" result will appear.
I hope somebody could help me or met this problem before.
Vary thankful.
As your data is large, there is a delay in generating the plot p1(). Hence, the previous plot is shown in renderPlot. The following update will show blank until a new plot is generated whenever user selects a new gene. Perhaps this will solve your issue. I cannot verify as I don't have large dataframe.
ui <- fluidPage(
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot")
#,verbatimTextOutput("all")
)
)
)
server <- function(input, output, session) {
rv <- reactiveVal(0)
observeEvent(input$selectGeneSymbol, {rv(0)})
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
rv(0)
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
req(plotdata())
p <- ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
rv(1)
p
})
observeEvent(input$plot1, {rv(1)})
output$plot <- renderPlot({
if (rv()) {
p1()
}
})
#output$all <- renderPrint(rv())
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

Saving Dynamically Generated Plots in Shiny

so I have recently adapted some code that I found on StackOverflow to create a dynamic number of plots based on user input. However, I now cannot figure out how to save all of those dynamic plots in one file; when I use ggsave() in downloadHandler, it only saves the last plot generated, as the plots are created inside of a for loop, inside of an observe function. I have tried saving the for loop as a separate function and saving that instead of last plot, I have tried saving the observe() as a function and calling that inside ggsave(), but nothing works. Any idea how I can save all of the generated plots to one file?
ui <- fluidPanel(
sidebarLayout(
sidebarPanel(
#this is the input widget for dataset selection
selectInput(inputId = "dataset_selec",
label = "Choose which Dataset to explore:",
choices = list("NK AD Dataset (Zhang, 2020)",
"APPPS1 Dataset (Van Hove, 2019)",
"Aging T Cell Dataset (Dulken, 2019)"),
selected = "APPPS1 Dataset (Van Hove, 2019)"))
mainPanel(
fluidRow(
column(4,
textInput(inputId = "gene_fp",
label = "Enter gene(s) of interest here, separated by commas: ")
),
column(4,
br(),
checkboxInput("split_fp", "Split the graph?")
),
column(4,
conditionalPanel(condition = "input.split_fp == true",
#display choices to split by
selectInput(inputId = "metadata_split_fp",
label = "Choose how to split the Seurat data: ",
choices = list("Genotype", "Timepoint")))
)
),
#ask users if they want to split the graphs
br(),
fluidRow(
column(4,
textInput("save_name_fp",
label = "Enter a file name: ")
),
column(4,
conditionalPanel(condition = "input.save_name_fp.length > 0",
selectInput("fp_device",
label = "Select file type: ",
choices = list("PNG", "JPEG", "PDF", "TIFF",
"BMP", "SVG")))
),
column(4,
br(),
conditionalPanel(condition = "input.save_name_fp.length > 0",
downloadButton("fp_save", label = "Save Feature Plot"))
)
),
#plot the actual plot
uiOutput("fp_plots")
)
)
)
server <- function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset_selec,
"NK AD Dataset (Zhang, 2020)" = nk_data,
"APPPS1 Dataset (Van Hove, 2019)" = appps1_data,
"Aging T Cell Dataset (Dulken, 2019)" = tcellinfil_data)
})
output$fp_plots <- renderUI({
#validate is to prevent an error message from being displayed when a gene hasn't been entered yet
validate(
need(input$gene_fp !="", "Please enter a gene.")
)
fp_genes <- input$gene_fp
fp_genes <- gsub(" ", "", fp_genes)
fp_genes <- unlist(strsplit(fp_genes, split = ","))
n <- length(fp_genes)
plot_output_list <- lapply(1:n, function(i) {
plotname <- paste("plot", i, sep = "")
if (input$split_fp == TRUE) {plotOutput(plotname, height = 580, width = 1100)}
else {plotOutput(plotname, height = 580, width = 550)}
})
do.call(tagList, plot_output_list)
})
#Here, we take the input of genes, and turn it into a character vector, so that we can iterate
#over it. This needs to be under observe({}) because it involves an input.
#Next, we iterate through the list of genes using a for loop, and within that for loop we assign
#the plots that we want to be displayed to each plotname, which is also sequentially created within
#this for loop, and assign it to the tagList we generated earlier. Basically, we're adding objects to
#list of names we made earlier.
#This needs to be under local({}) control, otherwise each graph doesn't get its own number,
#because of when renderPlot is evaluated
observe({
fp_genes <- input$gene_fp
fp_genes <- gsub(" ", "", fp_genes)
fp_genes <- unlist(strsplit(fp_genes, split = ","))
for (i in 1:length(fp_genes)) {
local({
plotname <- paste("plot", i, sep = "")
gene <- fp_genes[i]
output[[plotname]] <- renderPlot({
if (input$split_fp == TRUE) {FeaturePlot(datasetInput(), features = gene, split.by = input$metadata_split_fp)}
else {FeaturePlot(datasetInput(), features = gene)}
})
})
}
})
output$fp_save <- downloadHandler(
filename = function() {
paste(input$save_name_fp, tolower(input$fp_device), sep = ".")
},
content = function(file) {
ggsave(file, device = tolower(input$fp_device))
}
)
}
Create a list of plots, use grid.arrange to save it in a format you wish, and then save it. Perhaps you can adapt this code.
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("Gene_FPKM Value Barplot"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = 1 #"Igfbp7"
),
selectInput(
"selectGeneSymbol2",
"Select Gene Symbol2:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = 1 #"Igfbp7"
),
selectInput("fp_device",
label = "Select file type: ",
choices = list("PNG", "JPEG", "PDF", "TIFF","BMP", "SVG")
),
actionButton(inputId = "plot1", label = "FPKM"),
actionButton(inputId = "plot2", label = "logFC"),
actionButton(inputId = "all",label = "logFC&FPKM"),br(),
downloadButton("fp_save", label = "Save Feature Plot")
),
mainPanel(
uiOutput("all")
)
)
)
server <- function(input, output, session) {
plot_data1 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol2)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=750)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=750)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=1150)
})
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
p2 <- eventReactive(list(input$plot2,
input$all), {
ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol2, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
#plotlist <- do.call(tagList, list(p1(),p2()))
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
observe({
plots <- list(p1(),p2())
myplots <- do.call(grid.arrange, c(plots, ncol = 1))
output$fp_save <- downloadHandler(
filename = function() {
paste("myplots", tolower(input$fp_device), sep = ".")
},
content = function(file) {
ggsave(file, plot=myplots, device = tolower(input$fp_device))
}
)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

Update Graph in R Shiny react

I would like to understand why the graph does not update in the RShiny App generated from the code below.
What I try to do:
Generate a sample of n_data observations from a beta-distribution with certain shape parameters.
Plot the histogram of this sample, together with its mean.
Do this e_samples times and keep the means, show an updated graph every second
Plot the histogram of the vector with e_samples means
library(shiny)
library(ggplot2)
# Design the interface
ui <- fluidPage(titlePanel("Population vs sample"),
sidebarLayout(
# Function to determine the layout
sidebarPanel(
sliderInput(
'shape1',
label = 'Population shape 1:',
min = 1,
max = 9,
value = 2 ,
step = 1
),
sliderInput(
'shape2',
label = 'Population shape 2:',
min = 1,
max = 9,
value = 2 ,
step = 1
),
textInput("n_data", label = "Sample size:",
value = '25'),
textInput("e_samples", label = "number of samples:",
value = '5'),
actionButton("RerunButton", "New sample", icon("play"))
),
mainPanel(plotOutput('Sample'))
))
# Set up the server
server <- function(input, output) {
set.seed(1234)
xvals <- seq(.001, .999, by = 0.001)
# Define reactive values
avgs <- reactiveVal(vector(mode = "list", length = 1))
vals <- reactiveVal(0)
s <- reactiveVal()
sample_plot <- reactiveVal()
# This is where I hope to generate a new graph every second.
observe({
invalidateLater(1000)
cat(paste('vals', vals(), '\n'))
cat(paste('avgs', avgs(), '\n'))
if (vals() < input$e_samples) {
s(data.frame(
d = rbeta(
n = input$n_data,
shape1 = as.numeric(input$shape1),
shape2 = as.numeric(input$shape2)
)
))
temp <- s()
vals(vals() + 1)
averages <- avgs()
averages[vals()] <- mean(temp$d)
avgs(averages)
sample_plot(
ggplot() +
geom_histogram(
data = temp,
aes(x = d),
binwidth = 0.1,
fill = 'white',
col = 'black'
) +
geom_vline(xintercept = mean(temp$d)) +
xlim(0, 1) +
xlab('observation value') +
ylab('count')
)
}
})
output$Sample <- renderPlot({
sample_plot()
})
observeEvent(input$RerunButton, {
vals(0)
})
observeEvent(input$RerunButton, {
avgs(vector(mode = "list", length = 1))
})
}
shinyApp(ui = ui, server = server)
The code above only updates the graph once. Why?
All of your reactiveValues that keep changing are triggering your observe repeatedly right away. This happens five times in succession, well before 1000 msec has elapsed. To prevent this from happening, you would need to use isolate for your reactiveValues. See if this gives the right behavior:
# Set up the server
server <- function(input, output, session) {
set.seed(1234)
xvals <- seq(.001, .999, by = 0.001)
# Define reactive values
avgs <- reactiveVal(vector(mode = "list", length = 1))
vals <- reactiveVal(0)
s <- reactiveVal()
sample_plot <- reactiveVal()
# This is where I hope to generate a new graph every second.
observe({
invalidateLater(1000, session)
#cat(paste('vals', vals(), '\n'))
#cat(paste('avgs', avgs(), '\n'))
if (isolate(vals()) < input$e_samples) {
s(data.frame(
d = rbeta(
n = input$n_data,
shape1 = as.numeric(input$shape1),
shape2 = as.numeric(input$shape2)
)
))
temp <- s()
isolate(vals(vals() + 1))
averages <- isolate(avgs())
averages[vals()] <- mean(temp$d)
avgs(averages)
}
})
sample_plot <- reactive({
ggplot() +
geom_histogram(
data = s(),
aes(x = d),
binwidth = 0.1,
fill = 'white',
col = 'black'
) +
geom_vline(xintercept = mean(s()$d)) +
xlim(0, 1) +
xlab('observation value') +
ylab('count')
})
output$Sample <- renderPlot({
sample_plot()
})
observeEvent(input$RerunButton, {
vals(0)
})
observeEvent(input$RerunButton, {
avgs(vector(mode = "list", length = 1))
})
}

Exponential Smoothing in R and representing with Shiny

I want to build forecast techniques that exponential smoothing method is one of my selection. However, I have some issues with representing the ggplot and the result/report of the calculation.
Initially, I am generating random dataset in order to be used for this technique where alpha and number of periods to be forecasted are determined by the user. For instance; i have 100 days and next 4 days are willing to be estimated with their lines -fit, upper and lower-. Then I want to learn the values of this data as a table.
When I try to visualize the plot, the error is: ggplot2 doesn't know how to deal with data of class mtstsmatrix
Secondly, I would like to monitor the data like:
require(shiny)
require(ggplot2)
require(forecast)
require(TTR)
shinyServer(function(input, output, session){
set.seed(123)
output$es1 <- renderPlot({
tmp <- data.frame(time = 1:100, sales = round(runif(100, 150, 879)) )
tmp.mean <- HoltWinters(x=tmp$sales, alpha = input$alpha, beta = FALSE,gamma=FALSE)
tmp.pred <- predict(tmp.mean,n.ahead = input$h, prediction.interval = TRUE)
y <- ggplot(tmp, aes(time, sales)) +
geom_line() +
geom_line(data=tmp.pred, aes(y=tmp.pred[,1]),color="red") +
geom_line(data=tmp.pred, aes(y=tmp.pred[,2]),color="blue") +
xlab("Days") +
ylab("Sales Quantity")+
ggtitle(title)
y })
output$infoes <- renderDataTable({
tmp <- data.frame(time = 1:100, sales = round(runif(100, 150, 879)) )
tmp.mean <- HoltWinters(x=tmp$sales, alpha = input$alpha, beta = FALSE,gamma=FALSE)
tmp.pred <- predict(tmp.mean,n.ahead = input$h, prediction.interval = TRUE)
tmp.pred
})
ui
require(shiny)
require(ggplot2)
require(forecast)
require(TTR)
shinyUI(pageWithSidebar(
headerPanel("Forecasting Methods"),
sidebarPanel(
h3(strong("Exponential Smoothing",style = "color:black")),
br(),
sliderInput("h","Number of periods for forecasting:",
min = 1, max = 20, step= 1, value = 4),
sliderInput("alpha","Alpha (Smoothing Parameter):",
min = 0.05, max = 1, step= 0.05, value = 0.01)
),
mainPanel(
tabsetPanel( id="tabs",
tabPanel("Exponential Smoothing",
value="panel",
plotOutput(outputId = "es1",
width = "900px",height = "400px"),
dataTableOutput(outputId="infoes"))
))))
You had a to make tmp.pred palatable for ggplot as was said in the comments. You also don't have to create the same data in multiple statements, a reactive command is good for that:
ui.R (unchanged)
require(shiny)
require(ggplot2)
require(forecast)
require(TTR)
shinyUI(pageWithSidebar(
headerPanel("Forecasting Methods"),
sidebarPanel(
h3(strong("Exponential Smoothing",style = "color:black")),
br(),
sliderInput("h","Number of periods for forecasting:",
min = 1, max = 20, step= 1, value = 4),
sliderInput("alpha","Alpha (Smoothing Parameter):",
min = 0.05, max = 1, step= 0.05, value = 0.01)
),
mainPanel(
tabsetPanel( id="tabs",
tabPanel("Exponential Smoothing",
value="panel",
plotOutput(outputId = "es1",
width = "900px",height = "400px"),
dataTableOutput(outputId="infoes"))
))))
server.R
require(shiny)
require(ggplot2)
require(forecast)
require(TTR)
shinyServer(function(input, output, session){
set.seed(123)
predset <- reactive({
tmp <- data.frame(time = 1:100, sales = round(runif(100, 150, 879)) )
tmp.mean <- HoltWinters(x=tmp$sales, alpha = input$alpha, beta = FALSE,gamma=FALSE)
tmp.pred <- data.frame(predict(tmp.mean,n.ahead = input$h, prediction.interval = TRUE), time = tmp[nrow(tmp), "time"] + 1:input$h)
list(tmp = tmp, tmp.pred = tmp.pred)
})
output$es1 <- renderPlot({
tmp <- predset()$tmp
tmp.pred <- predset()$tmp.pred
y <- ggplot(tmp, aes(time, sales)) +
geom_line() +
geom_line(data=tmp.pred, aes(y=upr),color="red") +
geom_line(data=tmp.pred, aes(y=fit),color="blue") +
geom_line(data=tmp.pred, aes(y=lwr),color="red") +
xlab("Days") +
ylab("Sales Quantity")+
ggtitle("title")
y })
output$infoes <- renderDataTable({
predset()$tmp.pred
})
})

Resources