I'm working with Shiny, and i have another question, hopefully much easier:
I have a dataframe (uploaded from a CSV), where I want the user to select a Dependent variable, and then select their independent variables, but the list of available columns for the IV selection should now not include the dependent variable that they just selected.
I've been staring and reactive expressions all day, and have no clue. It's probably really obvious too.
Any help would be great.
Here is a code snippet from the Server code
# Read file ----
df <- reactive({
req(input$uploaded_file)
read.csv(input$uploaded_file$datapath,
header = input$header,
sep = input$sep)
})
# dynamically allow the user to select a dependent variable ----
output$selectbox <- renderUI({
selectInput(inputId = "select_dev",
label = "Select target variable",
choices = names(df()))
})
# Dynamically allow the user to select their independent variables using checkboxes ----
###
### Here is where I would like to remove the variable from the DF that they selected in output$selectbox.
###
output$checkbox <- renderUI({
checkboxGroupInput(inputId = "select_var",
label = "Select variables",
choices = names(df()),
selected = names(df()))
})
Perhaps there is an easier way than this to manipulate a reactive function. The goal is to have dataframe that I can treat as a set of independent variables, and be able to call on it for multiple analyses.
There you go -
library(shiny)
shinyApp(
ui = fluidPage(
uiOutput("selectbox"),
uiOutput("checkbox")
),
server = function(input, output, session) {
df <- reactive(iris)
output$selectbox <- renderUI({
selectInput(inputId = "select_dev",
label = "Select target variable",
choices = names(df()))
})
output$checkbox <- renderUI({
checkboxGroupInput(inputId = "select_var",
label = "Select variables",
choices = setdiff(names(df()), input$select_dev),
selected = setdiff(names(df()), input$select_dev))
})
}
)
Related
I am trying to create my first shiny app but I am facing a difficulty: in the reproducible example below I am creating a reactive pickerInput (i.e. only show brands proposing a cylindre equal to the input visitors select).
I then want that based on the combination input_cyl and picker_cny (remember that picker_cny depends on input_cyl) to display a table which shows the relevant data for the observation matching the combination input_cyl and picker_cny.
Thank you for your help!
df <- mtcars
df$brand <- rownames(mtcars)
df$brand <- gsub("([A-Za-z]+).*", "\\1", df$brand)
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_cyl", label = "Cyl",
choices = c("6", "4", "8")),
pickerInput(
inputId = "picker_cny",
label = "Select Company",
choices = paste0(unique(df$brand)),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Show Text
mainPanel(
tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
# Reactive pickerInput ---------------------------------
observeEvent(input$input_cyl, {
df_mod <- df[df$cyl == paste0(input$input_cyl), ]
# Method 1
disabled_choices <- !df$cyl %in% df_mod$cyl
updatePickerInput(session = session,
inputId = "picker_cny",
choices = paste0(unique(df$brand)),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
))
}, ignoreInit = TRUE)
output$table <- renderTable(df)
}
}
# Run the application
shinyApp(ui = ui, server = server)
You need a reactive that will handle the change in the input and subset the dataframe before giving it to the output table. For that, you just need to add this block to your server:
data <- reactive({
if (length(input$picker_cny) > 0)
df[df$brand %in% input$picker_cny,]
else
df
})
and update the output$table like this:
output$table <- renderTable(data())
Note: feel free to remove the if else in the reactive to get that:
data <- reactive({
df[df$brand %in% input$picker_cny,]
})
The only difference in that case is: would you show all or nothing when no input has been entered yet. That's a matter of taste.
I have two datasets, one with a list of two hundred cities and their corresponding state and another much larger dataset that I'd like to make an app to sort through. I need help making two drop down boxes in my shiny app where the first is the state variable and the second is the list of cities within that chosen state. I then want those selections to filter the much larger, second dataset in the output. I've tried solutions from several similar but slightly different examples online, but I'm having trouble translating it to what I'm doing.
So far I have this:
ui <- fluidPage(
headerPanel(''),
sidebarPanel(
#add selectinput boxs
htmlOutput("state_selector"),
htmlOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$State == input$state, "state"]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available), #calls list of available cities
selected = unique(data_available)[1])
})
shinyApp(ui = ui, server = server)
I tried to take out the portions of the code that weren't specifically related to the drop down boxes, since that's what I was more specifically asking about. So I'm sorry if I've left anything out! Let me know if I need to include anything else
Using available gapminder data, you can try this.
df <- gapminder
df$state <- gapminder$continent
df$city <- gapminder$country
citystatedata <- df
ui <- fluidPage(
headerPanel('Test'),
sidebarPanel(
#add selectinput boxs
uiOutput("state_selector"),
uiOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DTOutput("table")
)
)
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$state == req(input$state),]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available$city), #calls list of available cities
selected = 1)
})
mydt <- reactive({
citystatedata %>% filter(citystatedata$state == req(input$state) & citystatedata$city %in% req(input$city))
})
output$table <- renderDT(mydt())
}
shinyApp(ui = ui, server = server)
I'm making a Shiny app whose ui and server functions look like this:
ui <- fluidPage(
# App title ----
titlePanel("All Histograms!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
selectInput(inputId = 'dataset', label = 'Choose a dataset:',
choices = list.files(path = "#path here",
full.names = FALSE,
recursive = FALSE)),
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot")
)
))
server<- function( input, output, session){
outputdf <- reactive({
infile <- input$dataset
if (is.null(infile)){
return(NULL)
}
df<-read_feather(paste0("path_here",infile))
})
output$checkboxCompany <- renderUI({
checkboxGroupInput(inputId = "company_selection",
label="Company",
choices = unique(outputdf()$Company)
)
})
output$checkboxPredictedCondition <- renderUI({
checkboxGroupInput(inputId = "predicted_condition_selection",
label="Predicted Condition",
choices = unique(outputdf()$Predicted.Condition)
)
})
reactive_data <- reactive({
df%>%
filter(Company %in% input$company_selection)%>%
filter(Predicted.Condition %in% input$predicted_condition_selection)%>%
pull(Predicted.Probability)
})
output$distPlot <- renderPlot({
hist(reactive_data(), xlab = 'Predicted Probability', ylab = 'Frequency')
})
}
The user should be able to select from a list of datasets using selectInput, then based on the dataset, two checkbox groups company and Predict.Condition get modified - e.g. one dataset might have options a,b,c for company while a different dataset has options a,c,d for company.
Then, depending on the dataset selected and the resulting checkboxes marked, I'm making a reactive histogram.
However, when I run the app, I get "no applicable method for filter_ applied to an object of class function" error. I'm guessing R thinks that the df I'm passing in in reactive_data is a function? What did I do wrong here?
Turns out my reactive_data should have started with outputdf() and my ui was missing two uiOutputs for Company and Predicted COndition
I am trying to make a Shiny app that will plot gene of interest for a chosen patient. Each row is the gene name, and each column is a patient ID. For example:
99901 99902 99903 99904
SKI 4.789 5.789 6.324 1.2222
VWA1 6.901 7.002 5.89 4.567
TTLL10 6.783 7.345 8.987 6.345
library(shiny)
library(shinythemes)
library(lattice)
anno <- as.matrix(anno_genExp_gen3[1:3, 1:3])
#Define UI
ui <- fluidPage(
sidebarPanel(
titlePanel(title = "Gen3 Gene Expression Data"),
selectInput(inputId = "patients",
label = strong("Please choose patient/s to examine"),
choices = colnames(anno_genExp_off[,1:25]),
multiple = TRUE),
selectInput(inputId = "geneExp",
label = "Please select gene expressions/s to examine",
choices = rownames(anno_genExp_off[1:25,]),
multiple = TRUE)),
mainPanel(plotOutput("testPlot"))
)
server <- function(input, output) {
pdata <- reactive(input$patients)
gdata <-reactive(input$geneExp)
output$testPlot <- renderPlot ({
levelplot(anno,
col.regions=colorRampPalette(c("red","green","blue")))
})
}
shinyApp(ui = ui, server = server)
The code above just plots a small matrix, but how do I get it to plot user inputs using reactivity?
If the user chooses SKI and TTlLL10 only for patient 99901, how will I go about plotting this?
I've myself created a sample dataframe as you mentioned above. Here's the modified code.
Changes i made:
input$geneExp and input$patients are already reactive so there is no need to use a separate reactive function.
Filtered the dataframe for plotting use the same
Also, made a default selected value in the selectInput to avoid the initial error message when nothing is selected
library(shiny)
library(shinythemes)
library(lattice)
anno_genExp_off <- data.frame(`99901` = c(4.3,6.5,6.6),
`99902` = c(5.3,7.5,8.6),
`99903` = c(6.3,8.5,9.6),
row.names = c("SKI","VWA1","TTLL10"))
anno <- as.matrix(anno_genExp_off)
#Define UI
ui <- fluidPage(
sidebarPanel(
titlePanel(title = "Gen3 Gene Expression Data"),
selectInput(inputId = "patients",
label = strong("Please choose patient/s to examine"),
choices = colnames(anno_genExp_off),
selected = colnames(anno_genExp_off)[1],
multiple = TRUE),
selectInput(inputId = "geneExp",
label = "Please select gene expressions/s to examine",
choices = rownames(anno_genExp_off),
selected = rownames(anno_genExp_off)[1],
multiple = TRUE)),
mainPanel(plotOutput("testPlot"))
)
server <- function(input, output) {
#pdata <- reactive(input$patients)
#gdata <-reactive(input$geneExp)
output$testPlot <- renderPlot ({
levelplot(x = as.matrix(anno_genExp_off[which(rownames(anno_genExp_off) %in% input$geneExp) ,input$patients]),
col.regions=colorRampPalette(c("red","green","blue")))
})
}
shiny::shinyApp(ui,server)
TL;DR, this is my first Shiny App ever, and I am stuck on this reactive problem.
I am writing a Shiny app that will take Excel survey data and put it into a ggplot function. The function should work, but survey questions vary from year to year. I want the app to do the following:
Take multiple Excel files and read them
Display three drop-down menus for organization name, number of volunteers/hours, and the year the survey was taken, and display three text-entry forms for X and Y labels and Title
Print a histogram that shows, for each organization, the number of volunteers with dodged bars for each year the organization appeared.
The problem is with the second task. I want the app to react when the files get uploaded by placing the whole list of colnames() into the drop-down menu for the user to choose which columns had the organization name. I have tried solutions from other questions on Stack Overflow, but they all ended up throwing errors.
Here is my UI and Server code:
library(rsconnect)
library(readxl)
library(shiny)
library(ggplot2)
dataset <- file
ui <- fluidPage(
shinythemes::themeSelector(),
titlePanel("Volunteer stats"),
sidebarLayout(
sidebarPanel(
#I need: names of each of the files,
# columns for org, num_vol, and survey year,
# labels for x axis, y axis, and title,
# name for the PDF to be created
fileInput(inputId = "file", label = "Choose Excel file", multiple = TRUE),
uiOutput("org_select"),
uiOutput("num_select"),
uiOutput("year_select"),
textInput(inputId = "org_label", label = "X axis label"),
textInput(inputId = "vols_label", label = "Y axis label"),
textInput(inputId = "plot_title", label = "Chart title"),
textInput(inputId = "pdf_title", label = "PDF title")),
mainPanel(
plotOutput(
outputId = "histogram"
)
)
))
server <- function(input, output) {
output$org_select <- renderUI({
selectInput("org_col", "Which column has the organization name?", choices = list(colnames(read_excel(input$file))), label = "Organization")
})
output$num_select <- renderUI({
selectInput("num_vols", "Which column has the relevant metric?", choices = list(colnames(read_excel(input$file))), label = "Number of Volunteers")
})
output$year_select <- renderUI({
selectInput("year", "Which column has the year?", choices = list(colnames(read_excel(input$file))), label = "Year")
})
#assemble all the files into a list based on the input, to be passed to ggplot (not shown)
getData <- reactive({
if (is.null(input$file)){
return(NULL)
}else{
numfiles = nrow(input$file)
files_list = list(
for(i in 1:numfiles)
{
XL_file = read_excel(input$file[[i, 'datapath']], header = TRUE)
lastrow = nrow(XL_file)
shift = function(x, n){
c(x[-(seq(n))], rep(NA, n))
}
XL_file$identity = shift(XL_file$identity, 1)
files_list[[i]] = XL_file[-lastrow, ]
}
)
}
})
getData()
shinyApp(ui = ui, server = server)
I have not included my ggplot function for brevity. If I need help with that, I'll submit a separate question later.
Many thanks,
Fearless
Just two minor fixes to make it work:
input$file is an object (or list if you want), but read_excel() expect a string containing the file path. Use input$file$datapath.
The choices argument expect either a named list of named or unnamed values. With list(colnames(...)) you are passing it a list with a single element containing the chioices:
list(colnames(read_excel('path/to/file')))
[[1]]
[1] "COL_1" "COL_2" "COL_3" "COL_4"
Just pass it the colnames().
server <- function(input, output) {
output$org_select <- renderUI({
selectInput("org_col", "Which column has the organization name?", choices = colnames(read_excel(input$file$datapath)), label = "Organization")
})
output$num_select <- renderUI({
selectInput("num_vols", "Which column has the relevant metric?", choices = colnames(read_excel(input$file$datapath)), label = "Number of Volunteers")
})
output$year_select <- renderUI({
selectInput("year", "Which column has the year?", choices = colnames(read_excel(input$file$datapath)), label = "Year")
})
}