I want to learn ARMA forecasting and I am trying to forecast using a bitcoin dataset download from bitcoins
I am struggling with the following code.
library(Quandl)
library(forecast)
library(tseries)
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Simple ARMA Bitcoin Forecasting"),
sidebarLayout(
sidebarPanel("Please choose the number of periods",
numericInput("num",h3("Numeric input"), value = 1)),
mainPanel(plotOutput("plot")))
)
)
server <- shinyServer(function(input,output) {
output$plot <- plotOutput({
bitcoin <- Quandl("BITSTAMP/USD",type = "xts")
bitcoin_price <- bitcoin[,3]
barplottest <- diff(log(bitcoin_price))
fit <- auto.arima(dataInput)
fit %>% forecast(h="input$num") %>% autoplot()
})
})
shinyApp(ui,server)
This is the error that I receive:
Warning: Error in as.ts: object 'dataInput' not found
Stack trace (innermost first):
44: as.ts
43: auto.arima
42: imageOutput [#11]
41: plotOutput
40: server [#3]
4: <Anonymous>
3: do.call
2: print.shiny.appobj
1: <Promise>
Error in as.ts(x) : object 'dataInput' not found
Well im not sure what dataInput is
Here is the example with the highcharter package:
library(shiny)
library(Quandl)
library(forecast)
library(highcharter)
bitcoin <- Quandl("BITSTAMP/USD",type = "xts")
bitcoin_price <- bitcoin[,3]
barplottest <- diff(log(bitcoin_price))
fit <- auto.arima(barplottest )
ui <- shinyUI(fluidPage(
titlePanel("Simple ARMA Bitcoin Forecasting"),
sidebarLayout(
sidebarPanel("Please choose the number of periods",
numericInput("num",h3("Numeric input"), value = 1)),
mainPanel(highchartOutput("hcontainer",height = "500px")))
)
)
server <- shinyServer(function(input,output) {
output$hcontainer <- renderHighchart({
hchart(forecast(fit,h=input$num))
})
})
shinyApp(ui,server)
Related
I'm very new to shiny and butting against something there must be a pattern for, but have had no luck Googling.
I have a simple shiny file (app.R below) that returns a plot for n observations. In addition to making the plot available to the ui method, I'd like to pass it n to help it size the plot to my liking
library(shiny)
server <- function(input, output) {
output$distPlot <- renderPlot({
firstNames <- c("Bob", "Jane", "Bob")
lastNames <- c("Builder", "Gorillas", "Weave")
ages <- c(25, 26, 27)
df <- data.frame(firstNames, lastNames, ages)
# I want to pass this to `ui`
numFirstNames <- length(unique(df$firstNames))
mapping <- aes(x = firstNames, y = ages)
ggplot(df, mapping) + geom_violin() + coord_flip()
})
}
getHeightInPx <- function(numFirstNames) {
paste(100 * numFirstNames, "px", sep="")
}
ui <- fluidPage(
# I want height to be a function of numFirstNames as calculated in the server definition
mainPanel(plotOutput("distPlot", height = getHeightInPx(2)))
)
shinyApp(ui, server)
Since ui isn't a function and doesn't have direct access to output (to me it's getting to distPlot by framework magic) how can I get to data prepared in server to help layout the page?
Thanks
https://github.com/rstudio/shiny/issues/650 tipped me off that you could use the height parameter in renderPlot. So I combined that with some use of reactive and observe to call a function that returns the plot AND gives me the number of elements to use.
I hardly get reactive and observe, so while it seems to work I would not be surprised to hear that I am abusing them or that there's an easier way.
library(shiny)
renderDistPlot <- function(input) {
firstNames <- c("Bob", "Jane", "Bob", "Carol")
lastNames <- c("Builder", "Gorillas", "Weave", "Xmasing")
ages <- c(25, 26, 27, 23)
df <- data.frame(firstNames, lastNames, ages)
# I want to pass this to `ui`
numFirstNames <- length(unique(df$firstNames))
mapping <- aes(x = firstNames, y = ages)
plot <- ggplot(df, mapping) + geom_violin() + coord_flip()
list(Plot = plot, NumFirstNames = numFirstNames)
}
server <- function(input, output) {
renderDistPloatResult <- reactive(renderDistPlot(input))
observe(output$distPlot <- renderPlot(renderDistPloatResult()$Plot, height = renderDistPloatResult()$NumFirstNames * 100))
}
ui <- fluidPage(
# I want height to be a function of numFirstNames as calculated in the server definition
mainPanel(plotOutput("distPlot"))
)
shinyApp(ui, server)
Please I need assistant concerning a shiny code. I want to manipulate a data frame input by separating them into column vector for computation but I keep getting this error
Warning in <reactive>(...): NAs introduced by coercion
the code is as follows
library(shiny)
ui <- fluidPage(
# dataset
data <- data.frame(e1 = c(3, 7, 2, 14, 66),
e2 = c(2, 16, 15, 66, 30),
n1 = c(18, 25, 45, 62, 81),
n2= c(20, 30, 79, 64, 89))
# Application title
titlePanel("Demo"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
# Input: Upload file
fileInput(inputId = 'file', label = 'upload the file')
),
# Display Output
mainPanel(
uiOutput("final")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# separating the dataframe into 4 column vectors
e1 <- reactive(as.numeric(input$file[,1]))
e2 <- reactive(as.numeric(input$file[,2]))
n1 <- reactive(as.numeric(input$file[,3]))
n2 <- reactive(as.numeric(input$file[,4]))
# File Upload function
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.table(file = file1$datapath, sep = ',', header = TRUE)
})
output$result <- renderUI({
y <- (e1()/n1()) - (e2()/n2())
lg_y <- log(y)
v2 <- ((n1() - e1())/e1() * n1()) + ((n2() - e2())/e2() * n2())
w <- 1/v2
w1 <- sum(w)
w2 <- sum(w^2)
c <- w1 - (w2/w1)
s2 <- w * lg_y
ybar <- sum(s2)/sum(w)
Q <- sum(w*((lg_y - ybar)^{2}))# Cochrane homogeneity test statistic
Q.pval <- reactive(pchisq(Q, k() - 1,lower.tail = FALSE))
Isqd <- max(100*((Q-(k()-1))/Q),0)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have searched almost every question on this forum and haven't seen where the question was answered. please I look forward to your help
Still can't run the code above because you don't define function k(). Also FYI, your renderUI is set for "result" but your uiOutput is set for "final".
You get the warning Warning in <reactive>(...): NAs introduced by coercion because your true data set probably includes a non-numeric in it. I did not get any issues with the data set you provided above.
There are a couple ways forward:
1) Write a function to remove all non-numerics before you process the data. See here for a few examples.
2) Just keep the warning, it is a warning after all so it won't stop your code from running. Currently it turns your non-numerics into NA
3) Use suppressWarnings() but that is usually not recommended.
I do have a suggestion to clean up your code though:
# File Upload function
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.table(file = file1$datapath, sep = ',', header = TRUE, stringsAsFactors = FALSE)
})
# separating the dataframe into 4 column vectors
e1 <- reactive(as.numeric(data()[,1]))
e2 <- reactive(as.numeric(data()[,2]))
n1 <- reactive(as.numeric(data()[,3]))
n2 <- reactive(as.numeric(data()[,4]))
data(mtcars)
library(stats)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectizeInput("mtcarsid", "Nehme eine MT Cars category.", choices = colnames(mtcars), selected = colnames(mtcars)[2], multiple = FALSE)
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("model"),
textOutput("text123")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$text123 <- renderText({
})
output$model <- renderTable ({
z <- factor(input$mtcarsid)
# #print(mtcars[[z]])
#
# print(length(mtcars$mpg))
#
# print(length(mtcars[[z]]))
x <- aov(mpg ~ factor(mtcars[[z]]), data=mtcars)
x <- TukeyHSD(x)
print(x)
x <- as.data.frame(x[[1]][,4] > 0.05)
x
})
}
# Run the application
shinyApp(ui = ui, server = server)
This is my App and based on the input of my input$mtcarsid I want to perform an anova incl. a post-hoc test. However, my model seems to totally wrong input with my code. Can anybody tell me why?
aov(mpg ~ factor(cyl), data = mtcars)
This code works fine. But when i just use factor(input$mtcarsid) i get an error that length of input differs (1 vs 32).
One solution is to convert the selected variable to a factor outside of the call to aov().
output$model <- renderTable ({
mtcars[["selected"]] = factor(mtcars[[input$mtcarsid]])
x <- aov(mpg ~ selected, data=mtcars)
x <- TukeyHSD(x)
print(x)
x <- as.data.frame(x[[1]][,4] > 0.05)
x
})
I want to reproduce the example at: https://scip.shinyapps.io/scip_app/
Basically, I have a 300 by 300 adjusted correlation matrix and a 300 by 300 unadjusted correlation matrix and want to show them interactively with zoom in and zoom out function. The text descriptions should display the point estimates and confidence intervals.
Is there any template I can quickly refer to?
Building on the data from Mike, you can use the d3heatmap library
library(d3heatmap)
library(shiny)
n1 <- 100
n2 <- 100
nr <- 30
nc <- 30
set.seed(1)
x <- matrix(rnorm(n1), nrow=nr, ncol=nc)
y <- matrix(rnorm(n2), nrow=nr, ncol=nc)
MAT <- cor(x,y)
ui <- fluidPage(
mainPanel(
d3heatmapOutput("heatmap", width = "100%", height="600px")
)
)
## server.R
server <- function(input, output) {
output$heatmap <- renderD3heatmap({d3heatmap(MAT)})
}
shinyApp(ui = ui, server = server)
Edit: Specify the colours if needs to be and display the data as is, note that Colv = T by default, which means it will group the correlated items together
output$heatmap <- renderD3heatmap({d3heatmap(MAT, colors = "Blues", Colv = FALSE)})
I think plotly can do this well. Here are the docs https://plot.ly/r/heatmaps/:
And here is a little template-example (returning Porkchop's favor by borrowing his minimal shiny template) with some fake data:
library(shiny)
n1 <- 100
n2 <- 100
nr <- 30
nc <- 30
set.seed(1)
x <- matrix(rnorm(n1), nrow=nr, ncol=nc)
y <- matrix(rnorm(n2), nrow=nr, ncol=nc)
cmat <- cor(x,y)
plot_ly(z = cmat, type = "heatmap")
ui <- fluidPage(
mainPanel(
plotlyOutput("heatmap", width = "100%", height="600px")
)
)
## server.R
server <- function(input, output) {
output$heatmap <- renderPlotly({plot_ly(z = cmat, type = "heatmap")})
}
shinyApp(ui,server)
Here is the Shiny output. Note it is fully zoomable:
I have made a shiny app the removes outlying experimental artefacts:
df=data.frame(seq(-1000,1000), rnorm(2001)) #not real data
ui <- basicPage(
plotOutput("plot1", click = "plot_click", brush = "plot_brush"),
verbatimTextOutput("info"),
plotOutput("tab")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(df[,1], df[,2])
})
data_new<-eventReactive(input$plot_brush,{
da=df
rowmin <- which(da[,1] == round(as.numeric(input$plot_brush$xmin)))
rowmax <- which(da[,1] == round(as.numeric(input$plot_brush$xmax)))
da[rowmin:rowmax,2] = mean(da[,2])
da=isolate(da)
#writeToDatabase(da)
})
#output$zoom<-renderable({plot(data_new()[,1], data_new()[,2])})
output$tab=renderPlot({plot(data_new()[,1], data_new()[,2])})
}
shinyApp(ui, server)
This works fine but it is inconvenient that I can not permanently remove the artefacts i.e. I was wondering is there any way to make the values of the non-reactive variable permanently retain the changes made rather than the original incorrect data frame being replotted each time?
I have tried using a function that corrected the faulty data-variable 'df':
change=reactive(function(d){
rowmin <- which(d[,1] == round(as.numeric(input$plot_brush$xmin)))
rowmax <- which(d[,1] == round(as.numeric(input$plot_brush$xmax)))
d[rowmin:rowmax,2] = mean(d[,2])
return(isolate(d))
})
isolate(change(df))
but I get the following error:
Listening on http://127.0.0.1:6183
Warning: Error in change: unused argument (df)
Stack trace (innermost first):
52: change
51: is.data.frame
50: write.table
43: isolate
42: server [/Users/Downloads/test.R#20]
1: runApp
Error in change(df) : unused argument (df)
This was a starter test to see if I could dynamically update the variable. All of this is with the aim of being able to successively view and eliminate each of the sharp error peaks in my data shown above- rather than the code re-running on the same immutable (from shiny's perspective) variable each time??
You probably want to use reactiveValues:
server <- function(input, output) {
my <- reactiveValues(df=data.frame(seq(-1000,1000), rnorm(2001))) # Initialize df
output$plot1 <- renderPlot({plot(my$df[,1], my$df[,2])})
observeEvent(input$plot_brush,{
rowmin <- which(my$df[,1] == round(as.numeric(input$plot_brush$xmin)))
rowmax <- which(my$df[,1] == round(as.numeric(input$plot_brush$xmax)))
my$df[rowmin:rowmax,2] <- mean(my$df[,2]) # Update df
})
}