I don't understand why this app doesn't work?
The app works without the content within the server part.
It works whith the UI definition and the server function empty.
When I added ggplot code in server function the app leaf to work.
Could you help me?
Thanks
#install.packages("quantmod")
#install.packages('circlepackeR')
library(quantmod)
library(ggplot2)
library(shiny)
library(data.table)
library(plotly)
library(shinydashboard)
apple=as.data.frame(getSymbols("AAPL", src = "yahoo", from = "2010-01-01", to = "2020-10-15", auto.assign = FALSE))
colnames(apple)=c('Apertura','Maximo','Minimo','Cierre','Volumen','Ajustado')
apple$fecha=as.Date(rownames(apple))
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "SP500 Top-5"),
dashboardSidebar(
sidebarMenu(
menuItem("Apple", tabName = "aapl")
)
),
dashboardBody(
# tags$head(
# tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
# ),
tabItems(
tabItem(tabName = "aapl",
fluidRow(
tabsetPanel(
tabPanel("Plot", plotOutput("plota1")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)))))))
server <- function(input, output) {
apple=reactive({apple})
output$plota1 <- renderPlot({
g=ggplot()+
geom_line(mapping=aes(x=fecha, y=Cierre), data=apple(), size=1, alpha=0.5)+
scale_x_date("Fecha") + scale_y_continuous(name="Serie de precios de cierre")+
ggtitle ("Comportamiento diario de la acción APPPLE")
g
})
}
shinyApp(ui = ui, server = server)
Inside the server, change the reactive name to something other than apple. I defined it as df1, and used airquality data, and I get the output as shown below. Otherwise, your code is fine.
apple <- as.data.frame(airquality)
apple$fecha <- apple$Day
apple$Cierre <- apple$Temp
ui <- dashboardPage(
dashboardHeader(title = "SP500 Top-5"),
dashboardSidebar(
sidebarMenu(
menuItem("Apple", tabName = "aapl")
)
),
dashboardBody(
# tags$head(
# tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
# ),
tabItems(
tabItem(tabName = "aapl",
fluidRow(
tabsetPanel(
tabPanel("Plot", plotOutput("plota1")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", DTOutput("table"))
))))))
server <- function(input, output) {
df1 <- reactive({apple})
output$plota1 <- renderPlot({
g <- ggplot(data=df1())+
geom_line(mapping=aes(x=fecha, y=Cierre), size=1, alpha=0.5)+
#scale_x_date("Fecha") + scale_y_continuous(name="Serie de precios de cierre")+
ggtitle ("Comportamiento diario de la acción APPPLE")
g
})
output$table <- renderDT(df1())
}
shinyApp(ui = ui, server = server)
My knowledge on all things R is still a bit low especially when it comes to shiny. But to try get better I've been involving myself in the Qs to see if I can find a work through.
With this one, in the server code I removed
apple=reactive({apple})
and data=apple(). Knowing ggplot I wasn't sure why apple was a function anyway so I just had it read data=apple
This got the server ui function to run graph as shown. Obviously you haven't included any information on the summary or table parts so they remain blank. This worked for me, but I could be completely way off the mark and could run into other problems down the line.
Related
Once I add an HTML document in my shiny app my graphs stop populating. I am using bs4dash but shinydashboard also has the exact same issue.
Below is my code as well as a screenshot of what is happening.
Code before i add HTML document
Ui
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
fluidRow(
box(
#width = 12,
#includeHTML("first.html")
)
)
)
)
Server
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
Now when i remove the hastags to display my HMTL document. My graph all of a sudden disappears.
Ui
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
Server
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
I would like to have the graph still show. What is going wrong in the code. Thank you
I cannot reproduce your problem. I just observed that your fluidRow is the fourth parameter of dashboardPage which, however, expects a dashboardControlbar. Both, putting the fluidRow into dashboardBody or wrapping it in a call to dashboardControlbar works for me.
So either it is your first.html or indeed "just" the missing dashboardControlbar.
first.html
<span>I am an external HTML</span>
app.R
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
),
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
ui2 <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
dashboardControlbar(
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
shinyApp(ui, server)
## shinyApp(ui2, server) ## works likewise
Screenshots
I am working on a Shiny-app and since it is a rather large project, I am splitting it up in several files.
I have these app.R, ui.R and server.R:
app.R
library(shiny)
library(shinydashboard)
shinyApp(ui, server)
ui.R
library(shiny)
library(shinydashboard)
library(shinyWidgets)
header <- dashboardHeader(disable = TRUE)
sidebar <- dashboardSidebar(
sidebarMenu(id = "tabs",
sidebarMenuOutput("menu"))
)
MainBox <- fluidRow(
titlePanel("PromView"),
tabItems(
tabItem(tabName = "tab1", QuickPlot()),
tabItem(tabName = "tab2", p("Doorloop Content"))
)
)
body <- dashboardBody(MainBox)
ui <- dashboardPage(title = "PromView", skin = "blue",
header,
sidebar,
body
)
server.R
library(plotly)
source("~/Werk/BigData/Process Mining/R/PM_Globals.R", local = TRUE)
source("~/Werk/BigData/Process Mining/PromView/PromView/QuickFacts.R", local = TRUE)
source("~/Werk/BigData/Process Mining/PromView/PromView/LoadData.R", local = TRUE)
source("~/Werk/BigData/Process Mining/PromView/PromView/Filters.R", local = TRUE)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Quick facts", tabName = "tab1"),
menuItem("Doorloop", tabName = "tab2")
)
})
isolate({updateTabItems(session, "tabs", "tab1")})
}
When I start the app (in Rstudio), the app complains that it can' t find the QuickPlot()-function. The environment-pane in Rstudio is empty.
When I manually execute the "source"-lines in server.R, the environment-pane shows that all data are loaded and that functions are defined. The app then starts normally.
How can I force shiny to use the " source"-lines?
Ben
You can put the "source"-lines in the ui.R file, shiny loads ui file before server file and therefore, your app will complain that there is no QuickPlot function.
I'm working on a dashboard where sometimes I need to call the input's choice name and other times it's value, but I only know how to get the latter. Is there a way to call the first one?
Here is a minimum reproducible example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
selectInput(
"input",
h5("The output should give the choice name instead of it's value"),
choices=c(
"Name 1" = 1,
"Name 2" = 2,
"Name 3" = 3
)
),
textOutput("output")
)
)
server <- function(input, output, session) {
output$output <- renderPrint({paste(input$input)})
}
shinyApp(ui = ui, server = server)
I think it is easiest to create a data.frame with the choices and the corresponding names in advance, and use that to look up the name of the selected input. A working example is given below, hope this helps!
library(shiny)
library(shinydashboard)
choices_df = data.frame(
names = c('Name 1', 'Name 2', 'Name 3'),
id = seq(3)
)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
selectInput(
"input",
h5("The output should give the choice name instead of it's value"),
choices= setNames(choices_df$id,choices_df$names)
),
textOutput("output")
)
)
server <- function(input, output, session) {
output$output <- renderPrint({paste(choices_df$names[choices_df$id==input$input])})
}
shinyApp(ui = ui, server = server)
I'm trying to take input from a slider in shiny and use it in the server section by calling a function on it to obtain information for graphing. However, the input from the slider is not recognized serverside, and throws an error.
Evaluation error: argument "hour" is missing, with no default.
The inputID matches the argument so I don't understand why it wouldn't be able to access it.
library(shiny)
library(shinydashboard)
get_data <- function(foo){return(foo)}
#build shiny app
header <- dashboardHeader(
title="Data"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Charts and Analysis", tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("Temperature by Time of Day", tabName = "temperatures", icon = NULL) )
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "temperatures",
fluidRow(
box(
title = "Time of Day",
sliderInput(inputId = "hour", label="Hour (military)", min=0, max=23, value=12, step=1)
),
box(plotOutput("series"))
)
)
)
)
ui <- dashboardPage(skin="green", header, sidebar, body)
server <- function(input, output) {
MR <- get_data(strtoi(input$hour))
output$series <- renderPlot({
plot(x=MR, y=MR)
})
}
shinyApp(ui, server)
In a shiny application calls to input parameters must be in a reactive context.
Then we must move the functional assignment into the renderPlot function.
library(shiny)
library(shinydashboard)
get_data <- function(foo){return(foo)}
#build shiny app
header <- dashboardHeader(
title="Data"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Charts and Analysis", tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("Temperature by Time of Day", tabName = "temperatures", icon = NULL) )
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "temperatures",
fluidRow(
box(
title = "Time of Day",
sliderInput(inputId = "hour", label="Hour (military)", min=0, max=23, value=12, step=1)
),
box(plotOutput("series"))
)
)
)
)
ui <- dashboardPage(skin="green", header, sidebar, body)
server <- function(input, output) {
output$series <- renderPlot({
MR <- get_data(strtoi(input$hour))
plot(x=MR, y=MR)
})
}
shinyApp(ui, server)
I have initial loading of data from the DB in the server.R which takes a few seconds. Until this is done, the page displayed is distorted (wrong data in selection box, and weird placing of the boxes, see below).
I want to display a different page (or at least different content in my first-displayed tab) until the data is completely loaded.
I thought about doing some kind of conditionalPanel using a condition based on a dedicated global variable (initial_loading_done), but wherever I tried placing the conditionalPanel it didn't work.
This is the structure of my UI.R:
shinyUI(
dashboardPage(
dashboardHeader(title = "Title"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1",icon = icon("dashboard")),
menuItem("Tab2", tabName = "Tab2", icon = icon("bar-chart-o"))
)
),
dashboardBody(
includeCSS("custom_css.css"),
tabItems(
tabItem(tabName = "Tab1",
fluidRow(<content>),
mainPanel(
fluidRow(<content>)
)
),
tabItem(tabName = "Tab2",
fluidRow(<content>),
mainPanel(
dataTableOutput('my_data_table')
)
)
)
)
)
)
Here's a very simple example using shinyjs package
The idea is to create the loading "page" and the content "page" under different IDs, have the content page initially hidden, and use show() and hide() after the app is ready
library(shiny)
library(shinyjs)
load_data <- function() {
Sys.sleep(2)
hide("loading_page")
show("main_content")
}
ui <- fluidPage(
useShinyjs(),
div(
id = "loading_page",
h1("Loading...")
),
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
)
)
server <- function(input, output, session) {
load_data()
}
shinyApp(ui = ui, server = server)
In server I like to use reactiveValues() to store a setupComplete condition. Then, when the data is loaded my setupComplete is set to TRUE.
In the ui we can then assess this setupComplete condition in a conditionalPanel, and only display the content (in my example the three box() widgets).
Here's a working example
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton(inputId = "btn_data", label = "Download"),
conditionalPanel(condition = "output.setupComplete",
box( title = "box1" ),
box( title = "box2" ),
box( title = "boc3" )
),
conditionalPanel(condition = "!output.setupComplete",
box( title = "loading"))
)
)
server <- function(input, output) {
rv <- reactiveValues()
rv$setupComplete <- FALSE
## simulate data load
observe({
if(input$btn_data){
df <- data.frame(id = seq(1,200),
val = rnorm(200, 0, 1))
## Simulate the data load
Sys.sleep(5)
## set my condition to TRUE
rv$setupComplete <- TRUE
}
## the conditional panel reads this output
output$setupComplete <- reactive({
return(rv$setupComplete)
})
outputOptions(output, 'setupComplete', suspendWhenHidden=FALSE)
})
}
shinyApp(ui, server)
The code
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
doesn't work with tabsetPanel. But if you move the id to the div level it works beautifully. Thanks to shinyjs author Dean Attali for this tip. https://stackoverflow.com/users/4432127/keshete
hidden(
div(id = "mainTabsetPanel",
tabsetPanel(
....