I make an updateSelectInput on shiny, it's working. But after I can't use the new input as a variable for an output... The input is always empty. I give you the code for the SelectInput in Ui.R and the update in server.R. I can't give more, because the updating is made via an access database. And if I create data.frame just for the example, it will work...
selectInput("indic","Indicateur :",
choices = NULL,selected = NULL),
observeEvent(input$Source,{
indicateurs<-as.character(voila_source(input$Source)$Indice)
updateSelectInput(session,"indic",
choices = indicateurs)
})
output$summary<-renderTable({
information<-voila_source(input$Source)
information<-information[,-1]
indica<-input$indic ##here is empty...
print(indica)
description<-filter(information,Indice==indica)
description
})
Maybe I forgot something, I don't know. I want select an input and print a data.frame corresponding at the input selected.
EDIT : Answer found
Ok my code and your code work... It have to push on the submitbutton... But I don't want to push on submitbutton for that, I want just to click on selectInput to print my output, that is a description of the selectInput, and if I want this one, I push on the button to display a graph.
I found the error, the submitbutton, I replaced by actionbutton and it's working... I was not aware about the submitbutton and actionbutton.
If it could help you, This is my code for call the access database and all the server.R code and ui.R code :
library(shiny)
library(anytime)
library(plotly)
library(ggplot2)
library(dplyr)
library(RODBC)
library(ecb)
channel<-odbcConnectAccess("H:\\Analyse Macro\\Base Macro live.mdb")
listee<-sqlQuery(channel,paste("Select * from Liste_source"))
liste_server<-list()
for (i in 1:length(listee$Table)){
liste_server[i]<-as.character(listee$Table[i])
}
names(liste_server)<-as.character(listee$Table)
for (i in 1:length(listee$Table)){
liste_server[[i]]<-sqlQuery(channel,paste("Select * from ",liste_server[i]))
}
voila_source<-function(selection){
x<-as.character(selection)
liste_donnee<-liste_server[[x]]
#liste_donnee<-as.character(liste_donnee$Indice)
liste_donnee$Indice<-as.character(liste_donnee$Indice)
liste_donnee$Description<-as.character(liste_donnee$Description)
liste_donnee$Unite<-as.character(liste_donnee$Unite)
liste_donnee$Frequence<-as.character(liste_donnee$Frequence)
liste_donnee$Code<-as.character(liste_donnee$Code)
liste_donnee$Pays<-as.character(liste_donnee$Pays)
liste_donnee
}
# Define server logic required to draw a histogram
shinyServer(function(input, output,session) {
observeEvent(input$Source,{
indicateurs<-as.character(voila_source(input$Source)$Indice)
updateSelectInput(session,"indic",
choices = indicateurs)
})
output$summary<-renderTable({
information<-voila_source(input$Source)
information<-information[,-1]
reactives$indica<-input$indic
print(reactives$indica)
description<-filter(information,Indice==reactives$indica)
description<-data.frame(test=indica)
description
})
})
ui.R
library(shiny)
#library(quantmod)
library(lubridate)
library(plotly)
library(ggplot2)
library(RODBC)
channel<-odbcConnectAccess("H:\\Analyse Macro\\Base Macro live.mdb")
liste<-sqlQuery(channel,paste("Select * from Liste_source"))
liste<-as.character(liste$Table)
# Define UI for application that draws a histogram
#shinyUI(fluidPage(
ui<-tagList(
navbarPage(
"Evolutions Economiques",
tabPanel("Observation",
# Application title
titlePanel("Evolutions Economiques"),
# Sidebar with a slider input for number of bins
#sidebarLayout(
sidebarPanel(
h1("Selection des donnees"),
selectInput("Source","Source :",
choices =liste),
selectInput("indic","Indicateur :",
choices = NULL,selected = NULL),
selectInput("pays","Pays :",
choices = NULL),
selectInput("partenaire","Partenaire :",
choices = NULL),
#### replace by actionbutton submitButton("Ajouter"),
actionButton("add","Ajouter"),
hr(),
img(src="logo.png",height=80,width=200),
br(),
br(),
helpText("Application realisee pour l'exploration des donnees macroeconomiques")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(type="tabs",
tabPanel("Description",tableOutput("summary"))
#,
#plotlyOutput("graph"))
))
),
tabPanel("Extraction",
sidebarPanel(
selectizeInput("Index","Indice",c("ok")),
textInput("Nom","Nom fichier"),
actionButton("save","Sauver"),
hr(),
img(src="logo.png",height=80,width=200),
br(),
br(),
helpText("Application realisee pour l'exploration des donnees macroeconomiques")
),
mainPanel(
tabsetPanel(type="tabs",
tabPanel("liste",tableOutput("source")))
)
))
)
Judging from your example, it seems you have not initialised your indicateurs or indica variables is that correct?
If so you would need a couple of extra lines. The reason your solution (creating data.frame) works is that when you're testing your app, the variable already exists for the observeEvent or renderTable functions to act on. So simply add some lines in your script to do so before they are called.
Here is an example using reactiveValues (which would be better to work with when using a shiny app):
selectInput("indic","Indicateur :",
choices = NULL,selected = NULL),
# goes in your server.R
reactives <- reactiveValues(indicateurs = NULL, indica = NULL)
observeEvent(input$Source,{
reactives$indicateurs <-as.character(voila_source(input$Source)$Indice)
updateSelectInput(session,"indic",
choices = reactives$indicateurs)
})
output$summary<-renderTable({
information<-voila_source(input$Source)
information<-information[,-1]
reactives$indica<-input$indic ##here is empty...
print(reactives$indica)
description<-filter(information,Indice==reactives$indica)
description
})
Related
and thanks for reading and helping me.
I have a list of grades that has the names of the students and I am making a shiny app with it. I added a SelectInput to choose the students, but I would like to know if it is possible to add a row in the SelectInput with the option "All".
Anyone know how I can add this?
The code for the selectinput is the following:
ui <- fluidPage(
selectInput("alumnos", "Selecciona a un alumno:",
choices = asistencias$Alumno
)
)
You may try using pickerInput from shinyWidgets package.
library(shiny)
ui <- fluidPage(
shinyWidgets::pickerInput("alumnos", "Selecciona a un alumno:",
choices = unique(mtcars$cyl), multiple = TRUE,
options = list(`actions-box` = TRUE)
)
)
server <- function(input, output) {}
shinyApp(ui, 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)
I'm using observe() to change a value of a selectInput after a user selects TRUE/FALSE in the Categorical drop down list. In the first tab of my program if you set Categorical to TRUE then Impute gets updated to mode and mean otherwise. I'm then able to change the Impute value as desired without it reverting to the value that appears when TRUE/FALSE is selected.
In the second tab I have a multiple selectInput list with a similar interface as the first tab; the interface is created for every value selected in Select covariates. In this section I also used observe() to update each selected covariates' Impute drop down list accordingly to the logic of the first tab (i.e. if TRUE is selected then Impute gets updated to mode and mean otherwise). However, the value in Impute appers to be locked in the sense that I'm not able to switch between values as I did in the first tab.
I don't know how to correct this issue and I was wondering if anyone out there has encountered this similar problem and has been able to fix it. Any advice or help would be greatly appreciated.
The code to my app can be seen below and can be ran in a single file.
library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
shinyjs::useShinyjs(),
navbarPage("Test",id="navbarPage",
tabPanel("First tab", id = "first_tab",
sidebarLayout(
sidebarPanel(
selectInput('covariate.L.categorical', 'Categorical', c("",TRUE,FALSE)),
selectInput('covariate.L.impute', "Impute", c("","default","mean","mode","median"))
),
mainPanel()
)
),
tabPanel("Second tab", id = "second_tab",
sidebarLayout(
sidebarPanel(
selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE),
tags$hr(),
uiOutput("covariateop")
),
mainPanel()
)
))
))
server <- shinyServer(function(input, output, session) {
rv <- reactiveValues(cov.selected = NULL)
observe({
updateSelectInput(session, "covariate.L.impute", selected = ifelse(input$covariate.L.categorical,"mode","mean"))
})
output$covariateop <- renderUI({
lapply(input$covariates, function(x){
tags$div(id = paste0("extra_criteria_for_", x),
h4(x),
selectInput(paste0(x,"_categorical"), "Categorical",
choices = c("",TRUE,FALSE)),
selectInput(paste0(x,"_impute"), "Impute",
choices = c("","default","mean","mode","median")),
textInput(paste0(x,"_impute_default_level"), "Impute default level"),
tags$hr()
)
})
})
observe({
lapply(input$covariates, function(x){
updateSelectInput(session, paste0(x,"_impute"), selected = ifelse(as.logical(reactiveValuesToList(input)[[paste0(x,"_categorical")]])==TRUE,"mode","mean"))
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
In your observe in the second tab, you use reactiveValuesToList(input)[[paste0(x,"_categorical")]]. This means that this observe is reactive to any changes in any input element, so also if you change the "Imputation" input. You can just use input[[paste0(x,"_categorical")]] instead to get rid of this behaviour.
Note that the implementation of dynamic UI with lapply leads to the deletion and anew rendering of already existing input selections when an additional variable is selected. Maybe you can have a look at insertUI/removeUI to get a bit nicer UI.
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 try to make a selection menu like this:
Interactively change the selectInput choices
And everything works well with the exception of one thing:
Instead to get the values (like McDonald), I get the indices although I did nothing different (see picture link below). Where could be my mistake?
Picture
Here my global.R:
partners<- read.csv("genes.csv", header=TRUE, fill=TRUE)
server.R
shinyServer(function(input, output) {
#subTable
searchResult<- reactive({
subset(partners, grepl(input$nameSearch, partners$name))
})
output$searchResults <- renderTable({
searchResult()[,1]
})
output$selectUI <- renderUI({
selectizeInput("partnerName", "Click in and select", choices=searchResult()[,1], multiple=TRUE )
})
})
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Give the page a title
titlePanel("Tilte"),
sidebarPanel(
textInput("nameSearch", "Search for name", "Blah"),
htmlOutput("selectUI"),
br(),
submitButton("Update View"),
br()
),
# Create a spot for the barplot
mainPanel(
textOutput("text"),
plotOutput("plot")
)
)
)
I think you are not getting indices, but rather the integer representation of a factor. Check the class of partners[,1]. Try
output$selectUI <- renderUI({
selectizeInput("partnerName", "Click in and select",
choices=as.character(searchResult()[,1]), multiple=TRUE )
})
You could possibly add the stringsAsFactors=FALSE option when you read the data as well.