I am making something i Shiny and am wondering whether it is possible to make radiobuttons decide another input.
A toy example that replicates my problem is given by:
if (interactive()) {
ui <- fluidPage(
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif")),
textInput(inputId = "textid", label = "Text input-header", value = "rnorm"),
plotOutput("distPlot")
)
server <- function(input, output) {
df <- reactive({
switch(input$textid,
rnorm = {rnorm(500)},
uni = {runif(500)},
exp = {rexp(500)},
)})
output$distPlot <- renderPlot(hist(df())
)
}
shinyApp(ui, server)
}
As it is now, it is the input in the text box that decides what kind of distribution, that is used to generate the data. What I would like is that when one clicks of one of the radio buttons then the text is updated in the text box (e.g. if "Uniform" is checked off, then the textunput is updated with "uni" - and thereby this distribution is used). The thing is that I need the box since I would like to be able to choose somethiong that is not an option among the radio buttons (so it does not work for me just to add extra radio buttons). The extra option in this case is, that one can write "exp" in the text input (this distribution cannot be chosen from a radio button).
It might seem a bit idiotic in this example, but in my case I have 2 very often used timestamps, but the app must allow the user to choose every possible date as well.
Is this somehow possible?
Thanks in advance!
Something like this? Note that I added the req where it is required to have your text input as one of "rnorm","uni","exp"
library(shiny)
if (interactive()) {
ui <- fluidPage(
radioButtons("dist", "Distribution type:",c("Normal" = "rnorm","Uniform" = "uni","Exponential" = "exp")),
textInput(inputId = "textid", label = "Text input-header", value = "rnorm"),
plotOutput("distPlot")
)
server <- function(input, output,session) {
observeEvent(input$dist,{
updateTextInput(session, "textid",label = "Text input-header",value = input$dist)
})
df <- eventReactive(input$textid,{
req(input$textid %in%c("rnorm","uni","exp"))
switch(input$textid, rnorm = {rnorm(500)},uni = {runif(500)}, exp = {rexp(500)},
)})
output$distPlot <- renderPlot(hist(df()))
}
shinyApp(ui, server)
}
Related
In R Shiny, I know you can use update*Input functions to adjust the labels/placeholders/values of inputs in response to user actions via linked observeEvent calls. For example, in the code below, the label for my textInput changes as soon as you start typing anything into it.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
textInput(inputId = "name",
label = "Enter your name!",
placeholder = "Placeholder")
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observeEvent(input$name, {
req(input$name)
updateTextInput(session,
"name",
label = "Wow, you're really doing it!")
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
However, I can't figure out how to change the formatting of the updated labels. In particular, I want to make them either bold or a different color so they stand out more. I've tried stuff like label = HTML(<b>"This is bold"</b>) and label = p(strong("This is bold")) and various variations on them inside the updateTextInput() call. I've looked at other related articles like How to make a label of a shiny widget the same as plain text? and How to format parts of a label bold? and How to change the pickerinput label to fine instead of bold and I'm just spinning my wheels! It looks like the update*Input functions work a bit differently than their corresponding *Input functions, so what works for one may not work for the other...
Yep, that doesn't work. Here is a trick. The label is bold by default so I change it to a red label instead.
library(shiny)
# UI ####
ui <- fluidPage(
textInput(inputId = "name",
label = uiOutput("thelabel", inline = TRUE),
placeholder = "Placeholder")
)
# Server ####
server <- function(input, output, session) {
TheLabel <- reactiveVal("Enter your name")
output[["thelabel"]] <- renderUI({
TheLabel()
})
observeEvent(input[["name"]], {
req(input[["name"]])
TheLabel(span("This is red", style = "color: red;"))
}, ignoreInit = TRUE)
}
# Run ####
shinyApp(ui = ui, server = server)
I am trying to create a shiny app where it allows you to select an input of what operation calculate. if the user chooses "Addition" it will show the two numeric input boxes (so they can input two numbers), if the user chooses "square" it will show only one numeric input box to square.
With this, I use conditionalPanel and if the condition is satisfied, it fetches through uiOutput() the numericInputs that I want. and same thing for square.
Now when I run this app, the conditional panels do not appear. Where did I go wrong? Thanks for checking out my question.
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),#sidebar panel
)#fluidpage
server <- function(input, output) {
output$basicmath <- renderText( ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation"))))),
output$var2 <- renderUI({
helpText("this will show to input two numerics to be added")
}) ,
output$var1 <- renderUI({
helpText("this will show to input one numeric to square")
})
)}
shinyApp(ui = ui, server = server)
The key issue you were having is that you put the uiOutputs inside the calculation output that you anticipated. It is better to separate them, since the calculation output won't run until it has the necessary prerequisite values (your input values). In addition, because you hadn't specified an output location for basicmath, the app didn't know where to put anything inside that call to renderText(). Below is working code that gets the right UI elements to appear.
One other thing you were missing in your renderUI was the use of tagList(). This helps ensure that all of your elements are packaged together, not just the last one.
Note that the math part does not work, but it looks like that was just a placeholder. When you do start to use it, be sure to use unique ids for each input. You have several instances of input$a and input$b, which probably isn't a workable approach.
library(shiny)
library(shinythemes)
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),
mainPanel(
textOutput("basicmath")
)
)#fluidpage
server <- function(input, output) {
output$var2 <- renderUI({
tagList(
helpText("this will show to input two numerics to be added"),
splitLayout(
numericInput("var2a", label = "Input one number", value = NULL),
numericInput("var2b", label = "Input another number", value = NULL)
)
)
})
output$var1 <- renderUI({
tagList(
helpText("this will show to input one numeric to square"),
numericInput("var1a", label = "Input a number", value = NULL)
)
})
output$basicmath <- renderText( {ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation")))))
})
}
shinyApp(ui = ui, server = server)
For a project I am using multiple numericInput fields in shiny to enter certain amounts. The app user should be able to add new amounts if needed and type in any kind of numeric value, either via the arrows or manually. However, when adding new fields and trying to add amounts manually the input seems to "jump" and sometimes the whole app crashes.
I thought about using textInput fields instead of numericInput but this does not seem to work either.
This is a MWE of the code I am using. Once you add a couple of amount fields via the plus-button and enter values manually, it starts jumping/not working.
ui <- fluidPage(#....design etc.,
mainPanel(
uiOutput("inputwidgets"),
actionButton(inputId = "number",
label = icon(name = "plus",
lib = "font-awesome")),
actionButton(inputId = "delete_number",
label = icon(name = "minus",
lib = "font-awesome")),
actionButton("update", "Calculate")
)
)
server <- function(input, output) {
reac <- reactiveValues()
observeEvent(c(input$number,input$delete_number), {
# you need to add 1 to not start with 0
add <- input$number+1
# restriction for delete_number > number
delete <- if(input$delete_number > input$number) add else input$delete_number
calc <- add - delete
reac$calc <- if(calc > 0) 1:calc else 1
})
# By clicking the actionButton "number" an additional row appears
observe({
req(reac$calc)
output$inputwidgets = renderUI({
input_list <- lapply(reac$calc, function(i) {
amount <- input[[paste0("amount",i)]]
# for each dynamically generated input, give a different name
fluidRow(
column(2,
# Input: Specify the amount ----
numericInput(
paste0("amount",i),
label="Amount",
#step = 1000,
value = if(!is.null(amount)) amount else 0
)
)
)
})
do.call(tagList, input_list)
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
This issue is really annoying and disturbs the whole user experience.
Would be grateful about any kind of help with this.
I am pretty new to Shiny and for the app I am building, I need to add an input to a radioButton selection.
This is the code for my radioButton:
values <- c("Carbs" = "carbs", "Proteins" = "prots", "BMI" = "bmi"),
radioButtons("plotVal", "What value do you want to plot?", choices = values)
I would like to add an input field. If the user doesn't find the right choice, he could enter his own value. The end result would be something like that:
What value do you want to plot?
O Carbs
O Proteins
O BMI
O [Other... ]
The [Other... ] choice would be a textInput.
I've searched the web and read all the tutorials for inputs that I found but I didn't find this specific case of figure. Can anyone help me out? Thank you.
You could use updateRadioButtons:
library(shiny)
values <- c("Carbs" = "carbs", "Proteins" = "prots", "BMI" = "bmi")
ui <- fluidPage(
radioButtons("plotVal", "What value do you want to plot?", choices = values),
textInput("other", "Type in additional category"),
actionButton("add", "Add category")
)
server <- function(input, output, session) {
observeEvent(input$add, {
req(input$other)
otherVal <- "other"
names(otherVal) <- input$other
updatedValues <- c(values, otherVal)
updateRadioButtons(session, "plotVal", choices = updatedValues)
})
}
shinyApp(ui = ui, server = server)
I'm working on a very simple Shiny app that takes in a DNA codon and returns the corresponding amino acid. My issue is that I want to validate the user input so that it can only accept 3 letter (a single codon), must be capital letters, and only accept the DNA bases ( A, C, T, or G). I've had a look at Shiny's validation article, but keep on running into errors.
Here is the code I have so far:
ui.R
library(shiny)
library(shinythemes)
shinyUI(fluidPage(
theme = shinytheme("slate"),
# Application title
titlePanel("Codon lookup"),
#
sidebarLayout(
sidebarPanel(
textInput(
inputId = "codon",
label = "Enter a codon",
value = ""),
actionButton(inputId = "go", label = "Search")
),
#
mainPanel(
verbatimTextOutput("aminoacid")
)
)
))
server.R
library(shiny)
library(Biostrings)
shinyServer(function(input, output) {
data <- eventReactive(input$go, {
#validate somehow
input$codon
})
output$aminoacid <- renderText({
GENETIC_CODE[[as.character(data())]]
})
})
Also, if anyone know of an easy way to retrieve the amino acid's full name, rather than just the single letter notation, that would be helpful. Any other suggestions are welcomed.
That reactive is not really the right place to do the validation in this case since you are not using GENETIC_CODE there. So I moved it into the renderText output node. If you had a reactive doing the lookup you could do it there.
I looked at GENETIC_CODE, and it seems to make more sense to do this as a dropdown anyway and use that as validation. So I went ahead and put a selectInput in there using renderUI, as you have more flexibility if you create the input control in the server usually.
I also moved the Search button to above the codon select control as it was getting covered up by the selection.
library(shiny)
library(shinythemes)
u <- shinyUI(fluidPage(
theme = shinytheme("slate"),
# Application title
titlePanel("Codon lookup"),
#
sidebarLayout(
sidebarPanel(
actionButton(inputId = "go", label = "Search"),
uiOutput("codonselection")
),
#
mainPanel(
verbatimTextOutput("aminoacid")
)
)
))
library(Biostrings)
s <- shinyServer(function(input, output) {
data <- eventReactive(input$go, {
input$codon
})
output$codonselection <- renderUI({
choices <- names(GENETIC_CODE)
default <- "TTC"
selectInput("codon",label="Select Codon",choices=choices,selected=default)
})
output$aminoacid <- renderText({
lookupcodon <-as.character(data())
if (lookupcodon %in% names(GENETIC_CODE)){
return(GENETIC_CODE[[ lookupcodon ]])
} else {
return("Name not in GENETIC_CODE")
}
})
})
shinyApp(u,s)
Screen shot of it working: