How to position a button in fluidRow column - css

I'm trying to place a selectInput box beside an actionButton in a shiny app, using fluidRow & column arguments. However the button gets placed at the top of its column.
Using text-align:center in the div places the button centre-top in the column view. I'd like the actionButton to be at the same height as the selectBox on its left.
I'm just beginning to get into some CSS because of Shiny but am at a loss here.
Thanks in advance :)
ui <- fluidPage(title = "Working Title",
sidebarPanel(width = 6,
# *Input() functions
fluidRow(column(6, selectInput("Input1", label = h3("Select Input 1"), choices = list( "A" = "A", "B" = "B"), selected = 1)),
column(6, div(style = "background-color:yellow; text-align:center;", actionButton("goButtonSetInput1", "SetInput1")))
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)

You can do that by adding another fluidRow, and setting the label =NULL
ui <- fluidPage(title = "Working Title",
sidebarPanel(width = 6,
# *Input() functions
fluidRow(column(6, h3("Select Input 1") )),
fluidRow(column(6, selectInput("Input1", label = NULL, choices = list( "A" = "A", "B" = "B"), selected = 1)),
column(6, div(style = "background-color:yellow; text-align:center;", actionButton("goButtonSetInput1", "SetInput1")))
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)

Related

shiny addpopover function doesnt work with uioutput

I have created the following shiny App in R
First we import the necessary libraries
library(shiny)
library(shinyBS)
The next step is to create a UI as follows
ui = fluidPage( sidebarLayout( sidebarPanel(sliderInput("bins", "Number of bins:", min = 1, max =
50,value = 30), selectInput(inputId = "Select1", label = "Select1", choices = c('A', 'B', 'C'),
selected = "A"), selectInput(inputId = "Select2", label = "Select2", choices = c('A1', 'B1', 'C1'),
selected = "A1"), bsTooltip("bins", "Read", "right", options = list(container = "body")) ),
mainPanel(uiOutput("namelist") ) ))
We now create the Server as follows
server =function(input, output, session) {
content<-reactive({
input$Select2
})
output$namelist<-renderUI({
textInput(inputId = "text1", label =input$Select1)
})
addPopover(session, "namelist", "Data", content =content() , trigger = 'click') }
shinyApp(ui, server)
The App on running will create a slider and two select boxes and an output that reacts dynamically to user input. the tooltip displays the bubble with read when one hovers over the slider. I am unable to get the addpopover function to work. It should work such that based on the input of select 2, the text rendered in the popover message box should change. The App is crashing . When i place the addpopover command within a reactive environment, I am the renderUI functions output- namely the textbox disappears. I request someone to help me here.
You can wrap addPopover in observe or observeEvent. I would prefer observeEvent, as recommended here.
addPopover will be updated each time content() changes, which is what we want since this popover is supposed to show content(). However, there is something strange about the behaviour of this popover (clicks are sometimes ineffective) but I guess this is not related to your app in particular.
library(shiny)
library(shinyBS)
ui = fluidPage(sidebarLayout(
sidebarPanel(
sliderInput(
"bins",
"Number of bins:",
min = 1,
max =
50,
value = 30
),
selectInput(
inputId = "Select1",
label = "Select1",
choices = c('A', 'B', 'C'),
selected = "A"
),
selectInput(
inputId = "Select2",
label = "Select2",
choices = c('A1', 'B1', 'C1'),
selected = "A1"
),
bsTooltip("bins", "Read", "right", options = list(container = "body"))
),
mainPanel(uiOutput("namelist"))
))
server =function(input, output, session) {
content<-reactive({
input$Select2
})
output$namelist<-renderUI({
textInput(inputId = "text1", label = input$Select1)
})
observeEvent(content(), {
addPopover(session, "namelist", "Data", content = content() , trigger = 'click')
})
}
shinyApp(ui, server)

dateRangeInput R Shiny Control Alignment

I've been trying to align dateRangeInput control in R Shiny for a while now(more than 2hours) but still not able to do so. I've also searched Stackoverflow and found solutions that conveniently does the job for other controls, such as textInput or numericInput. But, when it comes to dateRangeInput what I've seen so far fail. Please if someone could help me with this, I'd appreciate. Following is a stand-alone code(also picked up from Stackoverflow):
library("shiny")
ui <- fluidPage(
fluidRow(
column(width = 4,
tags$form(
class="form-horizontal",
tags$div(
class="form-group",
tags$label(class = "col-sm-4 control-label", `for` = "Area1000", "Area"),
column(width = 4, dateRangeInput("date_range", label="", start="1900-01-01",
end ="2099-12-31",
min = "1900-01-01",
max = "2099-12-31"))
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
There is already an empty label being created by the dateRangeInput (as documented at: https://shiny.rstudio.com/reference/shiny/1.1.0/dateRangeInput.html)
label: Display label for the control, or NULL for no label.
So if you used dateRangeInput("date_range", label = NULL ... your current code should work.
library("shiny")
ui <- fluidPage(
fluidRow(
column(width = 4,
tags$form(
class="form-horizontal",
tags$div(
class="form-group",
tags$label(class = "col-sm-4 control-label", `for` = "date_range", "Area"),
column(width = 4, dateRangeInput("date_range", label = NULL, start="1900-01-01",
end ="2099-12-31",
min = "1900-01-01",
max = "2099-12-31"))
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I would also change the for declaration to date_range to match the id on the date range input element.

Updatepickerinput with change in pickerinput in Shiny

I want to update the Pickerinput with change in another PickerInput.How can I do it in server side in Shiny?
You could use observeEvent function at the server side to monitor the status of pickerInput #1 then use updatePickerInput function to update pickerInput #2.
Please see the code below, which takes the first letter in pickerInput #1 and chooses the content of pickerInput #2 accordingly:
library("shiny")
library("shinyWidgets")
ui <- fluidPage(
tags$h2("Update pickerInput"),
fluidRow(
column(
width = 5, offset = 1,
pickerInput(
inputId = "p1",
label = "Starting Letters",
choices = LETTERS
)
),
column(
width = 5,
pickerInput(
inputId = "p2",
label = "Names of Cars",
choices = ""
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$p1, {
updatePickerInput(session = session, inputId = "p2",
choices = grep(paste0("^",input$p1), rownames(mtcars), value = TRUE))
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
}
Output:

dynamic number of selectInput

I am new to shiny so this might be a very basic question.
I want to write a shiny app where the user inputs 'n' and we get n number of selectInput options and am not able to do it. Basically any form of for loop is not working.
The code I attempted is following
library(shiny)
ui = fluidPage(
sidebarLayout(
sidebarPanel(
textInput(inputId = "number", label = "number of selectInput",value = 5)
),
mainPanel(
uiOutput(outputId = "putselect")
)
)
)
server = function(input,output){
output$putselect = renderUI(
if(input$number != 0 ){
for(i in 1:(input$number)){
selectInput(inputId = "i", label = "just write something", choices = c(2,(3)))
}
}
)
}
shinyApp(ui = ui , server = server)
You either need to store the inputs you create in a list and return that list, or you can simply wrap your statement in lapply instead of for. A working example is given below, hope this helps!
library(shiny)
ui = fluidPage(
sidebarLayout(
sidebarPanel(
textInput(inputId = "number", label = "number of selectInput",value = 5)
),
mainPanel(
uiOutput(outputId = "putselect")
)
)
)
server = function(input,output){
output$putselect = renderUI(
if(input$number != 0 ){
lapply(1:(input$number), function(i){
selectInput(inputId = "i", label = paste0("input ",i), choices = c(2,(3)))
})
}
)
}
shinyApp(ui = ui , server = server)

How to overwrite output using 2nd action button

I have a shiny app which writes a dataframe to output when an action button is pressed. This is the "Go" button in the bare-bones example below. I have a reset button which resets the values of the inputs. I'm wondering how I might also reset the output (so it becomes NULL & disappears when "reset" is pressed).
I've tried to pass input$goButtonReset to the eventReactive function (with the intention of using an if statement inside to indicate which button was making the call) but this didn't seem to be possible.
Any help much appreciated!
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
observeEvent(input$goButtonReset, {
updateSelectInput(session, "Input1", selected = "NULL")
})
writePF <- eventReactive(input$goButton, {
data.frame("test output")
})
output$pf <- renderTable({
writePF()
})
}
shinyApp(ui = ui, server = server)
You could try using reactiveValues to store the data frame. This worked for me:
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
df <- reactiveValues()
observeEvent(input$goButton,{
df$writePF <- data.frame("test output")
})
observeEvent(input$goButtonReset,{
df$writePF <- NULL
})
output$pf <- renderTable({
df$writePF
})
}
shinyApp(ui = ui, server = server)

Resources