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)
Related
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 have two pickerInput values in the app. In the first, geography, the user can select to view either state (default) or county data. If the user selects county, I'd like to require that they pick a state from the second pickerInput, which is just a list of states. It is not required that the user pick a state when input$geography == "state".
I have considered putting this inside of a modalDialogue but it wasn't working. I also tried an updatePickerInput which didn't work either.
What is the best way of conditionally requiring the user to select a value from a pickerInput?
Thank you.
Here is a solution with shinyjs :
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
pickerInput("pick_1", choices = c("state","county"), multiple = FALSE, selected = "state"),
shinyjs::hidden(
pickerInput("pick_2", choices = state.name, multiple = TRUE)
)
)
server <- function(input, output, session) {
observe({
toggleElement("pick_2", condition = input$pick_1 == "state")
})
}
shinyApp(ui, server)
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
})
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 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]]))
}
)
)
})
})
)