UPDATE: Q2 has been answered. Thanks #Ben! Just looking for assistance with Q1 and selectize.
What I have: Using selectize the user can search a pension plan. Q1: How can I avoid a default plan and simply have a "enter here..."?
What I want: While the plan selection works fine, I'm trying to plot the age of plan members when that plan is selected. Q2: How can I make my output (age) reactive to the input (plan name)?
My ui.r:
fluidPage(
titlePanel("Atlantis Pension Dashboard"),
sidebarLayout(
sidebarPanel(
#Dynamic select type
selectizeInput('Plan_Name', 'Search plan by keyword', choices = unique(Active$Plan_Name)),
multiple = TRUE,
#Static drop down
selectInput('Plan_Name', "All plans",
choices=unique(Active$Plan_Name)),
hr(),
helpText("Data from...")
),
# Spot for hist
mainPanel(
plotOutput("agePlot")
)))
and my server.r:
function(input, output) {
Plan <- reactive(input$Plan_Name)
# Dynamic plan select
output$Plan_Name <- renderPrint({
str(sapply(sprintf('Plan_Name'), function(id) {
input[[id]]
}, simplify = FALSE))
})
# Age histogram dependant on the chosed plan
output$agePlot <- renderPlot({
req(Plan())
hist(Active[Plan()]$age)
}
)
}
What I've tried: damn near everything (being dumb doesn't help).
Related
I currently have an application running where it portrays a table of NBA teams and their performance metrics. The 'nba' data contains 30 rows with each team in the league as well as 26 columns of different metrics and descriptions such as 'Team', 'Conference', 'REC', and 'PTS'. The user is able to pick these performance metrics through a checkboxGroupInput. I am trying to add a filter in for the Conference of the teams. This would be a selectInput function. If the user chooses Eastern, I would like the output to return a table with only teams from the Eastern conference. If the user chooses Western, I would like the output to return a table with only teams from the Western Conference. I am not sure how to do this. I have tried inputting 'input$conference' in place of 'nba' and other techniques, but nothing has worked. I hope someone can help. Here is my code:
library(shiny)
library(ggplot2)
library(jsonlite)
nba <- read.csv(file.choose())
head(nba)
Eastern = filter(nba,Conference=="Eastern")
Western = filter(nba,Conference=="Western")
ui <- fluidPage(
tags$img(height=150, width=830,src = "NBAlogo2.png"),
tabsetPanel(
# General
tabPanel(title = "General",
titlePanel("NBA Team Performance Metrics Analysis"),
sidebarLayout(
sidebarPanel(
p("This application allows you to compare and contrast several performance metrics amongst teams in the NBA."),
tags$img(height=100, width=100,src = "Eastern.png",align="center"),
tags$img(height=100, width=100,src = "Western.png"),
# Team Filter
selectInput("conference", label = h3("Select Conference"),
choices = list("Eastern", "Western")),
# Stat Filter
checkboxGroupInput("general", label = h3("General Metrics"),
choices = list("Winning Percentage" = "REC",
"Points" = "PTS")),
),
mainPanel(
# Metric Output
h3("General Metrics"),
tableOutput("data1"),
),
)
)
)
)
server <- function(input, output) {
# General
output$data1 <- renderTable({nba[,c("Team",input$general)]},
rownames = TRUE)
}
shinyApp(ui = ui, server = server)```
Do you mean like this?
library(shiny)
library(dplyr)
server <- function(input, output) {
# General
output$data1 <- renderTable({
nba %>%
filter(Conference == input$conference) %>%
select(Team, input$general)
})
}
Can someone helps me out?
I already tried to look at different tutorials, and previous questions/answers on Stack. But nothing helped me out.
I am creating a Shiny app, which would show a different output (data table) based on the input value.
Here is my code so far:
library(shiny)
library(DT)
# Define UI for miles per gallon app ----
ui <- pageWithSidebar(
# App title ----
headerPanel("Clients per Township - Aggregation"),
# Sidebar panel for inputs ----
sidebarPanel(
helpText("Mean client's penetration (Number of Clients/Number of inhabitants) = 0.0089"),
selectInput("Choice", "Do you want to have a list of townships with client's penetration above or under the mean?", c(" ", "Above","Under"))),
# Main panel for displaying outputs ----
mainPanel(
conditionalPanel(
'input.Choice === "Above"',
DT::dataTableOutput("more_table")
),
conditionalPanel(
'input.Choice === "Under"',
DT::dataTableOutput("less_table")
)
)
)
# Define server logic to plot various variables against mpg ----
server <- function(input, output) {
more_table = DT::renderDataTable({
more_than_mean
})
less_table = DT::renderDataTable({
less_than_mean
})
}
shinyApp(ui, server)
The data tables more_than_mean, and less_than_mean were previously computed.
When I run the app, I don't get an error. BUT no output is showed.
Can someone helps me out? I don't understand why none of the two tables are showed when I run the app.
Thank you!
So after looking carefully again at my code, I found my (stupid) mistake.
I only forgot the "ouput$" before the name of the output tables!
library(shiny)
library(DT)
# Define UI for miles per gallon app ----
ui <- pageWithSidebar(
# App title ----
headerPanel("Clients per Township - Aggregation"),
# Sidebar panel for inputs ----
sidebarPanel(
helpText("Mean client's penetration (Number of Clients/Number of inhabitants) = 0.0089"),
selectInput("Choice", "Do you want to have a list of townships with client's penetration above or under the mean?", c(" ", "Above","Under"))),
# Main panel for displaying outputs ----
mainPanel(
conditionalPanel(
'input.Choice === "Above"',
DT::dataTableOutput("more_table")
),
conditionalPanel(
'input.Choice === "Under"',
DT::dataTableOutput("less_table")
)
)
)
# Define server logic to plot various variables against mpg ----
server <- function(input, output) {
output$more_table = DT::renderDataTable({
more_than_mean
})
output$less_table = DT::renderDataTable({
less_than_mean
})
}
shinyApp(ui, server)
I need your help, because I don't know how to solve my problem. I have my shiny app where I have data frame (imported from file) and checkboxgroupinput where I can mark which columns are for me interesting. After that in other tabpanel I would like to get two plot for each column (in one facet_wrap). All facet_wrap one under the other. The problem is that number of interesting columns is not constant. It is easy for my if I could hardcode number of rows with plots, but where it can change dynamically I have no idea how to program it, any tips from your side?
We can't solve your question without a reproducible example but you should be able to figure it out from this quick example of using uiOutput along with renderUI. This allows the use of dynamic values in UI elements.
Normally you would define your static input as checkboxGroupInput("columns", "Select the variables to plot", choices = vector_of_known_values).
However as per your question, this doesn't work if the dataset is not known beforehand (e.g.: user file upload). In this case use uiOutput in the UI part: uiOutput("ui"), so that you delay evaluation to server side. In server side you can dynamically set the choices regardless of the data structure.
output$ui <- renderUI( {
checkboxGroupInput("columns", "Select the variables to plot", choices = colnames(rv$data))
})
See full example:
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("datasets", "Select a dataset", choices = c("mtcars", "iris"), selected = "mtcars"),
uiOutput("ui")
),
mainPanel(
DT::dataTableOutput("table")
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(data = NULL)
observe( {
rv$data <- eval(parse(text = input$datasets))
})
filtered <- reactive( {
req(input$columns)
if( all(!input$columns %in% colnames(rv$data))) {
NULL
} else {
rv$data %>% select(input$columns)
}
})
output$ui <- renderUI( {
checkboxGroupInput("columns", "Select the variables to plot", choices = colnames(rv$data))
})
output$table <- DT::renderDataTable( {
req(filtered())
DT::datatable(filtered())
})
}
shinyApp(ui, 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:
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.