I am not able to give reference of column name from dbgetquery to the option choices specifying the column name from the query in updateselectizeinput in shiny. Can anyone help?
Example code:
query= reactive({ con, 'select * from database' })
updateselectizeinput(session, 'inputid', choice="how to give reference from query here", server=TRUE)
Actually it is very hard to understand what exactly do You mean, but i will just assume that You want to use the column names from the database table as a choice in selectizeInput. For this purpose You do not need updateSelectizeInput.
Here is the sample code with additional comments in it:
library(shiny)
u <- shinyUI(fluidPage(
titlePanel("Mutually Dependent Input"),
sidebarLayout(
sidebarPanel(
uiOutput("select1")),
mainPanel()
)
))
s <- shinyServer(function(input, output,session) {
queryOutput <- reactive({
data <- dbGetQuery(con, 'select * from database')}) # Here is Your SQL Query which gives You the table
output$select1 <- renderUI({
selectizeInput("select1_ui", "Select column name", choices = names(queryOutput())) # Here is Your selectizeInput with choices as column names
})
})
shinyApp(u,s)
Related
Could you please help me solving an issue related to Hierarchical input select.
I build a simply app for hierarchical input selecting, where the choices of each selectInput are updating based on the previous user selection. The app works, but I have found some strange behavior, which I want to avoid if possible.
My first input is the sliderInput, where the user can select which rows of the mtcars table should be used for the further sub-selection.
Then the selected cars are shown in the first selectInput and after the user choose which cars he want to see, the second selectInput mpg is filtered respectively.
Then after pressing an Action button, the sub-selection is displayed as table output.
When the user start the procedure from the beginning by changing the sliderInput, only the cars choices are updated. If we press on mpg selectInput we can still see the old selection.
Off course when we select again some cars the mpg are getting updated.
Do you know some way to avoid this behavior. My goal is, that mpg is always empty after the sliderInput is getting updated and not showing the old selections.
Thank you.
John
# Hierarchical inputSelect Example with mtcars
library(shiny)
library(dplyr)
ui <- fluidPage(
mainPanel(
fluidRow(
column(width=2,
sliderInput(inputId = "RowsINP",label = "Rows",min=1, max = dim(mtcars)[1], value=16,step=1),
selectInput("carsINP", "cars", choices = NULL,multiple=TRUE),
selectInput("mpgINP", "mpg", choices = NULL,multiple=TRUE),
actionButton("actionINP", "action")
),
column(width=10,
tableOutput('table')
)
)
)
)
server <- function(input, output,session) {
mtcars_tab <- reactive({
req(input$RowsINP)
data.frame(cars=rownames(mtcars[1:input$RowsINP,]),mtcars[1:input$RowsINP,])
})
observeEvent(mtcars_tab(), {
updateSelectInput(session,"carsINP", choices = unique(mtcars_tab()$cars))
})
cars <- reactive({
req(input$carsINP)
filter(mtcars_tab(), cars %in% input$carsINP)
})
observeEvent(cars(), {
# Also tried this option and many others
# if (!isTruthy(input$carsINP[1])){choices <- NULL}
# else{ choices <- unique(arrange(cars(),mpg)$mpg)}
choices <- unique(arrange(cars(),mpg)$mpg)
updateSelectInput(session, "mpgINP", choices = choices)
})
mpg <-eventReactive(input$actionINP,{
filter(cars(), mpg %in% input$mpgINP)
})
output$table <- renderTable(mpg())
}
# Run the application
shinyApp(ui = ui, server = server)
In my opinion, uiOutput/renderUI is perfect for these situations. We can avoid using a bunch of observeEvent and updateSelectInput calls, and the dropdown choices are updated (effectively) instantaneously, so you won't see the issue you've shown in your example. I think it's also a little bit easier to follow.
library(dplyr)
library(shiny)
ui <- {
fluidPage(
fluidRow(
sliderInput(inputId = "rows",label = "Rows",
min=1, max = dim(mtcars)[1],
value=16, step=1),
uiOutput('car_selector'),
uiOutput('mpg_selector'),
actionButton('action', 'Action'),
dataTableOutput('table_data')
)
)
}
server <- function(input, output, session) {
# render the car selection input
output$car_selector <- renderUI({
selectInput('car_input', 'Cars',
choices = rownames(mtcars)[1:input$rows],
multiple = TRUE)
})
# render the mpg selection input
output$mpg_selector <- renderUI({
selectInput('mpg_input', 'mpg',
choices = mtcars[rownames(mtcars) %in% input$car_input, 'mpg'],
multiple = TRUE)
})
# update the table data when the action button is clicked
table_data <- eventReactive(input$action, {
mtcars[rownames(mtcars) %in% input$car_input & mtcars$mpg %in% input$mpg_input, ]
})
# render the table data
output$table_data <- renderDataTable(table_data())
}
shinyApp(ui, server)
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)
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)
I am trying to render DataTable output to Shiny. Please find below explanation of my use case:
Connected to my database and got table data to df variable.
sent selected input from select input text box to server script.
Server script should take this input and get the data.
ui.R
library(shiny)
library(RODBC)
library(DBI)
# Establishing connection to ORE environment
dbconnect <- odbcConnect("orecloud", uid="XXXX", pwd="XXXXX", believeNRows=FALSE)
# Preparing data frames to get the data and show in select input pick list
df <- data.frame()
df <- sqlQuery(dbconnect,"SELECT distinct cpan FROM TABLE ")
shinyUI(fluidPage(
headerPanel("ORE XXX Summary"),
sidebarLayout(
sidebarPanel(
helpText("Please select Patient Details.."),
selectInput("CPAN",
label = "Choose patient",
choices = df,
selected = NULL),
submitButton(text = "Submit", icon = NULL)),
mainPanel(
dataTableOutput("tableoutput")
)
)
))
server.R
Server script should take the input and query the data from the table
Render the selected data to UI
If I change value in UI then it should display selected input data.
library(RODBC)
shinyServer(
function(input, output) {
dbconnect <- odbcConnect("orecloud", uid="oracle", pwd="Edvenswa2016", believeNRows=FALSE)
df2 <- data.frame()
input_var <- input$CPAN
print (input_var)
my_query <- paste("select * from CYTOKINE where CPAN= ", input_var)
print(myquery)
df2 <- sqlQuery(dbconnect,myquery)
output$tableoutput <- renderDataTable({df2})
}
)
You need to do it reactive
df2=reactive({
input_var <- input$CPAN
my_query <- paste("select * from CYTOKINE where CPAN= ", input_var)
sqlQuery(dbconnect,myquery)
})
and use like renderDataTable({df2()}) } )
If input$CPAN is character you need paste0("select * from CYTOKINE where CPAN= '", input_var,"'")
Also dont forget disconect
session$onSessionEnded(function() {
odbcClose(dbconnect )
})