Plot data after browsing input files with Shiny - r

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)

Related

How do I resolve this R shiny server looping if condition issue?

Context:
I am trying to make a shiny feature where the user can upload txt files and view the content of the files as a table. To account for the different types of delimiters I have placed radio buttons to act as delimiter options. The radio buttons will depend on the file type uploaded.
Issue:
The user would not be able to change the delimiter options and display the respective table, because the server keeps checking the file type and changing the radio buttons and resetting the default button.
Attempted solutions:
Setup a radiobutton for the user to select the file type which changes the delimited buttons instead of using an if condition of file type to determine the delimiter radiobuttons. Solution is not user friendly since the program should be able to identify and modify the radiobuttons in accordance to the file type.
Setup a go button to perform the if conditions for file type instead of relying on the server looping. Couldn't implement it properly
Question: Can anyone suggest solutions that are user friendly? Is there a feature in R shiny that already solves this issue?
UI
library(shinyWidgets)
library(DT)
library(shiny)
ui <- fluidPage(
titlePanel(title=div(img(src="ODClogo.png", height = 50), "OutDeCo")),
#navbarPage is top menu bar
navbarPage("",
#tabPanel is each tab in the navbarPage
# Assess DE tab
tabPanel(
title="Assess DE",
dropdown(
# title of sidepanel
tags$h3("Options"),
# inputs in the sidepanel
fileInput("DEFile", "Choose DE File",
accept = c(
".csv",
".tsv",
".txt"
)
),
# button for selecting delimiter, default is nothing until file is selected and handled in server side
radioButtons(inputId = 'sepButton', label = 'Delimiter Selector', choices = c(Default=''), selected = ''),
# side panel characteristics
style = "gradient", icon = icon("cog"),
status = "primary", width = "300px",
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutLeftBig
)
),
navlistPanel(
tabPanel(
title="Cluster Genes",
"Cluster genes Page",
# Navigation Bar for types of plots inside cluster
tabsetPanel(
tabPanel(
title="View file",
mainPanel(
uiOutput("UIDEContent")
)
),
tabPanel(
title="Plot 2"
),
tabPanel(
title="Plot 3"
)
),
),
),
)
),
)
Server
server <- function(input, output, session) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
# reactive converts the upload file into a reactive expression known as data
data <- reactive({
# DEFile from fileInput() function
ServerDEFile <- input$DEFile
# extensions tool for format validation
extDEFile <- tools::file_ext(ServerDEFile$datapath)
# file format checking
req(ServerDEFile)
validate(need(extDEFile == c("csv", "tsv", "txt"), "Please upload a csv, tsv or txt file."))
# convert data into file format
if(is.null(extDEFile)){return()}
if (extDEFile == "txt") {
choice <-c(Comma=",", Semicolon=";", Tab="\t", Space=" ")
updateRadioButtons(session, "sepButton",
label = paste("Delimiters for", extDEFile, "file"),
choices = choice,
)
}
else if (extDEFile == "tsv") {
choice <- (Tab="\t")
updateRadioButtons(session, "sepButton",
label = paste("Delimiter: Tab"),
choices = choice
)
}
else {
choice <- (Comma=",")
updateRadioButtons(session, "sepButton",
label = paste("Delimiter: Comma"),
choices = choice
)
}
read.table(file=ServerDEFile$datapath, sep=input$sepButton)
})
# creates reactive table called DEFileContent
output$DEFileContent <- renderTable({
if(is.null(data())){return ()}
data()
})
# handles rendering of reactive object on tb on ui
output$UIDEContent <- renderUI({
tableOutput("DEFileContent")
})
}
Use reactive object just to create a data frame, and use an observer to update radio button. Try this
library(shinyWidgets)
library(DT)
library(shiny)
ui <- fluidPage(
titlePanel(title=div(img(src="ODClogo.png", height = 50), "OutDeCo")),
#navbarPage is top menu bar
navbarPage("",
#tabPanel is each tab in the navbarPage
# Assess DE tab
tabPanel(
title="Assess DE",
dropdown(
# title of sidepanel
tags$h3("Options"),
# inputs in the sidepanel
fileInput("DEFile", "Choose DE File",
accept = c(
".csv",
".tsv",
".txt"
)
),
# button for selecting delimiter, default is nothing until file is selected and handled in server side
radioButtons(inputId = 'sepButton', label = 'Delimiter Selector', choices = c(Default=''), selected = ''),
# side panel characteristics
style = "gradient", icon = icon("cog"),
status = "primary", width = "300px",
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutLeftBig
)
),
navlistPanel(
tabPanel(
title="Cluster Genes",
"Cluster genes Page",
# Navigation Bar for types of plots inside cluster
tabsetPanel(
tabPanel(
title="View file",
mainPanel(
uiOutput("UIDEContent")
)
),
tabPanel(
title="Plot 2"
),
tabPanel(
title="Plot 3"
)
),
),
),
)
),
)
server <- function(input, output, session) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
observe({
# DEFile from fileInput() function
ServerDEFile <- req(input$DEFile)
# extensions tool for format validation
extDEFile <- tools::file_ext(ServerDEFile$datapath)
if(is.null(input$DEFile)){return()
}else{
if (extDEFile == "txt") {
label = paste("Delimiters for", extDEFile, "file")
choice <-c(Comma=",", Semicolon=";", Tab="\t", Space=" ")
}else if (extDEFile == "tsv") {
label = paste("Delimiter: Tab")
choice <- (Tab="\t")
}else {
label = paste("Delimiter: Comma")
choice <- (Comma=",")
}
updateRadioButtons(session, "sepButton", label = label, choices = choice)
}
})
# reactive converts the upload file into a reactive expression known as data
data <- reactive({
# DEFile from fileInput() function
ServerDEFile <- input$DEFile
# extensions tool for format validation
extDEFile <- tools::file_ext(ServerDEFile$datapath)
# file format checking
req(ServerDEFile)
validate(need(extDEFile == c("csv", "tsv", "txt"), "Please upload a csv, tsv or txt file."))
# convert data into file format
if(is.null(extDEFile)){return()}
read.table(file=ServerDEFile$datapath, sep=input$sepButton)
})
# creates reactive table called DEFileContent
output$DEFileContent <- renderTable({
if(is.null(data())){return ()}
data()
})
# handles rendering of reactive object on tb on ui
output$UIDEContent <- renderUI({
tableOutput("DEFileContent")
})
}
shinyApp(ui = ui, server = server)

Are there any specific resources to use for creating a shiny app that uploads a file and plots a selected column?

library(shiny)
library(plotly)
library(ggplot2)
library(tidyverse)
library(DT)
if (!require("okcupiddata")) install.packages("okcupiddata")
library(okcupiddata)
D=sample_n(profiles, 5000)
write.csv(D, file="~/Downloads/OKCupid.csv", row.names = FALSE)
ui <- fluidPage(
# Application title
titlePanel(title = "Uploading Your File"),
sidebarLayout(
sidebarPanel(
width = 2,
## Create a file upload control
fileInput(inputId = "file",
label = "Choose Your File:",
accept = c(".txt", ".csv")),
## Use html tag hr (horizontal rule) to make a horizontal separator
hr(),
## Make a h5 heading
h5("Max file size is 2M"),
## Create a checkbox that can be used to specify logical values.
checkboxInput(inputId = "header",
label = "Header",
value = TRUE),
## Create a set of radio buttons used to select an item from a list.
radioButtons(inputId = "sep",
label = "Separator",
choices = c(Comma = ",", Space = " ", Tab = "\t")),
uiOutput("variable")
),
mainPanel(
tabsetPanel(
tabPanel("Table", tableOutput("table")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Plot", plotlyOutput("plot", height = "700px"))
)
)
)
)
server <- function(input, output, session) {
myData <- reactive({
f = input$file
if (is.null(f)){
return(NULL)
} else {
read.table(f$datapath, header = input$header, sep = input$sep)
}
})
#A. Create a drop-down menu to choose a variable
output$variable <- renderUI({
})
#B. Display the whole table
output$table <- renderTable({
})
#C. Summarize the whole table
output$summary <- renderPrint({
})
#D. Plot only the selected variable.
# The code needs to handle both a categorical and numeric variables
output$plot <- renderPlotly({
})
}
shinyApp(ui = ui, server = server)
I'm stuck on A, B, C, and D. I know to use selectInput() to create a drop down menu, a data frame() function to render a table, a summary() function to render a summary, and a ggplot() function to render both a numeric and categorical plot.I don't know how to correctly reference the selected file and then reference the column from said file. Any ideas?
The answer completes A, B, C and D. You haven't really shared what kind of plot you need but based on class of the column selected this displays the plot.
library(shiny)
library(plotly)
library(tidyverse)
library(DT)
ui <- fluidPage(
# Application title
titlePanel(title = "Uploading Your File"),
sidebarLayout(
sidebarPanel(
width = 2,
## Create a file upload control
fileInput(inputId = "file",
label = "Choose Your File:",
accept = c(".txt", ".csv")),
## Use html tag hr (horizontal rule) to make a horizontal separator
hr(),
## Make a h5 heading
h5("Max file size is 2M"),
## Create a checkbox that can be used to specify logical values.
checkboxInput(inputId = "header",
label = "Header",
value = TRUE),
## Create a set of radio buttons used to select an item from a list.
radioButtons(inputId = "sep",
label = "Separator",
choices = c(Comma = ",", Space = " ", Tab = "\t")),
uiOutput("variable")
),
mainPanel(
tabsetPanel(
tabPanel("Table", tableOutput("table")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Plot", plotlyOutput("plot", height = "700px"))
)
)
)
)
server <- function(input, output, session) {
myData <- reactive({
f = input$file
if (is.null(f)){
return(NULL)
} else {
read.table(f$datapath, header = input$header, sep = input$sep)
}
})
#A. Create a drop-down menu to choose a variable
output$variable <- renderUI({
selectInput('dd', 'Select dropdown', names(myData()))
})
#B. Display the whole table
output$table <- renderTable({
myData()
})
#C. Summarize the whole table
output$summary <- renderPrint({
summary(myData())
})
#D. Plot only the selected variable.
# The code needs to handle both a categorical and numeric variables
output$plot <- renderPlotly({
if(is.numeric(myData()[[input$dd]]))
plt <- ggplot(myData(), aes(.data[[input$dd]])) + geom_histogram()
else
plt <- ggplot(myData(), aes(.data[[input$dd]])) + geom_bar()
ggplotly(plt)
})
}
shinyApp(ui = ui, server = server)

fileInput function not responding in r Shiny

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.

Subset data in R Shiny using Multiple Variables

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)

How to add a button that removes input rows?

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)

Resources