In the example below how I can have "Input two" match the appearance of "Input one" in terms of bolding the font and putting the label above the checkbox?
I imagine the answer is some kind of css wizardry but not sure how to approach it.
ui <- fluidPage(
fluidRow(
column(3,
sliderInput(inputId = "foo",label="Input one",min = 0,max = 100,value = 50,step = 10)
),
column(3,
checkboxInput(inputId = "bar",label="Input two")
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
One simple solution could be:
library(shiny)
ui <- fluidPage(
fluidRow(
column(3,
sliderInput(inputId = "foo",label="Input one",min = 0,max = 100,value = 50,step = 10)
),
column(3,
p(strong("Input two")),
checkboxInput(inputId = "bar",label=NULL)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
Related
Is there a way to collapse the sidebar by default. Right now, it is showing by default once the application is open. Can we make it collapsed by default
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),
mainPanel(actionButton("toggleSidebar", "Toggle sidebar")
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
})
}
shinyApp(ui, server)
Here is a UI based solution which avoids flashing the sidebarPanel on startup:
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(),
navbarPage("",
tabPanel(
"tab",
div(id = "sidebarWrapper", sidebarPanel(), style = "display: none;"),
mainPanel(actionButton("toggleSidebar", "Toggle sidebar"))
)))
server <- function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "sidebarWrapper")
})
}
shinyApp(ui, server)
PS: the same can be achived by using shinyjs::hidden(div(<...>)).
You can use the ignoreNULL argument at FALSE to trigger at initialization:
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}, ignoreNULL = FALSE)
With the Github version of shinyGizmo (which should be on CRAN soon) you can toggle the sidebar with amazing effects:
# remotes::install_github("r-world-devs/shinyGizmo")
library(shiny)
library(shinyGizmo)
ui <- fluidPage(
navbarPage(
"",
tabPanel(
"tab",
conditionalJS(
div(
id = "Sidebar",
sidebarPanel(
sliderInput(
"obs", "Number of observations:",
min = 0, max = 1000, value = 500
)
)
),
condition = "input.toggleSidebar % 2 === 1",
jsCalls$animateVisibility("jello", "tada", duration = 1500)
),
mainPanel(
actionButton("toggleSidebar", "Toggle sidebar")
)
)
)
)
server <-function(input, output, session) {
}
shinyApp(ui, server)
I am trying to build a shiny app where the user can decide how many tabs he wants to be shown. Here's what I have so far:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
tabsetPanel(
lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
value = h3(glue("Content {i}"))
)
})
)
})
}
shinyApp(ui = ui, server = server)
This does not produce the desired results, as the comparison tabs are not shown properly.
I have already checked out these 2 threads:
R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
R Shiny dynamic tab number and input generation
but they don't seem to solve my problem. Yes, they create tabs dynamically with a slider, but they don't allow to fill these with content as far as I can tell.
What works for me is a combination for lapply and do.call
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
myTabs = lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
h3(glue("Content {i}"))
)
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui = ui, server = server)
I am new in shiny, I wonder how to put the "=" close beside the selectInput box?
library(shiny)
ui = fluidPage(
mainPanel(
titlePanel("Calculation:"),#Voltage calculation
fluidRow(
column(3,
selectInput("selc11", h4("Cable"),#Resistivity
choices = list("Copper" = 0.0174, "Alum" = 0.0282), selected = 1)),
h4("=")
)
)
)
server = function(input, output) {
}
shinyApp(ui = ui, server = server)
If you want something like this:
You can achive it with:
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
mainPanel(
titlePanel("Calculation:"),#Voltage calculation
fluidRow(
column(1, h4('Cable')),
column(3, selectInput(
"selc11",
label = '',
choices = list("Copper" = 0.0174, "Alum" = 0.0282), selected = 1)
),
column(3, h4("="))
)
)
)
server = function(input, output) {
runjs("$('label.control-label').remove()")
}
shinyApp(ui = ui, server = server)
I am currently developing a Shiny App. In that I am not getting the expected output. The expected output is
But the output I get is
This is the code used
ui.R
shinyUI(
dashboardPage(
dashboardSidebar(
sidebarMenu(
id = 'MENU', badgeColor = "aqua",
menuItem('VIEW', tabName = 'view'),
menuItem('EDIT',tabName = 'edit')
)
),
dashboardBody(
tabItems(tabItem(tabName = "edit",
uiOutput("moreControls"))))
server.R
shinyServer(function(input, output, session) {
output$moreControls <- renderUI({
wellPanel(
fluidRow(column(4,wellPanel(
wellPanel("PEOPLE", style = "background-color:#0ec3c6;border-color:#0ec3c6;text-align:center;color: white;font-size: 24px;font-style: bold ;padding: 12px;"),
style ="background-color:RGB(255,255,255); border-color:RGB(255,255,255);align:right;",
textInput('email', 'Enter Email_Id'),
textInput('fn', ' Enter First Name')))))})
})
Can anyone help me with this issue? Thanks in advance..
Below code will give you the required wellPanel layout.
Note: I didn't use your full code, just tried to achieve specified layout. So replace the code block if it solves your problem.
library(shiny)
ui <- fluidPage(
wellPanel(
fluidRow(column(4,
fluidRow(wellPanel("PEOPLE", style = "background-color:#0ec3c6;border-color:#0ec3c6;text-align:center;color: white;font-size: 24px;font-style: bold ;padding: 12px;")),
style = "background-color:RGB(255,255,255); border-color:RGB(255,255,255);align:right;",
fluidRow(column(4, "Enter Email-ID"), column(8, textInput(label = NULL, inputId = 'EmailID' ))),
fluidRow(column(4, "Enter First Name"), column(8, textInput(label = NULL, inputId = 'FirstName')))))))
server <- function(input, output, session) {
onSessionEnded(stopApp)
}
shinyApp(ui, server)
I am trying to create a shiny app with multiple tabs. Each tab is to have its own sidebar. I haven't been able to get this to work. Any help on what is wrong would be appreciated.
Below is the code
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
selectizeInput('invar',"Reg in", choices = varnames, multiple = TRUE)),
conditionalPanel(condition = "input.tabs1==2",
selectizeInput('outvar',"Reg out", choices = predictors, multiple = FALSE)),
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input"),
tabPanel("output",value=2,plotOutput("Output")
))))
))
First of all, check your code again. You made following mistakes:
one tabPanel is nested inside the other one
there's an extra comma at the end of the second conditionalPanel(), so you pass an empty element to sidebarPanel()
If I correct your mistakes and create a mock example, it works perfectly fine as is. So there isn't really a problem here:
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
selectizeInput('invar',"Reg in", choices = letters[1:3], multiple = TRUE)),
conditionalPanel(condition = "input.tabs1==2",
selectizeInput('outvar',"Reg out", choices = letters[4:6], multiple = FALSE))
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output"))
)
)
))
server <- function(input, output, session){
output$Input <- renderPlot(plot(1))
output$Output <- renderPlot(plot(2))
}
shinyApp(ui, server)
You could do this as well by using renderUI:
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
uiOutput("mysidebar")
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output")
)))
))
server <- function(input, output, session){
output$mysidebar <- renderUI({
if(input$tabs1 == 1){
selectizeInput('invar',"Reg in", choices = letters[1:3])
} else if(input$tabs1 == 2){
selectizeInput('outvar',"Reg out", choices = letters[4:6])
}
})
}
shinyApp(ui,server)
I do this in a very different but effective way.
shinyApp(
shinyUI(
fluidPage(
uiOutput('mainpage')
)
),
shinyServer(function(input, output, session) {
panel <- reactiveValues(side = NULL)
output$mainpage <- renderUI({
sidebarLayout(position = "left",
sidebarPanel(
uiOutput(panel$side)
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output"))
)
)
})
output$sideinput <- renderUI({
tagList(
selectizeInput('invar',"Reg in", choices = varnames, multiple = TRUE))
)
})
output$sideoutput <- renderUI({
tagList(
selectizeInput('outvar',"Reg out", choices = predictors, multiple =FALSE)
)
})
observeEvent(input$tabs1,{
panel$side <- switch(input$tabs1,
1 = 'sideinput',
2 = 'sideoutput')
})
basically I am using observers as my conditionals and assigning the value of the desired panel to the variable name assigned to that panel position