I am trying to dynamically add an input to a Shiny page. I want the user to select from a dropdown a choice and then have the option to add a numeric input corresponding to that choice.
Once I run the app I have two fields "Choice" and "Number". I want the user to click the "Add UI" button and be presented with another "Choice 2" and a "Number 2", when they click again they get "Choice 3" and "Number 3" etc.
Currently all I can manage to add is just another dropdown box. When I try to add numericInput(inputId = "numericWhichGoesWithIndicatorChoice", label = "Number", value = 3) to the insertUI part of the code I get errors.
Additionally, I would like to make it dynamic in the sense that the user can add as many inputs as they want and the inputs will be stored. i.e, inputId = "indicatorChoice", inputId = "indicatorChoice2", inputId = "indicatorChoice3" etc.
Code:
library(shiny)
ui <- fluidPage(
actionButton("add", "Add UI"),
wellPanel(
selectInput(inputId = "indicatorChoice", label = "Choice", choices = c("choice1", "choice2", "choice3")),
numericInput(inputId = "numericWhichGoesWithIndicatorChoice", label = "Number", value = 3)
)
)
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui = selectInput(inputId = "indicatorChoice", label = "Choice 2", choices = c("choice1", "choice2", "choice3"))
)
})
}
shinyApp(ui, server)
Related
I am creating an app which has one checkboxInput that if you click on it, you will have anoother options to select. These options are hidden by a conditionalPanel. You will only see them if you click the checkbox.
However, I was wondering if it is possible to put some tabulation into these options, because I don't want them to have the same level of organisation.
For example:
Code:
library(shiny)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Tab1",
checkboxInput("option1", "Remove...", value = FALSE),
conditionalPanel(
condition = "input.option1 == 1",
radioButtons(inputId = "type_removal", label=NULL,
choices = c("Remove 1" = "remove1",
"Remove 2" = "remove2"))),
textInput(inputId = "data2", "Data1", value = "data")),
tabPanel("Tab2",
textInput(inputId = "data", "Data1", value = "data")
),
)
),
mainPanel(
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Is it possible to do it in Shiny?
Thanks very much in advance
Regards
You can add inline style to the conditional panel:
conditionalPanel(
condition = "input.option1 == 1",
style = "margin-left: 100px;",
radioButtons(inputId = "type_removal", label=NULL,
choices = c("Remove 1" = "remove1",
"Remove 2" = "remove2"))),
Add this css to your shiny app:
.shiny-options-group{
margin-left: 20px;
}
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)
I'm a Shiny newbie and I have probably a simple question, but I swear I spent half day reading solutions here and can't find anything close to what I need.
Imaging you have a database with employees ID, name, last name, age.
I need to have in my app a text input that allows the user to enter the ID and to see on the same row the name, last name and age.
The problem I face is that textInput will have a label (say "ID").
All the three other fields, that I need to be on the same row, won't have a label.
So what I would need is either a way to add a label to the three textOutput elements or to display them as textInput with a default value that has to change/behave like an output as soon as a user enters a new ID. But how?
This is my sample code:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(column(2,
textInput("input_ID", label = "Cusip 1",
value = "123")),
column(2,
textOutput(outputId = "output_name")),
column(2,
textOutput(outputId = "output_lastname")),
column(2,
textOutput(outputId = "output_age"))
)
)
)
)
s <- function(input,output){
output$output_name <- renderText(
{ # here is where I will check in a database
paste("Sample Name")
})
output$output_lastname <- renderText(
{ # here is where I will check in a database
paste("Sample Last Name")
})
output$output_age <- renderText(
{ # here is where I will check in a database
paste("Sample Age")
})
}
shinyApp(ui=u,server=s)
Perhaps I have to use different widgets?
Thank you
I updated the code to change the label using an textInput as suggested in the comment. Perhaps it helps to understand exactly what you are looking for.
library(dplyr)
library(shiny)
library(shinyjs)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(
column(2, textInput("input_ID", label = "Cusip 1",value = "123")),
column(2, textInput("output_name", label = "Firstname") %>% disabled()),
column(2, textInput("output_lastname", label = "Lastname") %>% disabled()),
column(2, textInput("output_age", label = "Age") %>% disabled())))))
s <- function(input,output, session){
observe({
id <- input$input_ID
set.seed(id)
df <- list(firstname = sample(LETTERS, 1), lastname = sample(LETTERS, 1), age = sample(1:100, 1))
updateTextInput(session, inputId = "output_name", label = df[["firstname"]])
updateTextInput(session, inputId = "output_lastname", label = df[["lastname"]])
updateTextInput(session, inputId = "output_age", label = df[["age"]])
})
}
shinyApp(ui=u,server=s)
How I create label for my UI is simply adding a h3 tag above each textoutput:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(column(2,
textInput("input_ID", label = "Cusip 1",
value = "123")),
column(2,
h3("First Name: "),
textOutput(outputId = "output_name")),
column(2,
h3("Last Name: "),
textOutput(outputId = "output_lastname")),
column(2,
h3("Age: ),
textOutput(outputId = "output_age"))
)
)
)
)
I have the following code:
library(shiny)
vec <- seq(1,10)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
fluidRow(
selectInput("selection", "Select number", vec, multiple = TRUE),
actionButton("First_fives", "First Fives" ),
actionButton("Last_fives", "Last Fives"),
actionButton("ok", "OK"))
),
mainPanel(
fluidRow(
h5("Selected numbers:")),
textOutput('num')
)
)
)
server <- function(input, output, session) {
observeEvent(input$First_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[1:5])
})
observeEvent(input$Last_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[6:10])
})
data <- reactiveValues()
observeEvent(input$ok,{
data$selected <- input$city
})
output$num <- renderText({data$selected})
}
shinyApp(ui = ui, server = server)
I almost managed to do what I want but not quite.
My selectInput box is empty when running the code and you can select amongst 10 items (from 1 to 10). This is fine.
Now I would like, when clicking on the button "First fives", the numbers 1 to 5 to be added to this empty box. In others words I would like to get the same as on the picture below in one click.
Please add selected on the updateSelectInput. The code will be like this:
observeEvent(input$First_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[1:5],selected = vec[1:5])
})
observeEvent(input$Last_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[6:10],selected = vec[6:10])
})
Please not I have only checked this function,not others.
Pls check if this meet your requirements.
I use drop box to display three options,
selectInput("select", label = h5("Choose Annotation DB"),
choices = list("h10kcod.db"="h10kcod","h20kcod.db"="h20kcod","hwgcod.db"="hwgcod")),
selected = NULL)
But it always have the first choice in the drop box already selected, however i am interested to get the drop box empty(with no one selected). How should i do that. Thanks
Hello look at this example :
library("shiny")
ui = fluidPage(
# method 1 : put an empty element "" in your list
selectInput("select", label = h5("Choose Annotation DB"),
choices = list("", "h10kcod.db"="h10kcod","h20kcod.db"="h20kcod","hwgcod.db"="hwgcod")),
# method 2 : use selectizeInput and the placeholder option
selectizeInput("select", label = h5("Choose Annotation DB"),
choices = list("h10kcod.db"="h10kcod","h20kcod.db"="h20kcod","hwgcod.db"="hwgcod"),
options = list(placeholder = 'A placeholder',
onInitialize = I('function() { this.setValue(""); }')))
)
server = function(input, output) {
}
shinyApp(ui = ui, server = server)