How to conditionally download a plot? - r

The below reproducible code allows the user to select either a data table or a plot of the data for viewing (via input$view). I'm trying to create a conditional around the downloadHandler() so that if the user is viewing the data table and chooses to download, then the data is downloaded; otherwise if the user is viewing the plot and chooses to download then a plot in PNG format is downloaded. I'm running into issues around input$view reactivity. How would I modify the code below to conditionally download whichever (data or plot) the user is viewing?
The code as posted below works for viewing either data or plot, but only allows the data table to be downloaded. Offending lines of code that otherwise cause a crash are commented out.
Reproducible code:
library(shiny)
library(ggplot2)
ui <- fluidPage(
radioButtons("view",
label = "View data or plot",
choiceNames = c('Data','Plot'),
choiceValues = c('viewData','viewPlot'),
selected = 'viewData',
inline = TRUE
),
conditionalPanel("input.view == 'viewData'",tableOutput("DF")),
conditionalPanel("input.view == 'viewPlot'",plotOutput("plotDF")),
downloadButton("download","Download",style = "width:20%;")
)
server <- function(input, output, session) {
data <- data.frame(Period = c(1,2,3,4,5,6),Value = c(10,20,15,40,35,30))
data1 <- reactiveValues()
inputView <- reactive(input$view) # attempt to make input$view reactive
observeEvent(input$view,{data1$plot <- ggplot(data, aes(Period,Value)) + geom_line()})
output$DF <- renderTable(data)
output$plotDF <- renderPlot(data1$plot)
output$download <-
# if(inputView() == 'viewData'){
downloadHandler(
filename = function()
paste("dataDownload","csv",sep="."),
content = function(file){
write.table(
data,
na = "",
file,
sep = ",",
col.names = TRUE,
row.names = FALSE)
}
)
# }
# else{
# downloadHandler(
# filename = function(){paste("plotDownload",'.png',sep='')},
# content = function(file){
# ggsave(file,plot=data1$plot)
# }
# )
# }
}
shinyApp(ui, server)

Try this
library(shiny)
library(ggplot2)
ui <- fluidPage(
radioButtons("view",
label = "View data or plot",
choiceNames = c('Data','Plot'),
choiceValues = c('viewData','viewPlot'),
selected = 'viewData',
inline = TRUE
),
conditionalPanel("input.view == 'viewData'",tableOutput("DF")),
conditionalPanel("input.view == 'viewPlot'",plotOutput("plotDF")),
#downloadButton("download","Download",style = "width:20%;")
uiOutput("plotrtable")
)
server <- function(input, output, session) {
data <- data.frame(Period = c(1,2,3,4,5,6),Value = c(10,20,15,40,35,30))
data1 <- reactiveValues()
inputView <- reactive(input$view) # attempt to make input$view reactive
observeEvent(input$view,{data1$plot <- ggplot(data, aes(Period,Value)) + geom_line()})
output$DF <- renderTable(data)
output$plotDF <- renderPlot(data1$plot)
output$plotrtable <- renderUI({
if(input$view == 'viewData'){downloadButton("download","Download",style = "width:20%;") }
else {downloadButton("downloadp","Download",style = "width:20%;") }
})
output$download <- downloadHandler(
filename = function()
paste("dataDownload","csv",sep="."),
content = function(file){
write.table(
data,
na = "",
file,
sep = ",",
col.names = TRUE,
row.names = FALSE)
}
)
output$downloadp <- downloadHandler(
filename = function(){paste("plotDownload",'.png',sep='')},
content = function(file){
ggsave(file,plot=data1$plot)
}
)
}
shinyApp(ui, server)

Related

Shiny -How to save to excel every change in renderTable?

I use Timevis package.
first of all I read an excel file with missions.
In my code the user can see all the missions on a time line, and he can edit/add/remove any missions.
after the user make a change I can see the update table below.
I want to save to my excel file every update that the user make.
this is my code:
library(shiny)
library(timevis)
library(readxl)
my_df <- read_excel("x.xlsx")
data <- data.frame(
id = my_df$id,
start = my_df$start,
end = my_df$end,
content = my_df$content
)
ui <- fluidPage(
timevisOutput("appts"),
tableOutput("table")
)
server <- function(input, output) {
output$appts <- renderTimevis(
timevis(
data,
options = list(editable = TRUE, multiselect = TRUE, align = "center")
)
)
output$table <- renderTable(
input$appts_data
)
}
shinyApp(ui, server)
You can use actionButton/ observe to call saveworkbook (package openxlsx) to save your changes. Technically you are not saving these changes, but replacing the file with an identical file containing the changes.
library(shiny)
library(openxlsx)
library(timevis)
library(readxl)
my_df <- read_excel("x.xlsx")
data <- data.frame(
id = my_df$id,
start = my_df$start,
end = my_df$end,
content = my_df$content
)
mypath = paste0(getwd(), "/x.xlsx") # Path to x.xlsx
ui <- fluidPage(
timevisOutput("appts"),
tableOutput("table"),
actionButton("save", "Save")
)
server <- function(input, output) {
output$appts <- renderTimevis(
timevis(
data,
options = list(editable = TRUE, multiselect = TRUE, align = "center")
))
observeEvent(input$save,
{
my_df<- createWorkbook()
addWorksheet(
my_df,
sheetName = "data"
)
writeData(
wb = my_df,
sheet = "data",
x = input$appts_data,
startRow = 1,
startCol = 1
)
saveWorkbook(my_df, file = mypath,
overwrite = TRUE)
})
output$table <- renderTable(
input$appts_data
)
}
shinyApp(ui, server)

External Data storage in Shiny apps

I am developing a shiny application which save the data entered on the user interface. I have refered the url on shiny rstudio page so by using this page, the code i have written is as mentioned below:
outputDir <- "C:\\Users/dell/Desktop/"
saveData <- function(data) {
data <- t(data)
fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
write.csv(
x = data, sep = ",",
file = file.path(outputDir, fileName),
row.names = FALSE, quote = TRUE
)
}
loadData <- function() {
files <- list.files(outputDir, full.names = TRUE)
data <- lapply(files, read.csv, stringsAsFactors = FALSE)
data <- do.call(rbind, data)
data
}
library(shiny)
fields <- c("name", "staff_name")
shinyApp(
ui = fluidPage(
titlePanel("attendance System"),
DT::dataTableOutput("responses", width = 300), tags$hr(),
textInput("name", "Accession Number", ""),
selectInput("staff_name", "Staff Name",
c("Rajiv" = "RT",
"Arvind " = "AKS",
"Ashutosh " = "AS")),
actionButton("submit", "Submit")
),
server = function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
observeEvent(input$submit, {
saveData(formData())
})
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
}
)
The above code create a new file for each entry. I am looking for a single file in which all entry to be added.
This will give you a unique file name based on time of save and content of the file:
fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
You can give it a single name like:
fileName <- 'input_bu.csv'
Like #ismirsehregal, I'd recommend bookmarking for this though.
after looking various solutions. I reached at below code to save the data in a single file as it is entered.
library(shiny)
outputDir <- "C:\\Users/dell/Desktop/"
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("responsesiq")) {
responsesiq <<- rbind(responsesiq, data)
} else {
responsesiq <<- data
}
fileName <- "test_igntu.csv"
write.csv(
x = responsesiq, sep = ",",
file = file.path(outputDir, fileName),
row.names = FALSE, quote = TRUE
)
}
fields <- c("acc", "staff_name")
shinyApp(
ui = fluidPage(
titlePanel("Attendance System"),
DT::dataTableOutput("responsesiq", width = 300), tags$hr(),
numericInput("acc", "AccNumber", ""),
selectInput("staff_name", "Staff Name",
c("Rajiv" = "RT",
"Arvind" = "AKS",
"Ashutosh" = "AS")),
actionButton("submit", "Submit")
),
server = function(input, output, session) {
# Whenever a field is filled, aggregate all form data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(formData())
})
}
)

Generating multiple graphs/plots from uploaded files in Shiny

I'm new to Shiny (worked with R for a few months) and i'm trying to figure out what a 'Shiny' way of handling multiple uploaded files is.
My goal is to have an interface where the user can upload multiple files. From these files a report must be generated, in the form of a large number of graphs and plots. From what I learned in the Shiny tutorials, on the server side all objects are isolated from eachother (meaning they cant be read, unless you call another function explicitly).
As you can see in my code below, this means that I have to duplicate the processing code for every single plot. This seems inefficient. What would be the 'Shiny' way of handling this?
Also, i left out a bunch of code that is not absolutely necessary for the example. In essence, I need to do a lot more processing and i dont want to duplicate all that code for every plot.
I am specifically asking about the server-side code. I want to read in multiple files that contain different contents. The operations in the server-side code are just place-holders, I don't actually want to cbind anything but I put that there to keep this code simple. I want to be able to do whatever I want to the imported data frames.
library(shiny)
# Define UI for application
ui <- fluidPage(
# Sidebar with file input
sidebarLayout(
sidebarPanel(
fileInput("people", NULL, multiple = FALSE, accept = ".csv",
buttonLabel = "Browse...", placeholder = "people file"),
fileInput("info", NULL, multiple = FALSE, accept = ".csv",
buttonLabel = "Browse...", placeholder = "info file"),
),
# Show the results of the data processing
mainPanel(
imageOutput("plot"),
tableOutput("base_data")
)
)
)
# Define server logic required to process the data
server <- function(input, output) {
output$base_data <- renderTable({
if(is.null(input$people) | is.null(input$info)) {
} else {
people_file <- input$people
info_file <- input$info
people <- read.csv(people_file$datapath, stringsAsFactors = F, encoding = "UTF-8-BOM")
info <- read.csv(info_file$datapath, stringsAsFactors = F, fileEncoding = "UTF-8-BOM")
rbind(people, info)
}
})
output$plot <- renderImage({
if(is.null(input$people) | is.null(input$info)) {
outfile <- tempfile(fileext='.png')
png(outfile, width = 1200, height = 800, res = 200)
dev.off()
list(src = outfile, width = 1200, height = 800)
} else {
people_file <- input$people
info_file <- input$info
people <- read.csv(people_file$datapath, stringsAsFactors = F, encoding = "UTF-8-BOM")
info <- read.csv(info_file$datapath, stringsAsFactors = F, fileEncoding = "UTF-8-BOM")
outfile <- tempfile(fileext='.png')
png(outfile, width = 1200, height = 800, res = 200)
plot(nrow(people), nrow(info), type="b")
dev.off()
list(src = outfile, width = 1200, height = 800, alt = "questions"))
}
}, deleteFile = TRUE)
}
# Run the application
shinyApp(ui = ui, server = server)
Here's an example of what i want in pseudocode:
[[ui]]
fileInput("people")
fileInput("info")
show(plot)
show(plot2)
show(df)
[[serverside]]
files <- source(input) {
people <- read.csv(input$people, stringsAsFactors = F, encoding = "UTF-8-BOM")
info <- read.csv(input$info, stringsAsFactors = F, encoding = "UTF-8-BOM")
}
contents <- plot(output) {
some_function(files$people, files$info)
plot(contents)
}
contents2 <- plot(output) {
some_other_function(files$people, files$info)
plot2 <- plot(contents2)
}
df <- table(output) {
cbind(files$people, files$info)
}
This is in pseudocode what i have now, which is not efficient.
[[ui]]
fileInput("people")
fileInput("info")
show(plot)
show(plot2)
show(df)
[[serverside]]
contents <- plot(input, output) {
people <- read.csv(input$people, stringsAsFactors = F, encoding = "UTF-8-BOM")
info <- read.csv(input$info, stringsAsFactors = F, encoding = "UTF-8-BOM")
contents <- some_function(people, info)
plot(contents)
}
contents2 <- plot(input, output) {
people <- read.csv(input$people, stringsAsFactors = F, encoding = "UTF-8-BOM")
info <- read.csv(input$info, stringsAsFactors = F, encoding = "UTF-8-BOM")
contents <- some_other_function(people,info)
plot(contents)
}
df <- table(input, output) {
people <- read.csv(input$people, stringsAsFactors = F, encoding = "UTF-8-BOM")
info <- read.csv(input$info, stringsAsFactors = F, encoding = "UTF-8-BOM")
cbind(people, info)
}
I will have to agree with heds1 thats a bit difficult to get your desired result. Since we dont have access to your csvs i created some dummy ones.
Reproducible data / csvs:
write.csv2(x = 1:5, file = "people.csv", row.names = FALSE)
write.csv2(x = 6:10, file = "people2.csv", row.names = FALSE)
If i understand you correctly you would like to avoid repeating the code for every uploaded file.
In order to loop over your files/ datasets we will have to collect them in one data structure.
One way of doing so would be to allow upload multiple files:
fileInput(..., multiple = TRUE)
Ui Side:
The ui side you could create with a loop in renderUI():
output$plots <- renderUI({
lapply(paste("people", 1:length(data)), plotOutput)
})
Server side:
The server side you can create with a loop over:
output[[paste("people", nr)]] <- renderPlot({
plot(plotData)
})
Local assignment
Finally you will have to use local() to avoid that only the data of the last iteration of the loop is taken:
local({
LOCAL_VARIABLE <- data[[nr]]
....
})
Full reproducible example:
library(shiny)
write.csv2(x = 1:5, file = "people.csv", row.names = FALSE)
write.csv2(x = 6:10, file = "people2.csv", row.names = FALSE)
ui <- fluidPage(
fileInput(inputId = "people", label = NULL, accept = ".csv",
buttonLabel = "Browse...", placeholder = "people file", multiple = TRUE),
uiOutput("plots")
)
server <- function(input, output, session) {
observeEvent(input$people, {
data <- lapply(input$people$datapath, read.csv2)
for(nr in 1:length(data)){
local({
plotData <- data[[nr]]
output[[paste("people", nr)]] <- renderPlot({
plot(plotData)
})
})
}
output$plots <- renderUI({
lapply(paste("people", 1:length(data)), plotOutput)
})
})
}
shinyApp(ui, server)
Edit:
Reuse the imported (and transformed) data:
library(shiny)
write.csv2(x = 1:5, file = "people.csv", row.names = FALSE)
ui <- fluidPage(
fileInput(inputId = "people", label = NULL, accept = ".csv",
buttonLabel = "Browse...", placeholder = "people file", multiple = FALSE),
plotOutput("plot"),
tableOutput("table"),
verbatimTextOutput("text")
)
server <- function(input, output, session) {
global <- reactiveValues()
observeEvent(input$people, {
data <- read.csv2(input$people$datapath)
# DO LOTS OF OPERATIONS ON data
global$data <- data
# FROM HERE ON USE: global$data
})
output$plot <- renderPlot({
req(global$data)
plot(global$data)
})
output$table <- renderTable({
global$data
})
output$text <- renderText({
toString(global$data)
})
}
shinyApp(ui, server)

How to loop through multiple upload widegets in shiny?

I want to create multiple fileInput function to allow users to upload files. The main reason I am creating multiple upload widgets is because I want to allow users to upload through different path. What I am trying to accomplish here is to loop through all the fileInputs and save all the files into one dataframe but not able to do it in example of my code.
library(shiny)
library(data.table)
library(DT)
n_attachments <- sprintf("file%s",seq(1:2))
ui <- fluidPage(
titlePanel('File download'),
sidebarLayout(
sidebarPanel(
textInput("LOAN_NUMBER", label = "Fannie Mae Loan Number", placeholder = "Please enter loan #")
, textInput("REO_ID", label = "REO Number", placeholder = "Please enter REO #")
, fileInput("file1", "Attachments1", accept = c("text/csv", "text/comma-separated-values,text/plain",".csv", ".pdf", ".doc", ".xlsx"), multiple = TRUE)
, fileInput("file2", "Attachments2", accept = c("text/csv", "text/comma-separated-values,text/plain",".csv", ".pdf", ".doc", ".xlsx"), multiple = TRUE)
, textOutput('text')
),
mainPanel(
DT::dataTableOutput("table"), tags$hr()
)
)
)
server <- function(input, output) {
bin_data <- reactive({
attachement_data <- data.frame(ATTACHMENT = character(), FILENAME = character(), LOAN_NUMBER = character(), REO_ID = character())
for(x in n_attachments)
{
output$text <- renderText({ input$x })
req(input$x)
# binary_data <- paste(readBin(input$file1$datapath, what="raw", n=1e6), collapse="-")
# attachment_info <- data.frame(ATTACHMENT = binary_data, FILENAME = paste0(input$file1$name))
# attachment_info
binary_data=list()
filenames=list()
for(i in 1:length(input$x[,1])){
binary_data[[i]] <- paste(readBin(input$x[[i, 'datapath']], what = "raw", n=1e6), collapse = "-")
filenames[[i]] <- input$x[[i, 'name']]
}
bin_data_frame <- data.frame(ATTACHMENT = as.character(unlist(binary_data)), FILENAME = as.character(unlist(filenames)))
bin_data_frame$LOAN_NUMBER <- input$LOAN_NUMBER
bin_data_frame$REO_ID <- input$REO_ID
attachement_data <- rbind(attachement_data, bin_data_frame)
}
save(attachement_data, file="attachement_data.RData")
attachement_data
})
output$table <- DT::renderDataTable({
bin_data()
})
}
shinyApp(ui = ui, server = server)
ok I think I figured it out, I have to use input[[x]] instead of input$x, and I added couple lines to check how many fileinputs are uploaded.
server <- function(input, output) {
bin_data <- reactive({
attachement_data <- data.frame(ATTACHMENT = character(), FILENAME = character(), LOAN_NUMBER = character(), REO_ID = character())
k <- 0
for(x in n_attachments)
{
if(!is.null(input[[x]]))
{
k = k + 1
}
}
for(x in n_attachments[0:k])
{
if(!is.null(input[[x]]))
{
output$text <- renderText({ input[[x]] })
req(input[[x]])
# binary_data <- paste(readBin(input$file1$datapath, what="raw", n=1e6), collapse="-")
# attachment_info <- data.frame(ATTACHMENT = binary_data, FILENAME = paste0(input$file1$name))
# attachment_info
binary_data=list()
filenames=list()
for(i in 1:length(input[[x]][,1])){
binary_data[[i]] <- paste(readBin(input[[x]][[i, 'datapath']], what = "raw", n=1e6), collapse = "-")
filenames[[i]] <- input[[x]][[i, 'name']]
}
bin_data_frame <- data.frame(ATTACHMENT = as.character(unlist(binary_data)), FILENAME = as.character(unlist(filenames)))
bin_data_frame$LOAN_NUMBER <- input$LOAN_NUMBER
bin_data_frame$REO_ID <- input$REO_ID
attachement_data <- rbind(attachement_data, bin_data_frame)
}
}
save(attachement_data, file="attachement_data.RData")
attachement_data
})
output$table <- DT::renderDataTable({
bin_data()
})
}
shinyApp(ui = ui, server = server)

Dynamically Generate Plots in Conditional Tabs using renderUI in Shiny

I need some help creating dynamic plots that go inside dynamic tabs. Here's the situation ... I have a data file that contains digital marketing data. The file has the following pieces of information: Campaign Name, Channel Name, Page Views, and Visits. Campaign Names are unique and roll up to one of four different marketing channels. This will change in the future depending on the data I feed it (for example, I may have six marketing channels in the next file I use), but this will do for troubleshooting purposes. I want to dynamically create tabs and output for each marketing channel in the file. I have been able to figure out how to create the tabs, but I'm having a hard time figuring out how to create other types of output (like a plot) to go with each tab.
The tabs were created using renderUI in the following code in the server file:
output$mytabs = renderUI({
if(is.null(rawData())){return ()}
channels = unique(rawData()$Channel)
myTabs = lapply(channels, tabPanel)
do.call(tabsetPanel, myTabs)
})
output$scatterPlot <- renderUI({
if(is.null(rawData())){return()}
createPlots()
myData = rawData()
channels = unique(myData$Channel)
plot_output_list <- lapply(seq_along(channels), function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname)
})
do.call(tagList, plot_output_list)
})
createPlots <- reactive ({
myData = rawData()
channels = unique(myData$Channel)
for (i in seq_along(channels)) {
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
tempRows = which(myData$Channel==channels[i])
output[[plotname]] <- renderPlot({
plot(x = myData$Spend[tempRows], y = myData$Return[tempRows])
})
})
}
})
These were then referenced in the ui file as follows:
mainPanel(
tabsetPanel(
tabPanel("Data Summary", uiOutput("dataSummary")),
tabPanel("Parameters & Model Fit",
uiOutput('mytabs'),
uiOutput('scatterPlot')),
tabPanel("Budget & Spend Summary"),
tabPanel("Testing", plotOutput('plot5'))
)
)
Ultimately, I'd like to plot Page Views vs Visits for each Marketing Channel on the corresponding marketing channel tab. At the moment, all four plots are showing up in each of marketing channel tab. In my global file, I've created two functions -- one function plots one channel at a time and another function that plots all the channels and saves each one as separate elements within a list. I'm not sure which one of these will end up being useful, if either.
I'm certain that I'm not understanding how to set 'myTabs' or I'm referencing it incorrectly from the ui. Even with this snippet of the code, someone here might be able to quickly spot the error and recommend a fix, but I am happy to provide the rest of my code if that would be helpful.
Thanks!
Jess
EDIT: For Reference, here is all of my code. Just changed the dir object to be the directory you want to work in.
library(shiny)
dir = ""
setwd(dir)
#######################
### Generate Data ###
#######################
channels = c("Affiliate","Email","Media","SEO")
nObs = c(round(runif(1,100,200)))
pageViews = runif(nObs*length(channels),50,500)
visits = runif(nObs*length(channels),10,100)
campaignNames = unlist(lapply(channels, FUN = function(x) paste(x,seq(from=1,to=nObs,by=1),sep="")))
channelNames = rep(channels,nObs)
myData = data.frame(Campaign = campaignNames, Channel = channelNames, Return = pageViews, Spend = visits)
write.table(myData,file="myTestData.csv",sep=",",col.names=TRUE,row.names=FALSE)
########################
### Global Functions #
########################
summarizeData = function(myDat){
summaryData = summarize(group_by(myDat,Channel), 'Campaign Count' = length(Campaign), Return = sum(Return), Spend = sum(Spend))
return(summaryData)
}
### PLOT DATA AND MODEL FIT ###
plotSingle = function(myData, channelName){
p1 <- ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
geom_point(color="black") +
theme(panel.background = element_rect(fill = 'grey85'),
panel.grid.major = element_line(colour = "white"))
return(p1)
}
plotAll = function(myData){
channels = unique(myData$Channel)
plots <- list() # new empty list
for (i in 1:length(channels)) {
channelName = channels[i]
p1 = plotSingle(myData = myData, channelName = channelName)
plots[[i]] = p1
}
return(plots)
}
############
### UI ###
############
ui <- fluidPage(
headerPanel('Plot Testing'),
sidebarPanel(
h3(helpText("Data Input")),
fileInput(inputId = "rawDataInput", label = "Upload Data"),
h5(helpText("Select the file parameters below")),
checkboxInput(inputId = 'header', label = 'Header', value = TRUE),
checkboxInput(inputId = "stringAsFactors", "stringAsFactors", FALSE),
br(),
radioButtons(inputId = 'sep', label = 'Separator', choices = c(Comma=',',Semicolon=';',Tab='\t', Space=''), selected = ',')
),
mainPanel(
tabsetPanel(
tabPanel("Data Summary", uiOutput("dataSummary")),
tabPanel("Parameters & Model Fit",
uiOutput('mytabs'),
uiOutput('scatterPlot')),
tabPanel("Budget & Spend Summary"),
tabPanel("Testing", plotOutput('plot5'))
)
)
)
################
### Server ###
################
server = function(input, output) {
rawData <- reactive({
file1 <- input$rawDataInput
if(is.null(file1)){return()}
read.table(file=file1$datapath, sep=input$sep, header = input$header, stringsAsFactors = input$stringAsFactors)
})
# this reactive output contains the summary of the dataset and display the summary in table format
output$filedf <- renderTable({
if(is.null(rawData())){return ()}
input$rawDataInput
})
# this reactive output contains the summary of the dataset and display the summary in table format
output$sum <- renderTable({
if(is.null(rawData())){return ()}
summarizeData(rawData())
})
# This reactive output contains the dataset and display the dataset in table format
output$table <- renderTable({
if(is.null(rawData())){return ()}
rawData()
})
dataPlots = reactive({
channels = unique(rawData()$Channel)
plots = plotAll(rawData())
})
output$mytabs = renderUI({
if(is.null(rawData())){return ()}
channels = unique(rawData()$Channel)
createPlots()
plot_output_list <- lapply(seq_along(channels), function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname)
})
myTabs = lapply(channels, tabPanel)
do.call(tabsetPanel, myTabs)
})
createPlots <- reactive ({
myData = rawData()
channels = unique(myData$Channel)
for (i in seq_along(channels)) {
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
tempRows = which(myData$Channel==channels[i])
output[[plotname]] <- renderPlot({
plot(x = myData$Spend[tempRows], y = myData$Return[tempRows])
})
})
}
})
output$scatterPlot <- renderUI({
if(is.null(rawData())){return()}
createPlots()
myData = rawData()
channels = unique(myData$Channel)
plot_output_list <- lapply(seq_along(channels), function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname)
})
do.call(tagList, plot_output_list)
})
output$dataSummary <- renderUI({
if(is.null(rawData())){return()}
else
tabsetPanel(tabPanel("About file", tableOutput("filedf")),tabPanel("Data", tableOutput("table")),tabPanel("Summary", tableOutput("sum")))
})
output$plot5 = renderPlot({
if(is.null(rawData())){return ()}
myData = rawData()
channelName = "Affiliate"
p1 <- ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
geom_point(color="black") +
theme(panel.background = element_rect(fill = 'grey85'),
panel.grid.major = element_line(colour = "white"))
return(p1)
})
}
### Run App ###
shinyApp(ui = ui, server = server)
Your example isn't exactly minimal so i did some stripping away. First the data and helper functions
library(shiny)
library(ggplot2)
channels = c("Affiliate","Email","Media","SEO")
nObs = c(round(runif(1,100,200)))
myData = data.frame(
Campaign = unlist(lapply(channels, FUN = function(x) paste(x,seq(from=1,to=nObs,by=1),sep=""))),
Channel = rep(channels,nObs),
Return = runif(nObs*length(channels),50,500),
Spend = runif(nObs*length(channels),10,100)
)
plotSingle = function(myData, channelName){
ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
geom_point(color="black") +
theme(panel.background = element_rect(fill = 'grey85'),
panel.grid.major = element_line(colour = "white"))
}
Now the UI
ui <- fluidPage(
headerPanel('Plot Testing'),
mainPanel(
uiOutput('mytabs'),
plotOutput('scatterPlot')
)
)
Note that we only use one plotOutput here. What we will do is just change the plot it's showing based on the currently selected tab. Here's the server code
server = function(input, output) {
rawData <- reactive({
myData
})
output$mytabs = renderUI({
if(is.null(rawData())){return ()}
channels = unique(rawData()$Channel)
myTabs = unname(Map(tabPanel, channels))
do.call(tabsetPanel, c(myTabs, id="channeltab"))
})
output$scatterPlot <- renderPlot({
if(is.null(rawData()) | is.null(input$channeltab)){return ()}
plotSingle(rawData(), input$channeltab)
})
}
You see we set an id on the tabsetPanel we create. We can then use that as input to determine which panel is selected and show the correct plot. All run with
shinyApp(ui = ui, server = server)

Resources