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:
Related
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)
I am trying to capture the url that has been selected when a person presses the "GET URLS" button on the app.
What should happen is that the event reactive() should look at the input$go_button and see that it has been pressed - it should then perform the expression to take the chosen url from the select input- unfortunately it does nothing.
I have tried debugging with browser() but still had no affect.
All i am trying to do is capture the url that has been selected when a person "presses" the "GET URLS" button.
my sample code is below:
library(shiny)
# Use a fluid Bootstrap layout
ui <- fluidPage(
# Give the page a title
titlePanel("testing select"),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
selectInput("url_selection", "select url:",
choices = c(
'/multi-task/',
"/personal-account",
"/paperless"
)
),
actionButton(inputId = "go_button", label = "Get URLS")
),
# Create a spot for the barplot
mainPanel(
textOutput(outputId = "urls_selected_print")
)
)
)
server <- function(input, output) {
url_capture <- reactive({eventReactive(eventExpr = input$go_button,
valueExpr = {
message("capturing url chosen in selectize input")
chosen_url <- input$url_selection
browser()
return(chosen_url)
})
})
}
shinyApp(ui, server)
You can use observeEvent to capture event when go_button has been pressed. You can store the selection in a reactiveVal which can be displayed in your output.
server <- function(input, output) {
rv <- reactiveVal(NULL)
observeEvent(input$go_button, {
message("capturing url chosen in selectize input")
rv(input$url_selection)
})
output$urls_selected_print <- renderText({rv()})
}
Small alternative to Ben's answer (you just have to remove reactive, because eventReactive is already reactive):
server <- function(input, output) {
url_capture <- eventReactive(eventExpr = input$go_button,
valueExpr = {
message("capturing url chosen in selectize input")
chosen_url <- input$url_selection
return(chosen_url)
})
output$urls_selected_print <- renderPrint({
url_capture()
})
}
I have an application which has 3 tabItems. I want to use a slider on second page to display same result on 3rd page interactively, i.e. if 2nd page slider changes then 3rd page slider should also change respectively.
I have a reactive function on server side
choose_segment <- reactive({
Multiple conditions for dropdown{Due to security cant share the exact code.}
})
and this choose_segment is refered in UI once and now i want to use it on the third page as well, but when i am calling the function on third page it is not displaying any thing on ui and also not giving any error.
in UI it is called inside UIoutput.
uiOutput(choose_segment())
My observations : I think as per my study we can not call one function directly twice, so what i am doing is i have made two different functions and calling same function from them, i.e.
output$chooseSegment1 <- renderUI({
choose_segment()
})
output$chooseSegment2 <- renderUI({
choose_segment()
})
Issue : it is giving me output but they both are not interactive :(
Kindly provide a solution so that i can make both the sliders work in interactive manner.
I have faced the same scenario, in that i was suppose to change the code structure.
I made dynamic output uiOutput to the Dropdown menu ob ui and then used the same in my server as Input$xyz in observe on server and it worked for me.
Code :
UI : column(3, selectInput(inputId="ABC",label= "Choose ABC"))
column(3, selectInput(inputId="ABC1",label= "Choose ABC"))
Server : observe({
if(is.null(tab2_summary())) return(NULL)
updateSelectInput(session, "ABC", value = input$ABC)
})
observe({
updateSelectInput(session, "ABC1", value = input$ABC)
})
observe({
updateSelectInput(session, "ABC", value = input$ABC1)
})
So this is how i was able to make the selectInput interactive on two different page.
For your reference there is one full reproducible code.
Kindly refer,
library(shiny)
# UI ----------------------------------------------------------
ui <- navbarPage("Navbar!",
tabPanel("Plot", sidebarLayout(sidebarPanel(
radioButtons("yaxis1", "y-axis", c("speed"="speed", "dist"="dist"),
selected = "speed"
)),
mainPanel( plotOutput("plot"),
textOutput("test2")))), # for input checking
tabPanel("Summary", sidebarLayout(sidebarPanel(
radioButtons("yaxis2", "grouping-var", c("speed"="speed", "dist"="dist")
)),
mainPanel(
verbatimTextOutput("summary"),
textOutput("test1")
)))
)
# Server ------------------------------------------
server <- function(input, output, session) {
observe({
x <- input$yaxis1
updateRadioButtons(session, "yaxis2", selected = x)
})
observe({
y <- input$yaxis2
updateRadioButtons(session, "yaxis1", selected = y)
})
# output$test1 <- renderPrint({cat("yaxis1", input$yaxis1)})
# output$test2 <- renderPrint({cat("yaxis2", input$yaxis2)})
# output$plot <- renderPlot({ plot(cars[['speed']], cars[[input$yaxis1]]) })
# output$summary <- renderPrint({ summary(cars[[input$yaxis2]]) })
}
shinyApp(ui, server)
I Hope it will of your help.
I would like to avoid the infamous for-loop in my shiny app, but so far I have not been able to find a solution. This is my first real shiny project, any input is gladly appreciated.
My scenario is: The user provides a data frame. The app then generates a drop-down menu for every column. (Later this will be used to decide whether the column should be treated as factor, co-variate or disregarded in a linear model)
My current approach is to use a for-loop and the insertUI-function:
ui.R:
library(shiny)
shinyUI(
fluidPage(
actionButton("ADD","ADD")
)
)
server.R
library(shiny)
opts <- c("A","B")
shinyServer(function(input, output) {
for(i in 1:length(mtcars)){
insertUI(
selector = "#ADD",
where="afterEnd",
ui=selectInput(paste(names(mtcars[i]),"sel"),names(mtcars[i]),opts)
)
}
})
This works but it does not feel elegant at all.
Thanks for your input on how I could improve.
I'd go the route of using lapply and wrapping the result in tagList to create a collection of selectors.
library(shiny)
library(ggplot2)
shinyApp(
ui =
shinyUI(
fluidPage(
selectInput(inputId = "data",
label = "Select a dataset",
choices = c("mtcars", "iris")),
uiOutput("select_control")
)
),
server =
shinyServer(function(input, output, session){
dataset <- eventReactive(input$data,
get(input$data))
output$select_control <-
renderUI({
tagList(
lapply(names(dataset()),
function(x)
{
selectInput(inputId = sprintf("select_control_%s",
x),
label = x,
choices = unique(dataset()[[x]]))
}
)
)
})
})
)
I build an R/shiny web app. I want to have a multiple choice box (I use checkboxGroupInput(), but am open to alternatives). However, the list of choices is long and I want to contain it in a relatively small box of options (that shows 5-6 options at a time) with a scroll bar that enables to scroll through the entire list of choices.
Is there a way this can be done?
minimal example:
ui.R
library(shiny)
choices = paste("A",1:30,sep="_")
shinyUI(pageWithSidebar(
# Application title
headerPanel("my title"),
sidebarPanel(
checkboxGroupInput("inp", "choose any of the following", choices)
),
mainPanel(
tableOutput("result")
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
myInput <- reactive({
input$inp
})
output$result <- renderTable({
x = myInput()
if(length(x)==0) {
x = "No Choice Made"
}
matrix(x,ncol=1)
})
})
I found that using selectInput(..., multiple = TRUE) does the trick.