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)
Related
In a shiny app (by RStudio), on the server side, I have a reactive that returns a list of variables by parsing the content of a textInput. The list of variables is then used in selectInput and/or updateSelectInput.
I can't make it work. Any suggestions?
I have made two attempts. The first approach is to use the reactive outVar directly into selectInput. The second approach is to use the reactive outVar in updateSelectInput. Neither works.
server.R
shinyServer(
function(input, output, session) {
outVar <- reactive({
vars <- all.vars(parse(text=input$inBody))
vars <- as.list(vars)
return(vars)
})
output$inBody <- renderUI({
textInput(inputId = "inBody", label = h4("Enter a function:"), value = "a+b+c")
})
output$inVar <- renderUI({ ## works but the choices are non-reactive
selectInput(inputId = "inVar", label = h4("Select variables:"), choices = list("a","b"))
})
observe({ ## doesn't work
choices <- outVar()
updateSelectInput(session = session, inputId = "inVar", choices = choices)
})
})
ui.R
shinyUI(
basicPage(
uiOutput("inBody"),
uiOutput("inVar")
)
)
A short while ago, I posted the same question at shiny-discuss, but it has generated little interest, so I'm asking again, with apologies, https://groups.google.com/forum/#!topic/shiny-discuss/e0MgmMskfWo
Edit 1
#Ramnath has kindly posted a solution that appears to work, denoted Edit 2 by him. But that solution does not address the problem because the textinput is on the ui side instead of on the server side as it is in my problem. If I move the textinput of Ramnath's second edit to the server side, the problem crops up again, namely: nothing shows and RStudio crashes. I found that wrapping input$text in as.character makes the problem disappear.
Edit 2
In further discussion, Ramnath has shown me that the problem arises when the server attempts to apply the dynamic function outVar before its arguments have been returned by textinput. The solution is to first check whether is.null(input$inBody) exists.
Checking for existence of arguments is a crucial aspect of building a shiny app, so why did I not think of it? Well, I did, but I must have done something wrong! Considering the amount of time I spent on the problem, it's a bitter experience. I show after the code how to check for existence.
Below is Ramnath's code with textinput moved to the server side. It crashes RStudio so don't try it at home. (I have used his notation)
library(shiny)
runApp(list(
ui = bootstrapPage(
uiOutput('textbox'), ## moving Ramnath's textinput to the server side
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text)) ## existence check needed here to prevent a crash
vars <- as.list(vars)
return(vars)
})
output$textbox = renderUI({
textInput("text", "Enter Formula", "a=b+c")
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
The way I usually check for existence is like this:
if (is.null(input$text) || is.na(input$text)){
return()
} else {
vars <- all.vars(parse(text = input$text))
return(vars)
}
Ramnath's code is shorter:
if (!is.null(mytext)){
mytext = input$text
vars <- all.vars(parse(text = mytext))
return(vars)
}
Both seem to work, but I'll be doing it Ramnath's way from now on: maybe an unbalanced bracket in my construct had earlier prevented me to make the check work? Ramnath's check is more direct.
Lastly, I'd like to note a couple of things about my various attempts to debug.
In my debugging quest, I discovered that there is an option to "rank" the priority of "outputs" on the server side, which I explored in an attempt to solve my problem, but didn't work since the problem was elsewhere. Still, it's interesting to know and seems not very well known at this time:
outputOptions(output, "textbox", priority = 1)
outputOptions(output, "variables", priority = 2)
In that quest, I also tried try:
try(vars <- all.vars(parse(text = input$text)))
That was pretty close, but still did not fix it.
The first solution I stumbled upon was:
vars <- all.vars(parse(text = as.character(input$text)))
I suppose it would be interesting to know why it worked: is it because it slows things down enough? is it because as.character "waits" for input$text to be non-null?
Whatever the case may be, I am extremely grateful to Ramnath for his effort, patience and guidance.
You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns = renderUI({
mydata = get(input$dataset)
selectInput('columns2', 'Columns', names(mydata))
})
}
))
EDIT. Another Solution using updateSelectInput
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
selectInput('columns', 'Columns', "")
),
server = function(input, output, session){
outVar = reactive({
mydata = get(input$dataset)
names(mydata)
})
observe({
updateSelectInput(session, "columns",
choices = outVar()
)})
}
))
EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.
library(shiny)
runApp(list(
ui = bootstrapPage(
textInput("text", "Enter Formula", "a=b+c"),
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))
vars <- as.list(vars)
return(vars)
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
As far as I can tell, the problem is that input$inBody does not retrieve a character even though the selectInput function is given a character as value, namely value = "a+b+c". The solution is therefore to wrap input$inBody in a as.character
The following works:
The observe approach with updateSelectInput:
observe({
input$inBody
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
updateSelectInput(session = session, inputId = "inVar", choices = vars)
})
The reactive approach with selectInput:
outVar <- reactive({
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
return(vars)
})
output$inVar2 <- renderUI({
selectInput(inputId = "inVar2", label = h4("Select:"), choices = outVar())
})
Edit: I have edited my question with an explanation based on Ramnath's feedback. Ramnath has explained the problem and provided a better solution, which I give as an edit of my question. I'll keep this answer for the record.
server.R
### This will create the dynamic dropdown list ###
output$carControls <- renderUI({
selectInput("cars", "Choose cars", rownames(mtcars))
})
## End dynamic drop down list ###
## Display selected results ##
txt <- reactive({ input$cars })
output$selectedText <- renderText({ paste("you selected: ", txt() ,sep="") })
## End Display selected results ##
ui.R
uiOutput("carControls"),
br(),
textOutput("selectedText")
I have an application which has 3 tabItems. I want to use a slider on second page to display same result on 3rd page interactively, i.e. if 2nd page slider changes then 3rd page slider should also change respectively.
I have a reactive function on server side
choose_segment <- reactive({
Multiple conditions for dropdown{Due to security cant share the exact code.}
})
and this choose_segment is refered in UI once and now i want to use it on the third page as well, but when i am calling the function on third page it is not displaying any thing on ui and also not giving any error.
in UI it is called inside UIoutput.
uiOutput(choose_segment())
My observations : I think as per my study we can not call one function directly twice, so what i am doing is i have made two different functions and calling same function from them, i.e.
output$chooseSegment1 <- renderUI({
choose_segment()
})
output$chooseSegment2 <- renderUI({
choose_segment()
})
Issue : it is giving me output but they both are not interactive :(
Kindly provide a solution so that i can make both the sliders work in interactive manner.
I have faced the same scenario, in that i was suppose to change the code structure.
I made dynamic output uiOutput to the Dropdown menu ob ui and then used the same in my server as Input$xyz in observe on server and it worked for me.
Code :
UI : column(3, selectInput(inputId="ABC",label= "Choose ABC"))
column(3, selectInput(inputId="ABC1",label= "Choose ABC"))
Server : observe({
if(is.null(tab2_summary())) return(NULL)
updateSelectInput(session, "ABC", value = input$ABC)
})
observe({
updateSelectInput(session, "ABC1", value = input$ABC)
})
observe({
updateSelectInput(session, "ABC", value = input$ABC1)
})
So this is how i was able to make the selectInput interactive on two different page.
For your reference there is one full reproducible code.
Kindly refer,
library(shiny)
# UI ----------------------------------------------------------
ui <- navbarPage("Navbar!",
tabPanel("Plot", sidebarLayout(sidebarPanel(
radioButtons("yaxis1", "y-axis", c("speed"="speed", "dist"="dist"),
selected = "speed"
)),
mainPanel( plotOutput("plot"),
textOutput("test2")))), # for input checking
tabPanel("Summary", sidebarLayout(sidebarPanel(
radioButtons("yaxis2", "grouping-var", c("speed"="speed", "dist"="dist")
)),
mainPanel(
verbatimTextOutput("summary"),
textOutput("test1")
)))
)
# Server ------------------------------------------
server <- function(input, output, session) {
observe({
x <- input$yaxis1
updateRadioButtons(session, "yaxis2", selected = x)
})
observe({
y <- input$yaxis2
updateRadioButtons(session, "yaxis1", selected = y)
})
# output$test1 <- renderPrint({cat("yaxis1", input$yaxis1)})
# output$test2 <- renderPrint({cat("yaxis2", input$yaxis2)})
# output$plot <- renderPlot({ plot(cars[['speed']], cars[[input$yaxis1]]) })
# output$summary <- renderPrint({ summary(cars[[input$yaxis2]]) })
}
shinyApp(ui, server)
I Hope it will of your help.
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]]))
}
)
)
})
})
)
I'm very new to shiny and am having some trouble and have been searching all day, so hopefully someone can help me. Once an action button (actionButton, on UI) is selected by a user, I would like the server script to call a function (evenReactive in server) I wrote (myfunction, see below) that uses the input items from the UI and gets the right parameters I need to run myfunction and produce a n X2 data matrix that will be plotted as a table (renderTable in server, below). The data is a n X 2 matrix.
I have some sample code below. It's not the entre code, so you will not see the UI with the inputs I am putting in my function, or the server parts associated. But, it is the part I am trying to fix. I hope that's ok. I don't need the renderText, but when I take it out I get an error. Sorry for the formatting. Copy and pasting changed it a bit.
library(shiny)
ui <- shinyUI(fluidPage
(column(4,actionButton("gobutton", "Run"),verbatimTextOutput("ntext1")),
column(4, DT::dataTableOutput("table",width = "75%"))))
library(shiny)
shinyServer(function(input, output, session)
ntext1 <- eventReactive(input$gobutton, {
if (input$gobutton==1){
data=myfunction(input$checkbox,input$dateRange)}
})
output$ntext1 <- renderText({ntext1()})
output$table <- DT::renderDataTable(DT::datatable({
data
})
))
myfunction <-function(All,date1,date2,source_cd,tran_cd,airline_list,mag_level) {
print(All); print(date1); print(date2); print(source_cd);print(tran_cd);print(airline_list);print(mag_level)
setwd("C:/Users/TRomano/Documents/Projects/TrendAnalysis/Data")
data = read.csv("Airlines.csv",header = TRUE)
return(data)
}
For this type of problem I like to make use of reactiveValues()that are designed to store data in a reactive way.
Here is a simple app (single app, not split into server & ui) that demonstrates what I think you are trying to do
library(shiny)
library(DT)
ui <- shinyUI(
fluidPage(
column(width = 4,
actionButton("gobutton", "Run")
column(width = 4,
DT::dataTableOutput("table",
width = "75%"))))
server <- shinyServer(function(input, output, session){
rv <- reactiveValues()
rv$data <- NULL
observe({ ## will 'observe' the button press
if(input$gobutton){
print("here") ## for debugging
rv$data <- myfunction() ## store the data in the reactive value
rv$data
}
})
output$table <- DT::renderDataTable({
## The data has been stored in our rv, so can just return it here
rv$data
})
})
myfunction <- function(){
data <- data.frame(id = c(1,2,3),
val = letters[1:3])
return(data)
}
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Company Name"),
dashboardSidebar(sidebarMenu(
menuItem("Results Table", tabName = "ResultsTable", icon = icon
("ResultsTable")),
dashboardBody(
tabItems(
tabItem(tabName tabItem(tabName = "ResultsTable",
fluidPage(
headerPanel(
fluidRow(
column(4,
selectInput("sour",
"Source Type:",
c("All",
unique(as.character(data_source_cd)))), offset=2
),
column(4,
selectInput("tran",
"Transaction Type:",
c("All",
unique(as.character(tran_cd)))))),
# Create a new row for the table.
fluidRow(column(8, DT::dataTableOutput("table",width = "75%"),offset = 2))))))
library(shiny)
shinyServer(function(input, output, session) {
ntext1 <- eventReactive(input$gobutton, {
if (input$dateRange[2]<input$dateRange[1]){print("You selected the date range option;however, the end date entered occurs before the starting date")}else{
output$ntext1 <- renderText({print("Analysis complete...")});
observe({
if(input$gobutton){
rv$data <- myfunction() }
})
output$table <- DT::renderDataTable(DT::datatable({
data <- rv$data
if (input$sour != "All") {
data <- data[data[,5] == input$sour,]
}else{data}
if (input$tran != "All") {
data <-data[data[,6] == input$tran,]
}else{data}
}))
}})
Once an action button is selected on the main page of my dashboard(not shown), myfunction runs analysis with the inputs from the main dashboard page. On another tab, a table will show once the analysis is complete. There are drop down menus (input$tran, input$sour) that will reduce what is in the table depending on what the user selects. If there are any errors in the input, a warning of text comes up on the main dashboard page and the tab with the table will not be created until the correct inputs are selected.
The observe function allowed me to run my function and the output data of the function set to a variable I could later use to create the table (shown).
THis is my first time posting. Any questions feel free to ask.
In a shiny app (by RStudio), on the server side, I have a reactive that returns a list of variables by parsing the content of a textInput. The list of variables is then used in selectInput and/or updateSelectInput.
I can't make it work. Any suggestions?
I have made two attempts. The first approach is to use the reactive outVar directly into selectInput. The second approach is to use the reactive outVar in updateSelectInput. Neither works.
server.R
shinyServer(
function(input, output, session) {
outVar <- reactive({
vars <- all.vars(parse(text=input$inBody))
vars <- as.list(vars)
return(vars)
})
output$inBody <- renderUI({
textInput(inputId = "inBody", label = h4("Enter a function:"), value = "a+b+c")
})
output$inVar <- renderUI({ ## works but the choices are non-reactive
selectInput(inputId = "inVar", label = h4("Select variables:"), choices = list("a","b"))
})
observe({ ## doesn't work
choices <- outVar()
updateSelectInput(session = session, inputId = "inVar", choices = choices)
})
})
ui.R
shinyUI(
basicPage(
uiOutput("inBody"),
uiOutput("inVar")
)
)
A short while ago, I posted the same question at shiny-discuss, but it has generated little interest, so I'm asking again, with apologies, https://groups.google.com/forum/#!topic/shiny-discuss/e0MgmMskfWo
Edit 1
#Ramnath has kindly posted a solution that appears to work, denoted Edit 2 by him. But that solution does not address the problem because the textinput is on the ui side instead of on the server side as it is in my problem. If I move the textinput of Ramnath's second edit to the server side, the problem crops up again, namely: nothing shows and RStudio crashes. I found that wrapping input$text in as.character makes the problem disappear.
Edit 2
In further discussion, Ramnath has shown me that the problem arises when the server attempts to apply the dynamic function outVar before its arguments have been returned by textinput. The solution is to first check whether is.null(input$inBody) exists.
Checking for existence of arguments is a crucial aspect of building a shiny app, so why did I not think of it? Well, I did, but I must have done something wrong! Considering the amount of time I spent on the problem, it's a bitter experience. I show after the code how to check for existence.
Below is Ramnath's code with textinput moved to the server side. It crashes RStudio so don't try it at home. (I have used his notation)
library(shiny)
runApp(list(
ui = bootstrapPage(
uiOutput('textbox'), ## moving Ramnath's textinput to the server side
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text)) ## existence check needed here to prevent a crash
vars <- as.list(vars)
return(vars)
})
output$textbox = renderUI({
textInput("text", "Enter Formula", "a=b+c")
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
The way I usually check for existence is like this:
if (is.null(input$text) || is.na(input$text)){
return()
} else {
vars <- all.vars(parse(text = input$text))
return(vars)
}
Ramnath's code is shorter:
if (!is.null(mytext)){
mytext = input$text
vars <- all.vars(parse(text = mytext))
return(vars)
}
Both seem to work, but I'll be doing it Ramnath's way from now on: maybe an unbalanced bracket in my construct had earlier prevented me to make the check work? Ramnath's check is more direct.
Lastly, I'd like to note a couple of things about my various attempts to debug.
In my debugging quest, I discovered that there is an option to "rank" the priority of "outputs" on the server side, which I explored in an attempt to solve my problem, but didn't work since the problem was elsewhere. Still, it's interesting to know and seems not very well known at this time:
outputOptions(output, "textbox", priority = 1)
outputOptions(output, "variables", priority = 2)
In that quest, I also tried try:
try(vars <- all.vars(parse(text = input$text)))
That was pretty close, but still did not fix it.
The first solution I stumbled upon was:
vars <- all.vars(parse(text = as.character(input$text)))
I suppose it would be interesting to know why it worked: is it because it slows things down enough? is it because as.character "waits" for input$text to be non-null?
Whatever the case may be, I am extremely grateful to Ramnath for his effort, patience and guidance.
You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns = renderUI({
mydata = get(input$dataset)
selectInput('columns2', 'Columns', names(mydata))
})
}
))
EDIT. Another Solution using updateSelectInput
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
selectInput('columns', 'Columns', "")
),
server = function(input, output, session){
outVar = reactive({
mydata = get(input$dataset)
names(mydata)
})
observe({
updateSelectInput(session, "columns",
choices = outVar()
)})
}
))
EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.
library(shiny)
runApp(list(
ui = bootstrapPage(
textInput("text", "Enter Formula", "a=b+c"),
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))
vars <- as.list(vars)
return(vars)
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
As far as I can tell, the problem is that input$inBody does not retrieve a character even though the selectInput function is given a character as value, namely value = "a+b+c". The solution is therefore to wrap input$inBody in a as.character
The following works:
The observe approach with updateSelectInput:
observe({
input$inBody
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
updateSelectInput(session = session, inputId = "inVar", choices = vars)
})
The reactive approach with selectInput:
outVar <- reactive({
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
return(vars)
})
output$inVar2 <- renderUI({
selectInput(inputId = "inVar2", label = h4("Select:"), choices = outVar())
})
Edit: I have edited my question with an explanation based on Ramnath's feedback. Ramnath has explained the problem and provided a better solution, which I give as an edit of my question. I'll keep this answer for the record.
server.R
### This will create the dynamic dropdown list ###
output$carControls <- renderUI({
selectInput("cars", "Choose cars", rownames(mtcars))
})
## End dynamic drop down list ###
## Display selected results ##
txt <- reactive({ input$cars })
output$selectedText <- renderText({ paste("you selected: ", txt() ,sep="") })
## End Display selected results ##
ui.R
uiOutput("carControls"),
br(),
textOutput("selectedText")