# USER INTERFACE ####
ui <- fluidPage(
navbarPage(
tabPanel(
"TAB1",
mainPanel(
tabPanel(
"Subtab1",
fluidRow(
"TEF",
column(
12,
box(6, "CE", plotOutput("plot1")),
box(6, "CO", plotOutput("plot2"))
)
)
)
)
)
)
)
# SERVER ####
server <- function(input, output, session) {
output$plot1 <- renderPlot(plot(mtcars$mpg, mtcars$cyl))
output$plot2 <- renderPlot(plot(mtcars$mpg, mtcars$gear))
}
shinyApp(ui = ui, server = server)
Error
Error in box(6, "CE", plotOutput("plot1")) :
plot.new has not been called yet
I did not have this error but I had another.
To correct it, I added the width= argument to the box function. Note that your are note supposed to use several Page functions in one shiny app. You are supposed to either chose fluidPage OR navbarPage OR shinydashboardPage. Only the last one enables you to correctly use the box function from {shinydashboard}.
ui <- fluidPage(
tabPanel(
"TAB1",
mainPanel(
tabPanel(
"Subtab1",
fluidRow(
"TEF",
column(
12,
# Note that to correctly use the `shinydashboard::box` function,
# you are supposed to use shinydashboardPage instead of fluidPage
box(width=6, "CE", plotOutput("plot1")),
box(width=6, "CO", plotOutput("plot2"))
)
)
)
)
)
)
Related
I am using auth0 package for authentication in shiny. The package contains auth0::logoutButton(). I would like to put these button on the right side of the NavbarPage in Shiny app. Here is a simple app:
library(shiny)
library(markdown)
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
)
###
# HERE ADD loginButton() in new panel that will be on the right side for test any actionbutton
###
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
shinyApp(ui = ui, server = server)
You can try with actionbutton instead of loginButton. The solution will be the same.
I'm not sure exactly what the HTML would be for auth0:logoutButton(), but you can add an action button to the upper right side of the navbarPage by adding an HTML script after your last tabPanel like this:
library(shiny)
library(markdown)
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
),
tags$script(
HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right; padding-top: 8px\"><button id=\"signin\" type=\"button\" class=\"btn btn-primary action-button\" onclick=\"signIn()\">Sign In</button></div>')")
)
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
Note: this code calls an undefined signIn() function, so you would want to alter the onclick behavior to match what you're trying to do.
If you prefer sticking with shiny functions actionButton or actionLink, you may find this helpful:
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
),
actionLink("signing", "", icon = icon("sign-in-alt"),
style = "position: absolute; right: 20px; top: -3px")
)
I'm not familiar with auth0 but here's a generic solution. You can add a reactive expression to the server or an onclick argument to actionButton.
library(shiny)
ui <- fluidPage(
style = "padding: 0px;", # no gap in navbar
actionButton("logout", "Log Out", icon = icon("user"),
style = "position: absolute; top: 5px; right: 5px; z-index:10000;"),
navbarPage(
title = "My App",
tabPanel("Panel 1", h1("Hi there"))
)
)
server <- function(input, output, session) {
observeEvent(input$logout, {
# do something
})
}
shinyApp(ui, server)
I want to call the function fziim (defined previously) whose arguments depend on the values of two widgets defined in the ui. The function returns a list with several plots that I want to display.
I try the following code but can't make it run properly, as the elements of the list appear not be accessible
first the ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(9,
selectInput("sector", h4("Sector"),
choices = list("S1","S1")
, selected = 1))# need to insrt instead list with sector names
),
fluidRow(
column(9,
numericInput("num1",
h4("Investment value (million $)"),
value = "100"))
)
),
mainPanel(
tabsetPanel(
tabPanel("Trade Balance",
fluidRow(
plotOutput("graph_trade")
)
),
tabPanel("Imports",
fluidRow(
plotOutput("graph_imports")
)
),
tabPanel("Exports",
fluidRow(
plotOutput("graph_exports")
)
),
tabPanel("Supply chain",
fluidRow(
plotOutput("graph_supply_chain")
)
),
tabPanel("Taxes",
fluidRow(
plotOutput("graph_all_taxes")
)
),
tabPanel("Employment",
fluidRow(
plotOutput("graph_employment"),
)
)
)
)
)
)
And the server is as follows:
server <- function(input, output) {
impacts_update<-fziim(sector =input$sector,investment =input$num1 )
output$graph_all_taxes<-renderPlot({
impacts_update$graph_all_taxes
})
output$graph_employment<-renderPlot({
impacts_update$graph_employment
})
output$graph_trade<-renderPlot({
impacts_update$graph_trade_balance
})
output$graph_imports<-renderPlot({
impacts_update$graph_imports_blockade
})
output$graph_exports<-renderPlot({
impacts_update$graph_exports_blockade
})
output$graph_supply_chain<-renderPlot({
impacts_update$graph_domestic
})
}
Where fziim looks like:
fziim<-function(sector, investment){
g1<-plot1
g2<-plot2
g3<-plot3
g4<-plot4
g5<-plot5
g6<-plot6
output<-list(g1,g2,g3,g4,g5,g6)
return(output)
}
Here is a reproducible app that hits the main points of what you are after. We make the
impacts_update a reactive function and call it in every renderPlot function. Doing so allows us to assign it to a regular variable and pull from the list of data.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("A","Test",choices=c(1,2,3)),
selectInput("B","TEest",choices=c(1,2,3))
),
mainPanel(
plotOutput("graph_all_taxes"),
plotOutput("graph_employment")
)
))
server <- function(input, output) {
fziim<-function(A,B){
C<-(1:3)
A<-as.numeric(A)
dfA<-data.frame(A,C)
g1<-dfA
B<-as.numeric(B)
dfB<-data.frame(B,C)
g2<-dfB
return(list(g1,g2))
}
impacts_update<-reactive({
fziim(input$A, input$B)
})
output$graph_all_taxes<-renderPlot({
graph_tax<-impacts_update()
graph_tax<-unlist(graph_tax)
plot(graph_tax[1])
})
output$graph_employment<-renderPlot({
graph_tax2<-impacts_update()
graph_tax2<-unlist(graph_tax2)
plot(graph_tax2[2])
})
#And so on...
}
shinyApp(ui = ui, server = server)
Note: My fiizm function is only for testing purposes.
Main change
How we create the list
impacts_update<-reactive({
fziim(sector =input$sector,investment =input$num1)
)}
How we call the list
output$graph_all_taxes<-renderPlot({
graph_tax<-impacts_update()
graph_tax<-unlist(graph_tax)
plot(graph_tax[1])
})
I have a Shiny App that takes a text input and shows it on the main panel (I used this answer to build it):
ui.r:
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
h3(textOutput("text1", container = span))
)
)
)
)
server.r:
shinyServer(function(input, output) {
cap <- eventReactive(input$goButton, {
input$text1
})
output$text1 <- renderText({
cap()
})
})
It worked great until I decided to add a Tabset panel, and show the input on one of the tabs. I modified mainPanel() in ui.r as:
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("t1"),
tabPanel("t2",
tabPanel("t3"), h3(textOutput("text1", container = span)),
)
)
After this change, I am getting an error when launching an app:
ERROR: cannot coerce type 'closure' to vector of type 'character'
Is there something I am missing?
You have to put the content within the tab within the call to tabPanel. Ex:
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
Thus, server.R is unchanged from you question, and ui.R becomes:
library(shiny)
shinyUI(
fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
)
)
)
I got this UI
(reproductible code):
library(shiny)
ui <- fluidPage(
sidebarPanel(
tabsetPanel(
tabPanel("tab1", checkboxInput("opt1", "opt1 for 1 tab")),
tabPanel("tab2", checkboxInput("opt2", "opt2 for 2 tab"))
)
),
mainPanel(
navbarPage("choose page",
navbarMenu("page1",
tabPanel("panel1",
mainPanel(plotOutput("plot1"))
),
tabPanel("panel2", plotOutput("plot2"))
),
navbarMenu("page2", tabPanel("panel3", plotOutput("plot3")), tabPanel("panel4", plotOutput("plot4")))
)
)
)
server <- function(input, output){
}
shinyApp(ui, server)
I want to add in sidebarPanel:
checkboxInput ONLY for page1 and panel1
checkboxInput ONLY for page1 (common for panel1 and panel2)
is it possible with shiny?
Yes, put an id to the navbarPage and use conditionalPanel:
ui <- fluidPage(
sidebarPanel(
conditionalPanel(
'input.navbar == "panel1"',
checkboxInput("checkbox1", "Hello")
),
conditionalPanel(
'input.navbar == "panel1" || input.navbar == "panel2"',
checkboxInput("checkbox1", "Goodbye")
)
),
mainPanel(
navbarPage("choose page",
navbarMenu("page1",
tabPanel("panel1",
mainPanel(plotOutput("plot1"))
),
tabPanel("panel2", plotOutput("plot2"))
),
navbarMenu("page2", tabPanel("panel3", plotOutput("plot3")), tabPanel("panel4", plotOutput("plot4"))),
id = "navbar"
)
)
)
Why it doesn't work good?
library(shiny)
ui <- fluidPage(
navbarPage("Choose page: " ,
navbarMenu("Discovering the dataset",
sidebarPanel(
checkboxInput("x", "x")
),
tabPanel("volume", mainPanel(plotOutput("pp"))),
tabPanel("amount salary"),
tabPanel("map"),
tabPanel("data"),
tabPanel("animation"),
tabPanel("wordcloud")
),
navbarMenu("Options"),
navbarMenu("More information")
)
)
server <- function(input, output){
output$pp <- reactivePlot({plot(1,1)})
}
shinyApp(ui, server)
here I want the checkbox for all barpage Discovering the dataset
I'm using conditionalPanel to create a UI that first presents a panel with options to the user and then displays a tabbed dashboard using tabsetPanel. The simple act of adding another tabPabel as shown below somehow prevents the server.R file from running. I've tested using print statements. It seems like the Shiny app is breaking, but I can't find a syntax error or any reason for it to be.
conditionalPanel(
condition = "output.panel == 'view.data'",
tabsetPanel(id = "type",
tabPanel("Script", value = "script",
fluidPage(
br(),
fluidRow(
column(3, uiOutput("script.name")),
column(3, uiOutput("script.message"))
),
hr(),
plotlyOutput("plotly")
)
),
tabPanel("Location", value = "location",
fluidPage(
br(),
fluidRow(
# column(3, uiOutput("id.range"))
),
hr(),
plotlyOutput("plot")
)
)
# when this tabPanel is uncommented it doesn't work
# ,tabPanel("Accelerometer", value = "accelerometer",
# fluidPage(
# br(),
# hr(),
# plotlyOutput("plot")
# )
# ),
)
)
It's not failing because of the additional tabPanel, it's failing because it contains a duplicate reference to output$plot. Each output of the server function can only be displayed once. For example, this runs, but will fail if the duplicated line is uncommented:
library(shiny)
ui <- shinyUI(fluidPage(
# textOutput('some_text'),
textOutput('some_text')
))
server <- shinyServer(function(input, output){
output$some_text <- renderText('hello world!')
})
runApp(shinyApp(ui, server))
A simple solution is to save the results of the render* function to a local variable, which you can then save to two outputs:
library(shiny)
ui <- shinyUI(fluidPage(
textOutput('some_text'),
textOutput('some_text2')
))
server <- shinyServer(function(input, output){
the_text <- renderText('hello world!')
output$some_text <- the_text
output$some_text2 <- the_text
})
runApp(shinyApp(ui, server))