Skip to content

Instantly share code, notes, and snippets.

@dgrapov
Created February 2, 2018 04:48
Show Gist options
  • Star 10 You must be signed in to star a gist
  • Fork 10 You must be signed in to fork a gist
  • Save dgrapov/dfcf6ab2339b1cf19b090cfb8dadc855 to your computer and use it in GitHub Desktop.
Save dgrapov/dfcf6ab2339b1cf19b090cfb8dadc855 to your computer and use it in GitHub Desktop.
Example of a shiny app with data upload and different plot options
#initialize
library(shiny)
library(ggplot2)
library(purrr)
library(dplyr)
#example data
data(iris)
#make some factors
#easier to let ggplot2 control plotting (color, fill) based on type
data(mtcars)
uvals<-sapply(mtcars,function(x){length(unique(x))})
mtcars<-map_if(mtcars,uvals<4,as.factor) %>%
as.data.frame()
#plotting theme for ggplot2
.theme<- theme(
axis.line = element_line(colour = 'gray', size = .75),
panel.background = element_blank(),
plot.background = element_blank()
)
# UI for app
ui<-(pageWithSidebar(
# title
headerPanel("Select Options"),
#input
sidebarPanel
(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Semicolon = ";",
Comma = ",",
Tab = "\t"),
selected = ","),
# Horizontal line ----
tags$hr(),
# Input: Select what to display
selectInput("dataset","Data:",
choices =list(iris = "iris", mtcars = "mtcars",
uploaded_file = "inFile"), selected=NULL),
selectInput("variable","Variable:", choices = NULL),
selectInput("group","Group:", choices = NULL),
selectInput("plot.type","Plot Type:",
list(boxplot = "boxplot", histogram = "histogram", density = "density", bar = "bar")
),
checkboxInput("show.points", "show points", TRUE)
),
# output
mainPanel(
h3(textOutput("caption")),
#h3(htmlOutput("caption")),
uiOutput("plot") # depends on input
)
))
# shiny server side code for each call
server<-(function(input, output, session){
#update group and
#variables based on the data
observe({
#browser()
if(!exists(input$dataset)) return() #make sure upload exists
var.opts<-colnames(get(input$dataset))
updateSelectInput(session, "variable", choices = var.opts)
updateSelectInput(session, "group", choices = var.opts)
})
output$caption<-renderText({
switch(input$plot.type,
"boxplot" = "Boxplot",
"histogram" = "Histogram",
"density" = "Density plot",
"bar" = "Bar graph")
})
output$plot <- renderUI({
plotOutput("p")
})
#get data object
get_data<-reactive({
if(!exists(input$dataset)) return() # if no upload
check<-function(x){is.null(x) || x==""}
if(check(input$dataset)) return()
obj<-list(data=get(input$dataset),
variable=input$variable,
group=input$group
)
#require all to be set to proceed
if(any(sapply(obj,check))) return()
#make sure choices had a chance to update
check<-function(obj){
!all(c(obj$variable,obj$group) %in% colnames(obj$data))
}
if(check(obj)) return()
obj
})
#plotting function using ggplot2
output$p <- renderPlot({
plot.obj<-get_data()
#conditions for plotting
if(is.null(plot.obj)) return()
#make sure variable and group have loaded
if(plot.obj$variable == "" | plot.obj$group =="") return()
#plot types
plot.type<-switch(input$plot.type,
"boxplot" = geom_boxplot(),
"histogram" = geom_histogram(alpha=0.5,position="identity"),
"density" = geom_density(alpha=.75),
"bar" = geom_bar(position="dodge")
)
if(input$plot.type=="boxplot") { #control for 1D or 2D graphs
p<-ggplot(plot.obj$data,
aes_string(
x = plot.obj$group,
y = plot.obj$variable,
fill = plot.obj$group # let type determine plotting
)
) + plot.type
if(input$show.points==TRUE)
{
p<-p+ geom_point(color='black',alpha=0.5, position = 'jitter')
}
} else {
p<-ggplot(plot.obj$data,
aes_string(
x = plot.obj$variable,
fill = plot.obj$group,
group = plot.obj$group
#color = as.factor(plot.obj$group)
)
) + plot.type
}
p<-p+labs(
fill = input$group,
x = "",
y = input$variable
) +
.theme
print(p)
})
# set uploaded file
upload_data<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
#could also store in a reactiveValues
read.csv(inFile$datapath,
header = input$header,
sep = input$sep)
})
observeEvent(input$file1,{
inFile<<-upload_data()
})
})
# Create Shiny app ----
shinyApp(ui, server)
@dgrapov
Copy link
Author

dgrapov commented Feb 2, 2018

test

@turnet1
Copy link

turnet1 commented Oct 21, 2018

Awesome example and thank you!

@maintq
Copy link

maintq commented Mar 25, 2019

I run this code on R Studio but it said "Error: polygon edge not found"
Please help.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment