I am new to R Shiny. I am attempting to create an app that allows a user to subset a data.frame based on multiple variables and then see the resulting data.
Here is a small example data set:
iter,wave,apples
1,1,600
1,1,500
1,1,400
1,2,300
1,2,200
1,2,100
2,1,1000
2,1,1100
2,1,1200
2,2,1300
2,2,1400
2,2,1500
3,1,1100
3,1,2200
3,1,3300
3,2,4400
3,2,5500
3,2,6600
I would like the user to be able to specify the value of iter and of wave and see the resulting data.
Here is my attempt at the Shiny code. I realize I must be making several silly mistakes.
Edit
Here is my revised code. The end result now comes pretty close to what I want. The sidebar is still not being displayed perfectly.
library(shiny)
setwd('C:/Users/mark_/Documents/simple_RShiny_files/explore')
apple.data <- read.csv('subset_data_based_on_multiple_variables.csv',
header = TRUE, stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("Subsetting Apple Dataset"),
sidebarLayout(
sidebarPanel(
uiOutput("codePanel")
),
mainPanel(
tableOutput("view")
)
),
selectInput("codeInput", inputId ="data1", label = "Choose Iter", choices = unique(apple.data$iter)),
selectInput("codeInput", inputId ="data2", label = "Choose Wave", choices = unique(apple.data$wave))
)
server <- function(input, output) {
output$codePanel <- renderUI({
})
dataset <- reactive({
subset(apple.data, (iter == input$data1 & wave == input$data2))
})
output$view <- renderTable(dataset())
}
shinyApp(ui = ui, server = server)
The output
The problem is that both selectInputs have the same inputId. This works:
library(shiny)
apple.data <- data.frame(
iter = c(1L,1L,1L,1L,1L,1L,2L,2L,2L,2L,2L,
2L,3L,3L,3L,3L,3L,3L),
wave = c(1L,1L,1L,2L,2L,2L,1L,1L,1L,2L,2L,
2L,1L,1L,1L,2L,2L,2L),
apples = c(600L,500L,400L,300L,200L,100L,1000L,
1100L,1200L,1300L,1400L,1500L,1100L,2200L,3300L,4400L,
5500L,6600L)
)
ui <- fluidPage(
titlePanel("Subsetting Apple Dataset"),
sidebarLayout(
sidebarPanel(
selectInput("codeInput1", label = "Choose Iter", choices = unique(apple.data$iter)),
selectInput("codeInput2", label = "Choose Wave", choices = unique(apple.data$wave))
),
mainPanel(
tableOutput("view")
)
)
)
server <- function(input, output) {
dataset <- reactive({
return(subset(apple.data, (iter == input$codeInput1 & wave == input$codeInput2)))
})
output$view <- renderTable(dataset())
}
shinyApp(ui = ui, server = server)
Related
I found the following code that creates an RShiny app that allows users to visualize a data table based on certain columns that they select. See following code (should run on it's own):
library(shiny)
library(ggplot2) # for the diamonds dataset
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset === "diamonds"',
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("diamonds", DT::dataTableOutput("mytable1")),
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- DT::renderDataTable({
DT::datatable(diamonds2[, input$show_vars, drop = FALSE])
})
}
shinyApp(ui, server)
My question is, how can I change this dataset to be reactive, such that instead of always using the diamonds dataset, a data table would result based on what dataset I select from a dropdown menu? Such as adding a selectInput() argument?
If you are just trying to have different tables show based on a selectInput(), then this will work for a small number of tables. Essentially, the output table is an if else statement, which displays a different table depending on what's selected in the selectInput().
library(shiny)
library(ggplot2) # for the diamonds dataset
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
selectInput("Datasetchoice", "Dataset", choices = c("diamonds", "iris", "mtcars")), #Choose which dataset to display
conditionalPanel(
'input.dataset === "diamonds"',
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("diamonds", DT::dataTableOutput("mytable1"))
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- DT::renderDataTable({
if(input$Datasetchoice == "diamonds") { #If else statement, show a different table depending on the choice
DT::datatable(diamonds2[, input$show_vars, drop = FALSE])
} else if (input$Datasetchoice == "iris") {
DT::datatable(iris)
} else if(input$Datasetchoice == "mtcars") {
DT::datatable(mtcars)
}
})
}
shinyApp(ui, server)
Here is a solution that updates the checkboxes and the table upon selection of a different dataset. No limit on the number of datasets. But the datasets must be dataframes.
library(shiny)
library(datasets) # for the datasets
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
selectInput("dat",
label = "Choose data",
choices = c("cars", "mtcars", "faithful", "iris", "esoph", "USArrests")),
checkboxGroupInput("datavars", "Columns to show",
choices = NULL,
selected = NULL)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("dataset", DT::dataTableOutput("mytable1")),
)
)
)
)
server <- function(input, output, session) {
r <- reactiveValues(
dataobj = NULL
)
observeEvent(input$dat, {
dataobj <- r$dataobj <- get(input$dat, 'package:datasets')
datavars <- names(dataobj)
freezeReactiveValue(input, "datavars")
updateCheckboxGroupInput(session, "datavars",
choices = datavars,
selected = datavars)
})
output$mytable1 <- DT::renderDataTable({
req(r$dataobj, input$datavars)
DT::datatable(r$dataobj[, input$datavars, drop = FALSE])
})
}
shinyApp(ui, server)
I have written a simple example of what I am doing. I have 3000 numbers that I want to show in a selectInput. The numbers have to be in a reactive function, since in my original work, the data is from a file.
My problem is that when I run the app it only appears 1000 numbers, not the entire data (3000 numbers).
I have seen this post Updating selection of server-side selectize input with >1000 choices fails but I don't know how can I do it using uiOutput and renderUI.
Can anyone help me?
Thanks very much in advance
The code:
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
uiOutput('selectUI')
),
mainPanel(
)
)
)
server <- function(input, output) {
num <- reactive({
data = c(1:3000)
return(data)
})
output$selectUI <- renderUI({
selectInput(inputId = 'options', "Select one", choices = num())
})
}
# Run the application
shinyApp(ui = ui, server = server)
Use selectizeInput instead of selectInput with the argument options = list(maxOptions = 3000).
Thanks to Stéphane Laurent's answer, the example will be solved like this:
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "options", label = "Select one", choices=character(0)),
),
mainPanel(
)
)
)
server <- function(input, output, session) {
num <- reactive({
data = c(1:3000)
return(data)
})
observe({
updateSelectizeInput(
session = session,
inputId = "options",
label = "Select one",
choices= num(), options=list(maxOptions = length(num())),
server = TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This code will work if you have more than 3000 entries. It will show you ALL the choices that you have. However, if you have a long list of choices (e.g. 60000) it will decrease the speed of your app.
I am new to R and R shiny, and have been working on putting together a statistics application that will allow the user to import files, and then run different statistics programs on the data. The fileData function had been working fine for me until recently, and now whenever I attempt to upload a file, nothing opens. I have tried everything I can think of to get it to run, but it appears the file won't attach to the function. Any help will be very much appreciated!
library(shiny)
library(shinyFiles)
library(dplyr)
library(shinythemes)
ui <- fluidPage(theme = shinytheme("cosmo"),
# Application title
titlePanel("Stats"),
# Sidebar
sidebarLayout(
sidebarPanel(
tabsetPanel(type = "tab",
tabPanel("SCI",
fileInput("file1", "Insert File", multiple = TRUE, accept = c("text/csv", "text/comma-separated-values, text/plain", ".csv")),
selectInput("statChoice", "Choose Stats", c("None" = "None", "ANOVA 0 w/in 1 btw" = "A1btw", "ANOVA 0 w/in 2 btw" = "A2btw")),
conditionalPanel("statChoice == 'A1btw'",
uiOutput("ind1"),
uiOutput("dep1")),
conditionalPanel("statChoice == 'A2btw'",
uiOutput("ind1"),
uiOutput("ind2"),
uiOutput("dep1")),
)
)
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(type = "tab",
tabPanel("Data",
dataTableOutput("fileData")),
tabPanel("Summary Statistics"),
tabPanel("Graphs"))
)
)
)
server <- function(input, output) {
fileData <- eventReactive(input$file1,{
read.csv(input$file1$dataPath, header = TRUE, sep = ",", dec = ".")
})
output$fileData <- renderDataTable(
fileData()
)
vars <- reactive({
names(fileData())
})
output$ind1 <- renderUI({
selectInput("var1", "Independent 1", choices = vars())
})
output$ind2 <- renderUI({
selectInput("var2", "Independent 2", choices = vars())
})
output$dep1 <- renderUI({
selectInput("var3", "Dependent 1", choices = vars())
})
}
shinyApp(ui = ui, server = server)
Tricky because Shiny doesn't give any warning about this :
shiny app will not work if the same "output" is used two times in Ui.R.
Everything looks OK, except the double use of uiOutput("dep1") and uiOutput("ind1") :
conditionalPanel("statChoice == 'A1btw'",
uiOutput("ind1"), # Used once
uiOutput("dep1")), # Used once
conditionalPanel("statChoice == 'A2btw'",
uiOutput("ind1"), # Used twice
uiOutput("ind2"),
uiOutput("dep1")), # Used twice
You should use an output only once.
I have some code to program a small shiny app for which I need to add input rows and, if needed, delete them again. I have figured out how to add inputs, however I can't figure out how to delete them.
Here is a MWE of my code. There is no output since I cannot share the excel sheet behind the code from which the output is generated. However, it should suffice for simply helping me find the correct code to remove the added rows with full input (except the first row):
library(shiny)
GeographyList <- c("Africa","Asia Pacific","Europe","Global", "United States","Latin America & Caribbean")
RegionList <- c("Emerging",
"Developed")
ClassList <- c("1",
"2",
"3")
# Define UI for app that draws a plot ----
ui <- fluidPage(
fluidRow(
mainPanel(
uiOutput("inputwidgets"),
actionButton("number",
"Add Row"),
# Input: Click to update the Output
actionButton("update", "Update View"),
# Output: Plot ----
h4("Allocation"),
plotOutput("distPlot")
)
)
)
# Define server logic required to call the functions required ----
server <- function(input, output, session) {
# Get new input by clicking Add Row
observeEvent(input$number, {
output$inputwidgets = renderUI({
input_list <- lapply(1:input$number, function(i) {
# for each dynamically generated input, give a different name
fluidRow(
column(2,
selectInput(paste0("Geography", i),
label = paste0("Geography", i),
choices = GeographyList,
multiple = FALSE,
selected = NA)
),
column(3,
selectInput(paste0("Region", i),
label = paste0("Region", i),
choices = RegionList,
multiple = FALSE,
selected = NA)
),
column(4,
selectInput(paste0("Class", i),
label = paste0("Class", i),
choices = ClassList,
multiple = FALSE,
selected = NA)
),
column(3,
# Input: Specify the amount ----
numericInput(paste0("amount",i), label="Amount", 0)
))
})
do.call(tagList, input_list)
})
})
output$distPlot <- renderPlot({
if (input$update == 0)
return()
isolate(input$number)
isolate(input$amount)
slices <- c(input$amount1,input$amount2,input$amount3,input$amount4)
pie(slices)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
Appreciate any tips since I am very new to shiny! Thanks in advance.
You could build your lapply loop based on a reactiveValue which is triggered by your add button and a delete button:
1. Edit: using sapply in output$distPlot according to lapply rows
2. Edit: using existing input values
library(shiny)
GeographyList <- c("Africa","Asia Pacific","Europe","Global", "United States","Latin America & Caribbean")
RegionList <- c("Emerging",
"Developed")
ClassList <- c("1",
"2",
"3")
# Define UI for app that draws a plot ----
ui <- fluidPage(
fluidRow(
mainPanel(
uiOutput("inputwidgets"),
actionButton("number",
"Add Row"),
actionButton("delete_number",
"Delete Row"),
# Input: Click to update the Output
actionButton("update", "Update View"),
# Output: Plot ----
h4("Allocation"),
plotOutput("distPlot")
)
)
)
# Define server logic required to call the functions required ----
server <- function(input, output, session) {
reac <- reactiveValues()
observeEvent(c(input$number,input$delete_number), {
# you need to add 1 to not start with 0
add <- input$number+1
# restriction for delete_number > number
delete <- if(input$delete_number > input$number) add else input$delete_number
calc <- add - delete
reac$calc <- if(calc > 0) 1:calc else 1
})
# Get new input by clicking Add Row
observe({
req(reac$calc)
output$inputwidgets = renderUI({
input_list <- lapply(reac$calc, function(i) {
Geography <- input[[paste0("Geography",i)]]
Region <- input[[paste0("Region",i)]]
Class <- input[[paste0("Class",i)]]
amount <- input[[paste0("amount",i)]]
# for each dynamically generated input, give a different name
fluidRow(
column(2,
selectInput(paste0("Geography", i),
label = paste0("Geography", i),
choices = GeographyList,
multiple = FALSE,
selected = if(!is.null(Geography)) Geography
)
),
column(3,
selectInput(paste0("Region", i),
label = paste0("Region", i),
choices = RegionList,
multiple = FALSE,
selected = if(!is.null(Region)) Region
)
),
column(4,
selectInput(paste0("Class", i),
label = paste0("Class", i),
choices = ClassList,
multiple = FALSE,
selected = if(!is.null(Class)) Class
)
),
column(3,
# Input: Specify the amount ----
numericInput(
paste0("amount",i),
label="Amount",
value = if(!is.null(amount)) amount else 0
)
))
})
do.call(tagList, input_list)
})
})
output$distPlot <- renderPlot({
req(reac$calc, input$update)
slices <- sapply(reac$calc, function(i) {
c(input[[paste0("amount",i)]])
})
pie(slices)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
I am trying to build a Shiny App that does the following:
1) Browse a value file that looks like
Sample x y
A 1 3
B 2 1
C 3 6
D 4 4
2) Browse a second info file,
Sample Country Status
A US OK
B UK OK
C UK NOPE
D US OK
3) When I press a Submit button,
4) I merge the two files by the Sample column,
5) And make a scatter plot with ggplot, with a dropdown menu that allows me to color the points according to the names of the columns from the info file.
With the code below, I am facing two problems: (i) after I load my files and press the Submit button, nothing happens, and (ii) how could I mention in my selectInput block for my dropdown menu the number of possible choices (assuming I do not know them in advance)?
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "user_value_file",
label = "Choose a file with numeric values"
),
fileInput(
inputId = "user_info_file",
label = "Choose a file with sample info"
),
actionButton(
inputId = "my_button",
label = "Submit"
)
),
mainPanel(
# browse sample annotation file
selectInput(
inputId = "info_col",
label = "Choose an info to color",
choices = c("Country", "Status") # I am cheating here because I know in advance what are the colnames of the info file
),
# outputs
plotOutput(
outputId = "my_scatter_plot"
)
)
)
)
server <- function(input, output) {
output$contents <- renderTable(
{
valueFile <- input$user_value_file
if (is.null(valueFile))
return(NULL)
infoFile <- input$user_info_file
if (is.null(infoFile))
return(NULL)
}
)
randomVals <- eventReactive(
input$goButton,
{
my_val <- read.table(valueFile$datapath, header = T, sep = "\t")
my_info <- read.table(infoFile$datapath, header = T, sep = "\t")
df <- merge(my_val, my_info, by="Sample")
output$my_scatter_plot <- renderPlot(
{
ggplot(df, aes_string(x=df$x, y=df$y, color=input$info_col)) +
geom_point()
}
)
}
)
}
shinyApp(ui = ui, server = server)
A few things noted to get it working:
the inputID in the layout needs to match the server renderTable parameters (e.g., input$goButton should be input$my_button)
renderPlot was moved from eventReactive, and calls randomVals to get the data frame df
To get choices from the user info file, added session to server function and updateSelectInput (note depending on that file structure you probably want to do something like remove first column name or other changes)
Otherwise left things as they are. Please let me know if this has the behavior you were looking for.
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "user_value_file",
label = "Choose a file with numeric values"
),
fileInput(
inputId = "user_info_file",
label = "Choose a file with sample info"
),
actionButton(
inputId = "my_button",
label = "Submit"
)
),
mainPanel(
# browse sample annotation file
selectInput(
inputId = "info_col",
label = "Choose an info to color",
choices = NULL # Get colnames from user_info_file later on
),
# outputs
plotOutput(
outputId = "my_scatter_plot"
)
)
)
)
server <- function(input, output, session) {
output$contents <- renderTable({
valueFile <- input$user_value_file
if (is.null(valueFile))
return(NULL)
infoFile <- input$user_info_file
if (is.null(infoFile))
return(NULL)
})
randomVals <- eventReactive(input$my_button, {
my_val <- read.table(input$user_value_file$datapath, header = T, sep = "\t")
my_info <- read.table(input$user_info_file$datapath, header = T, sep = "\t")
updateSelectInput(session, "info_col", "Choose an info to color", choices = names(my_info)[-1])
merge(my_val, my_info, by="Sample")
})
output$my_scatter_plot <- renderPlot({
df <- randomVals()
ggplot(df, aes_string(x=df$x, y=df$y, color=input$info_col)) +
geom_point()
})
}
shinyApp(ui, server)