I'm really new to R, so this is probably an easy and obvious fix.
I'm trying to create a function that I can call to create selectInput boxes using the name of a column in a data frame with the choices being the
Dataset is the name of the data frame and characteristic is the name of a column within the frame. I'm trying to use the characteristic name as the title of the input box, the values from within the column as the dropdown box options, and store the input in a variable called I(characteristic).
NewCharacterBox <- function(Characteristic, Dataset)
fluidRow(
column(3,
selectInput(paste("I", toString(Characteristic), sep = ""), h5(toString(Characteristic)),
choices = Dataset$Characteristic
If I understood it right, you probably don't need a new user-defined function for that rather can simply use names(dataset). Below is an example of that.
library(shiny)
data = iris
ui = fluidPage(
selectInput("choice","List of Columns",
choices = names(data),
selected = NULL),
textOutput("selected"),
tableOutput("result")
)
server = function(input, output) {
output$selected <- renderText({
paste("You have selected", input$choice)
})
output$result <- renderTable({
data[,input$choice]
})
}
shinyApp(ui,server)
Related
I used a reactive function on the server to create a data frame.
And I want to express the unique vector of one column of this data frame as selectinput in the UI.
ex)
DATA<-data.frame(ID, NAME)
####server#####
DATAFRAME<-reactive({DATA[DATA$ID %in% input$ID,})
####UI######
selectizeInput("name",label="name:",choices=unique(DATAFRAME$NAME))
In other words, I want to show a list of Names for data that has been refined once by ID in advance.
In order to react to changes in the reactive expression DATAFRAME you can use an observer and update the list of names with updateSelectizeInput (as pointed out by #MrFlick).
library(shiny)
ui <- fluidPage(
titlePanel("Widget Dependencies Sample App"),
selectizeInput("IdSelect", "Choose ID", "N/A"), # IDs to select from
selectizeInput("IdName", "Choose Name", "N/A"), # Names depend on selected ID
tableOutput("IdDatatable") # show the whole data set to understand what happens
)
server <- function(input, output, session) {
ID <- paste("ID", 1:3, sep = "_")
NAME <- LETTERS[1:(3*5)]
DATA <- data.frame(ID, NAME)
updateSelectizeInput(session, "IdSelect", choices = unique(ID))
DATAFRAME <- reactive({DATA[DATA$ID %in% input$IdSelect, ]})
observe({
updateSelectizeInput(session, "IdName", choices = unique(DATAFRAME()$NAME))
})
output$IdDatatable <- renderTable(DATA)
}
shinyApp(ui = ui, server = server)
However, if you need the reactive expression DATAFRAME only once, you can make the code even simpler. In that case, you wouldn't observe a DATAFRAME that reacts to changes in a widget. You can omit the DATAFRAMEand observe the input widget directly. This observer generates a filtered vector of Names and changes the choices in the selectizeInput with only one observer.
observe({
Names <- DATA$NAME[DATA$ID %in% input$IdSelect]
updateSelectizeInput(session, "IdName", choices = unique(Names))
})
I would like to provide reactively drop down choices (autocomplete suggestions) to the user depending on the input he provides. User input and autocomplete suggestions should be in the same widget.
The problem is, that I have a large data set (1 million rows+) from which the user should be able to choose names from. Since preloading this large data set would slow down the app, I would like to work with multiple splitted data sets, which I load depending on first letter of the user input.
The goal is to provide something like a textInput widget where the user is able to start typing a name. Depending on the first letter of this user input, I would like to present suggestions to the user from which he should be able to choose from.
Unfortunately this is not possible with:
textInput (lacks of drop down with suggestions)
selectInput / selectizeInput / select2Input (lacks of ability to work with non-pre loaded data)
Here are my failed trails with different input widgets to get this to work.
library(shiny)
library(shinysky)
#ui
ui <- fluidPage(
#Text Input
textInput(inputId = "txtInput", label = "Text Input", value = NULL),
#Select Input
selectInput(inputId = "selectInput", label = "Select Input", choices = NULL),
#Selectize Input
selectizeInput(inputId = "selectizeInput", label = "Selectize Input", choices = NULL),
#Select2Input from shinysky
select2Input(inputId = "select2Input", label = "Select2 Input", choices = NULL)
)
#server
server <- function(input, output, session) {
#Create reactive values
rv <- reactiveValues()
#Function for loading specific data set
f.populate.values <- function(start.letter) {
data.set <- c()
if(start.letter == "a") {
#Example toy list
data.set <- c("aaa", "abc", "adb", "adf")
}
if(start.letter == "b") {
#Example toy list
data.set <- c("baa", "bbc", "bdb", "bdf")
}
return(data.set)
}
#Failed trials to update / generate a dropdown with the loaded data set from "f.populate.values"
observeEvent(input$txtInput, {
#Store loaded data depending on first typed character
rv$names <- f.populate.values(substring(input$txtInput, 1, 1))
#Trials to update suggestions in widgets
updateTextInput(inputId = "txtInput", value = rv$names, session = session)
updateSelectInput(inputId = "selectInput", choices = rv$names, session = session)
updateSelectizeInput(inputId = "selectizeInput", choices = rv$names, session = session)
updateSelect2Input(inputId = "select2Input", choices = rv$names, label = "Select 2 Input", session = session)
})
}
shinyApp(ui, server)
I want to create a simple shiny app.In the app I upload a csv file. Here the csv file that I use is mtcars.csv. Then there are two selectInputs. I populate the first one with the columns of the uploaded csv file. And the second one is populated by all values for the field that is already selected in the first selectInput. Until here everything is fine. The problem starts when I click the actionButton: I want to renderTable all the records of the uploaded csv where the first selectInput is equal to the second one. For example, if the csv file is mtcars and first selectInput is cylinder and the sencond one is 6, I want to renderTable all the cars that have 6 cylinders.
However, the result is always empty. Here is the code for my UI:
ui <- fluidPage(
# Application title
titlePanel("This is a test!"),
sidebarLayout(
sidebarPanel(
fileInput("file", "Browse",
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
selectInput("first","Variable Name", choices = NULL),
selectInput("second","Ranges", choices = NULL),
actionButton("btn","Proceed")
),
mainPanel(
tableOutput("out")
)
)
)
And here is my server:
server <- function(input, output, session) {
#storing the csv in df
df = reactive({
req(input$file)
return(read_csv(input$file$datapath))
})
#populating first inputSelect
observe({
choices1 = colnames(df())
updateSelectInput(session,"first", choices = choices1)
})
#populating second inputSelect
observeEvent(input$first,{
choices1 = df() %>%
select(input$first) %>%
unique()
updateSelectInput(session,"second", choices = choices1)
})
#The goal is to return all rows in df() where the values
#of column in first selectInput is equal to second selectInput
observeEvent(input$btn,{
x = df() %>%
filter(input$first == input$second) #problem: this is always empty
output$out = renderTable(x)
})
}
I'm new to shiny. And I'm looking for the right way to do this.
Here's the snapshot of the empty output:
I believe this should work
observeEvent(input$btn,{
x = df()[df()[,input$first] == input$second,]
output$out = renderTable(x)
})
The problem is you are doing this
filter("cyl" == 6)
you need to do this
filter(cyl == 6)
This is happening because input$first = "cyl" is a string. So your code is comparing a string with a number, which is giving zero rows on filter.
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 am trying to dynamically populate the values of the selectInput from the data file uploaded by the user. The selectInput must contain only numeric columns.
Here is my code snippet for server.R
...
idx <- sapply(data.file, is.numeric)
numeric_columns <- data.file[, idx]
factor_columns <- data.file[, !idx]
updateSelectInput(session, "bar_x", "Select1", choices = names(numeric_columns))
updateSelectInput(session, "bar_y", "Select2", choices = names(factor_columns))
...
Corresponding ui.r
...
selectInput("bar_x", "Select1", choices = NULL),
selectInput("bar_y", "Select2", choices = NULL)
...
The code works fine as long as there are more than one values in any dropdown. However, it fails as soon as it encounters only one value to be displayed in the selectInput.
How can I handle this specific condition, given that the data is uploaded and it cannot be controlled if there is just one column as numeric?
It appears that in 2019, this issue still exists. The issue that I have seen is that when there is only one option in the dropdown, the name of the column is displayed instead of the one option.
This appears to only be a graphical problem, as querying the value for the selectInput element returns the correct underlying data.
I was unable to figure out why this problem exists, but an easy way around this bug is to simply change the name of the column so that it looks like the first element in the list.
library(shiny)
ui <- fluidPage(
selectInput("siExample",
label = "Example Choices",
choices = list("Loading...")),
)
server <- function(input, output, session) {
# load some choices into a single column data frame
sampleSet <- data.frame(Example = c("test value"))
# rename the set if there is only one value
if (length(sampleSet$Example) == 1) {
# This should only be done on a copy of your original data,
# you don't want to accidentally mutate your original data set
names(sampleSet) <- c(sampleSet$Example[1])
}
# populate the dropdown with the sampleSet
updateSelectInput(session,
"siExample",
choices = sampleSet)
}
shinyApp(ui = ui, server = server)
Info: Code was adapted by OP to make error reproducible.
To solve your issue use val2 <- val[,idx, drop = FALSE]
You dropped the column names by subsetting the data.frame().
To avoid this use drop = FALSE; see Keep column name when select one column from a data frame/matrix in R.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
# drj's changes START block 1
#selectInput('states', 'Select states', choices = c(1,2,4))
selectInput('states', 'Select states', choices = NULL)
# drj's changes END block 1
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
#drj's changes START block 2
#val <- c(1,2,3)
#names(val) <- c("a","b","c")
#updateSelectInput(session, 'states', 'Select states', choices = names(val[1]))
val <- as.data.frame(cbind(c("_1","_2","_3"), c(4, 4, 6)))
names(val) <- c("a","b")
val$b <- as.numeric(val$b)
idx <- sapply(val, is.numeric)
val2 <- val[,idx, drop = FALSE]
updateSelectInput(session, 'states', 'Select states', choices = names(val2))
#drj's changes END block 2
})
}
# Run the application
shinyApp(ui = ui, server = server)