Shiny: Assigning different dataframe names in if-else statement - r

I have reactive tables df1, df2 from Shiny. After some preprocessing I saved them as df1_a, df1_b, df1_a_grouped.
I have an if-else statement defined in df3:
if df1_b exists, then add 10 to column num1
else left_join(df2(), df_a_grouped()).
The script works. However, I would like to reference the two reactive dataframes defined in the if-else statement separately from df3 e.g., save as test1 for if else save as test2 so that I could use each of these in another if-else
Any help would be of great help.
Below is a fully reproducible sample script:
#### Libraries
library(shiny)
library(shinyWidgets)
library(tidyr)
library(dplyr)
library(shinydashboard)
library(reactable)
#### ui
ui <- dashboardPage(
dashboardHeader(title = "Skew"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Test1", tabName = "tab1", icon = icon("table"))
)
),
body <- dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "tab1",
fluidRow(
## df1
reactableOutput("table1"),
br(),
br(),
## df2
reactableOutput("table2"),
br(),
br(),
## df3
reactableOutput("table3")
) # fluidRow
) # tab1 - tabItem
) # tabItems
) # dashboardBody
) # dashboardPage
#### server #
server <- function(input, output, session) {
## df1
# reactive
df1 <- reactive({
data.frame(
# "id" = c("A", "A", "A", "B"),
"id" = c("A", "A", "A", "A"),
"num1" = c(10, 11, 12, 13)
)
})
# renderReactable
output$table1 <- renderReactable({
reactable(df1(), borderless = F, defaultColDef = colDef(align = "center"))
})
## df2
# reactive
df2 <- reactive({
data.frame(
"id" = c("A", "A", "B"),
"num2" = c(14, 15, 16)
)
})
# renderReactable
output$table2 <- renderReactable({
reactable(df2(), borderless = F, defaultColDef = colDef(align = "center"))
})
## df1_a
# reactive
df1_a <- reactive({
df1() %>% filter(id == "A")
})
## df1_b
# reactive
df1_b <- reactive({
df1() %>% filter(id == "B")
})
##
df1_a_grouped <- reactive({
df1_a() %>%
group_by(id) %>%
summarise(
sum_num1 = sum(num1)
)
})
## df3
# reactive
# would like to reference the two dataframes separately
df3 <- reactive({
if (nrow(df1_b()) > 0) {
df <- df1_b() %>% mutate(num1_addten = num1 + 10) # test1
} else {
df <- left_join(df2(), df 1 _a_grouped(), on = "id") # test2
}
return(df)
})
}
shinyApp(ui, server)

There are many ways to store reactive elements. You could make df3 a reactive object storing a list with your different dataframes:
df3 <- reactive({
if (nrow(df1_b()) > 0) {
df1 <- df1_b() %>% mutate(num1_addten = num1 + 10) # test1
} else {
df1 <- left_join(df2(), df1_a_grouped(), on = "id") # test2
}
df2 <- df1_b() %>% mutate(num1_addten = num1 + 10)
df3 <- left_join(df2(), df1_a_grouped(), on = "id")
list(df1, df2, df3)
})
Then you can call them like this:
df3()[[1]]
df3()[[2]]
df3()[[3]]

Related

How to store a shiny reactive data frame as csv on hard drive locally and append new entries

This is a follow-up question to this: How to use paste0 with input$ in shiny
I don't know if this is possible and I have been through all the persistent storage history the last years (here is a representative example of a former question: r shiny: Load data in to form fields from previously persistent stored data
Now I want to create a form in shiny where people can fill in the form and press a button to send the data, this is done with this code:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(width = 4,
setSliderColor(c("DeepPink ", "#FF4500", "Teal"), c(1, 2, 3)),
# Input: Simple integer interval ----
div(class = "label-left",
Map(function(id, lbl) {
list(
div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput(id, lbl, min = 0, max = 3, value = 0, width = "250px")),
div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput(paste0("txt_", id), label = NULL, value = 0, width = "40px" ))
)
}, c("a", "b", "c"), c("A", "B", "C"))
)
),
# Main panel for displaying outputs ----
mainPanel(
titlePanel("Sliders"),
# Output: Table summarizing the values entered ----
tableOutput("values")
)
)
)
server <- function(input, output, session) {
Map(function(id) {
list(
observeEvent(input[[paste0("txt_", id)]], {
if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
{
updateSliderInput(
session = session,
inputId = id,
value = input[[paste0("txt_", id)]]
) # updateSliderInput
}#if
}),
observeEvent(input[[id]], {
if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
{
updateTextInput(
session = session,
inputId = paste0("txt_", id),
value = input[[id]]
) # updateTextInput
}#if
})
)
}, c("a", "b", "c"))
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
data.frame(
Name = c("A",
"B",
"C"),
Value = as.character(c(input$a,
input$b,
input$c
)),
stringsAsFactors = FALSE)
})
# Show the values in an HTML table ----
output$values <- renderTable({
sliderValues()
})
}
shinyApp(ui, server)
And NOW I would like to save the actual filled in data to the hard disk as csv or any other format. And if the same user comes again next time the new data should be appended to the existing data.
Is this possible?
Here is an app.R that does the required actions from your comments.
library(shiny)
library(shinyWidgets)
library(dplyr)
library(openxlsx)
defaultDF <- data.frame(Name = c("A", "B", "C"),
Value = rep(0L, 3))
MyColors = c("DeepPink ", "#FF4500", "Teal")
ui <- fluidPage(
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(width = 4,
setSliderColor(MyColors,
c(1:3)),
# Input: Simple integer interval ----
div(class = "label-left",
Map(function(id, lbl, val) {
list(
div(style="display: inline-block;vertical-align:middle; width: 300px;",
sliderInput(id, lbl, min = 0, max = 3, value = val, width = "250px")),
div(style="display: inline-block;vertical-align:middle; width: 150px;",
textInput(paste0("txt_", id), label = NULL, value = 0, width = "40px" ))
)
}, defaultDF %>% select(Name) %>% pull(),
defaultDF %>% select(Name) %>% pull(),
defaultDF %>% select(Value) %>% pull())
),
downloadButton("xlsxDownload", "Download dataframe"),
fileInput(
"xlsxUpload",
"Files with stored values",
#placeholder = "Select files",
#buttonLabel = "Обзор",
#accept = c(".xml",".zip"),
accept = c(".xlsx"),
multiple = F
)
),
# Main panel for displaying outputs ----
mainPanel(
titlePanel("Sliders"),
# Output: Table summarizing the values entered ----
tableOutput("values")
)
)
)
server <- function(input, output, session) {
currentDF <- reactiveVal(defaultDF)
# Show the values in an HTML table ----
output$values <- renderTable({
currentDF()
})
output$xlsxDownload <- downloadHandler(
filename =
function() { "myDataframe.xlsx"
},
content =
function(file) {
openxlsx::write.xlsx(
currentDF(),
file)
}
)
observe({
file1 <- input$xlsxUpload
if (!is.null(file1)) {
ext <- tools::file_ext(file1$datapath)
req(file1)
validate(need(ext %in% c("xlsx"), 'All files must have extension xlsx')) # Add all other validation checks as well
transformedData <- openxlsx::read.xlsx(file1$datapath)
#do necessary checks and data transformations here
transformedData
currentDF(transformedData)
}
})
observe({
cdf <- currentDF()
Map(function(Nm) updateSliderInput(
session = session,
inputId = Nm,
value = cdf %>% filter(Name == Nm) %>% select(Value) %>% pull()
),
c("A", "B", "C")
)
})
observe({
cdf <- currentDF()
Map(function(Nm) updateTextInput(
session = session,
inputId = paste0("txt_", Nm),
value = cdf %>% filter(Name == Nm) %>% select(Value) %>% pull()
),
c("A", "B", "C")
)
})
toListen <- reactive({
list(input$A, input$B, input$C)
})
toListen2 <- reactive({
list(input$txt_A, input$txt_B, input$txt_C)
})
observeEvent(toListen(),{ Map(function(id) {cdf <- currentDF()
cdf$Value[cdf$Name == id] <- input[[id]]
currentDF(cdf)
},
c("A", "B", "C")
)
}
)
observeEvent(toListen2(),{ Map(function(id) {cdf <- currentDF()
cdf$Value[cdf$Name == id] <- input[[paste0("txt_", id)]]
currentDF(cdf)
},
c("A", "B", "C")
)
}
)
}
shinyApp(ui, server)
It allows:
to save and load a xlsx file with dataframe containing settings (values of A, B and C) on the client side.
to change this dataframe when slider is moved and or text is input.
to adjust positions of sliders / values in text inputs and rendered dataframe when the flie is loaded and/or any of the input controls value changes.

How to execute a paste function inside a reactive dataframe?

I am somewhat familiar with the paste() function in base R. I am trying to learn Shiny and reactivity and don't understand how to execute a paste() inside a reactive Shiny function.
In running the demo code at the bottom, this is what first appears in the rendered "Reactive results" panel:
choice subclass
1 A 1
2 A 1
3 A 2
4 B 1
5 B 3
I'd like to paste the row number of each row in front of each "choice" column element, followed by a "." and a space, so that the "Reactive results" panel output looks like this:
choice subclass
1 1. A 1
2 2. A 1
3 3. A 2
4 4. B 1
5 5. B 3
How would I execute a paste() in this reactive example?
Demo code:
library(shiny)
data <- data.frame(choice = c("A","A","A","B","B"),subclass = c(1,1,2,1,3))
ui <- fluidPage(
h5(strong("Base data frame:")),
verbatimTextOutput("data"),
radioButtons(inputId = "showData",
label = h5(strong("Multiply base DF subclass by factor of:")),
choiceNames = c('One','Two'),
choiceValues = c('One','Two'),
selected = 'One',
inline = TRUE
),
h5(strong("Reactive results:")),
verbatimTextOutput("choices1")
)
server <- function(input, output, session) {
output$data <- renderPrint(data)
rv <- reactiveValues(choices1=c())
observeEvent(input$showData, {
if(input$showData == 'One'){rv$choices1 <- data[]}
else {rv$choices1[,2] <- 2 * data[ ,2]}
}
)
output[["choices1"]] <- renderPrint({rv$choices1})
}
shinyApp(ui, server)
Your app looks a bit complicated to me. But as I don't know about your desired final result I stick with your code and only did some slight changes in your observeEvent to achieve your desired result:
library(shiny)
data <- data.frame(choice = c("A", "A", "A", "B", "B"), subclass = c(1, 1, 2, 1, 3))
ui <- fluidPage(
h5(strong("Base data frame:")),
verbatimTextOutput("data"),
radioButtons(
inputId = "showData",
label = h5(strong("Multiply base DF subclass by factor of:")),
choiceNames = c("One", "Two"),
choiceValues = c("One", "Two"),
selected = "One",
inline = TRUE
),
h5(strong("Reactive results:")),
verbatimTextOutput("choices1")
)
server <- function(input, output, session) {
output$data <- renderPrint(data)
rv <- reactiveValues(choices1 = c())
observeEvent(input$showData, {
rv$choices1 <- data
rv$choices1$choice <- paste0(row.names(rv$choices1), ". ", rv$choices1$choice)
if (input$showData == "Two") {
rv$choices1[, 2] <- 2 * rv$choices1[, 2]
}
})
output[["choices1"]] <- renderPrint({
rv$choices1
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:4262
Suggested modifications, in two parts.
First,
use str_glue instead of paste, and mutate to modify the dataframe,
replace choiceNames and choiceValues with a single argument choices, as they are equal,
rewrite output[["choices1"]] as output$choices1,
use dataframe column by name rather than by index,
replace reactiveValues and observeEvent with a single reactive: reactivity is automatic, you don't have to reimplement it with an oberveEvent.
Here is the code:
library(shiny)
library(dplyr)
library(magrittr)
library(stringr)
data <- data.frame(choice = c("A", "A", "A", "B", "B"),
subclass = c(1, 1, 2, 1, 3))
ui <- fluidPage(
h5(strong("Base data frame:")),
verbatimTextOutput("data"),
radioButtons(inputId = "showData",
label = h5(strong("Multiply base DF subclass by factor of:")),
choices = c("One", "Two"),
selected = "One",
inline = TRUE
),
h5(strong("Reactive results:")),
verbatimTextOutput("choices1")
)
server <- function(input, output, session) {
output$data <- renderPrint(data)
rv <- reactive({
df <- data %>% mutate(choice = str_glue("{row_number()}. {choice}"))
if (input$showData == "Two") {
df %<>% mutate(subclass = 2 * subclass)
}
df
})
output$choices1 <- renderPrint(rv())
}
shinyApp(ui, server)
Second simplification: the reactive is useless as it's only used once, in renderPrint. So put everything in renderPrint. It's still reactive.
library(shiny)
library(dplyr)
library(magrittr)
library(stringr)
data <- data.frame(choice = c("A", "A", "A", "B", "B"),
subclass = c(1, 1, 2, 1, 3))
ui <- fluidPage(
h5(strong("Base data frame:")),
verbatimTextOutput("data"),
radioButtons(inputId = "showData",
label = h5(strong("Multiply base DF subclass by factor of:")),
choices = c("One", "Two"),
selected = "One",
inline = TRUE
),
h5(strong("Reactive results:")),
verbatimTextOutput("choices1")
)
server <- function(input, output, session) {
output$data <- renderPrint(data)
output$choices1 <- renderPrint({
df <- data %>% mutate(choice = str_glue("{row_number()}. {choice}"))
if (input$showData == "Two") {
df %<>% mutate(subclass = 2 * subclass)
}
df
})
}
shinyApp(ui, server)

How to put 2 possibles eventReactive in only one variable

I am building a Shiny app which generate a dataframe from a database through the specific function my_function.
I want to use an eventReactive() to attribute the result of my_function depending on different inputs. My problem is that there are 2 ways to select these inputs which are structured in 2 different panels (I need this structure), so I have 2 actionButton that allow me to run my_function, and 1 variable for each eventReactive. Is there a way to put them in only 1 variable ?
df_all is a dataframe with several columns like "VAR1", "YEAR", "TYPE", "AGE" ... I need to filter depending on the inputs.
For the moment I have tried :
library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
df_all <- data.frame(
VAR1 = c(rep("A", 2), "B", "C")
YEAR = (rep(2001, 3), 2002)
TYPE = c("t1", "t2", "t2", "t1")
)
my_function <- function(arg1, arg2, arg3)
{
df = data.frame(
v1 = paste(arg1, arg2)
v2 = arg3
)
return(df)
}
shinyUI(dashboardPage(
dashboardHeader("title"),
dashboardSidebar(
sidebarMenu(id = "menu",
menuItem("Item1", tabName = "item1")
)),
dashboardBody(
tabItems(
tabItem(tabName = "item1",
selectInput(inputId = "var1", label = NULL, choices = c("A", "B", "C")),
tabsetPanel(
tabPanel("Item1-Panel1",
uiOutput("ui_year1"),
uiOutput("ui_type1"),
div(actionButton(inputId = "extra1", label = "Run", icon = icon("play")))),
tabPanel("Item1-Panel2",
uiOutput("ui_year2"),
uiOutput("ui_type2"),
div(actionButton(inputId = "extra2", label = "Run", icon = icon("play")))),
tabPanel("Item1-Panel3",
DT::dataTableOutput("tableau_ext1"),
DT::dataTableOutput("tableau_ext2"),
downloadButton("downloadCSV", "Save (CSV)"))
))))))
shinyServer(function(input, output) {
output$ui_year1 <- renderUI({
checkboxGroupInput(inputId = "year1", label = NULL, choices = df_all %>% filter(CULTURE == input$var1) %>% select(YEAR) %>% distinct() %>% pull()
})
output$ui_type1 <- renderUI({
checkboxGroupInput(inputId = "type1", label = NULL, choices = sort(df_all %>% filter(VAR1 == input$cult, YEAR %in% input$year1) %>% select(TYPE) %>% distinct() %>% pull())
})
output$ui_year2 <- renderUI({
checkboxGroupInput(inputId = "year2", label = NULL, choices = df_all %>% filter(VAR1 == input$var1) %>% select(YEAR) %>% distinct() %>% pull()
})
output$ui_type2 <- renderUI({
checkboxGroupInput(inputId = "type2", label = NULL, choices = sort(df_all %>% filter(VAR1 == input$cult, YEAR %in% input$year2) %>% select(TYPE) %>% distinct() %>% pull())
})
df1 <- eventReactive(input$extra1, {
my_function(arg1 = input$cult,
arg2 = as.numeric(input$year1),
arg3 = as.character(input$type1))
})
df2 <- eventReactive(input$extra2, {
my_function(arg1 = input$cult,
arg2 = as.numeric(input$year2),
arg3 = as.character(input$type2))
})
})
I tried to attribute the 2 eventReactive in 1 variable df, because I want to see and save the dataframe generated by my_function with :
shinyServer([...]
df <- eventReactive(input$extra1, {
my_function(arg1 = input$cult,
arg2 = as.numeric(input$year1),
arg3 = as.character(input$type1))
})
df <- eventReactive(input$extra2, {
my_function(arg1 = input$cult,
arg2 = as.numeric(input$year2),
arg3 = as.character(input$type2))
})
output$tableau_ext1 <- DT::renderDataTable({
df()
})
output$downloadCSV <- downloadHandler(
filename = function() {
paste0(input$year1, "_", input$type1, ".csv")
},
content = function(file) {
write.csv2(df(), file, row.names = FALSE)
}
)
)
But it didn't worked... If someone knows how to solve my problem, I will be grateful for his help :)
Building off of this thread the following seems to achieve the desired behavior (if I understand everything correctly):
library(shiny)
my_fun <- function() {
x <- sample(x=nrow(iris), size = 6)
x
}
ui <- fluidPage(
tabsetPanel(
tabPanel(title = "panel1",
actionButton("go1", "go 1")),
tabPanel(title = "panel2",
actionButton("go2", "go 2"))
),
mainPanel(dataTableOutput("tab"))
)
server <- function(input, output) {
df <- eventReactive(c(input$go1, input$go2), {
iris[my_fun(),]
}, ignoreNULL = FALSE, ignoreInit = TRUE)
output$tab <- renderDataTable({
df()
})
}
shinyApp(ui, server)
See also ?eventReactive for the ignoreNULL and ignoreInit options.
Edit: Two functions, one eventReactive, and keep track of tabs to know what to render.
library(shiny)
library(dplyr)
go1_fun <- function() {
x <- filter(iris, Species == "setosa") %>% head
x
}
go2_fun <- function() {
x <- filter(iris, Species == "virginica") %>% head
x
}
ui <- fluidPage(
tabsetPanel(id = "tabs",
tabPanel(title = "panel1",
actionButton("go1", "go 1")),
tabPanel(title = "panel2",
actionButton("go2", "go 2"))
),
mainPanel(dataTableOutput("tab"))
)
server <- function(input, output, session) {
df1 <- reactive({
if (req(input$go1)) {
x <- go1_fun()
}
return(x)
})
df2 <- reactive({
if (req(input$go2)) {
x <- go2_fun()
}
return(x)
})
tab_to_render <- eventReactive(c(input$go1, input$go2), {
if (input$tabs == "panel1") x <- df1()
if (input$tabs == "panel2") x <- df2()
return(x)
}, ignoreNULL = FALSE, ignoreInit = TRUE)
output$tab <- renderDataTable({
tab_to_render()
})
}
shinyApp(ui, server)

R - Turn character variable in numeric with DT and shiny

It's been 2 days that I'm trying to convert dynamically character variables in numerics and vice-versa in a shiny datatable.
Here I send you a reproductible exemple:
library(DT)
library(shiny)
library(tidyverse)
server = shinyServer(function(input, output) {
mydata <- reactive({
df <- mtcars %>% rownames_to_column("model")
df[,2] <- ifelse(input[[paste0("col", 2)]]=="num",unlist(df[,2]) %>%
as.numeric, unlist(df[,2]) %>% as.character)
df
})
output$tableau <- DT::renderDT({
#df <- mtcars %>% rownames_to_column("model")
df <- mydata()
class <- map_df(df, typeof)
class <- gsub("double", "numeric", class)
class <- gsub("integer", "numeric", class)
tableSelectInput <- map(1:ncol(df),
function(i) {
if (class[i] =="numeric"){
opt1 <- "num"
opt2 <- "cat"
}else{
opt1 <- "cat"
opt2 <- "num"
}
selectInput(
inputId = paste0("col", i),
label = NULL, selected = opt1,
choices = c(opt1, opt2))
}
)
# I didn't find a more elegant way to turn '[[ ]]' in '[ ]'
l <- length(tableSelectInput)
selectin <- 1:l
type_cat <- 1:l
for (i in 1:l) {
selectin[i] = as.character(tableSelectInput[[i]])
pos=gregexpr("selected>",selectin[i])[[1]][1]
type_cat[i] = substr(selectin[i],(pos+9),(pos+11))
}
col_names = paste0(colnames(df), " <br/><em>(",type_cat,")</em>
<br/>", selectin, sep=" ")
DT::datatable(
df,
options = list(
preDrawCallback = JS("function() {
Shiny.unbindAll(this.api().table().node()); }"),
drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());
}")
),
colnames =col_names,
editable = TRUE,
escape=FALSE,
selection = list(target = 'column'))
}, server=FALSE)
output$log <- renderPrint({
#To check if it works
mydata()[,2]
})
})
ui = shinyUI(
fluidPage(
titlePanel("My Awesome Shiny App"),
# Show a plot of the generated distribution
mainPanel(
DT::DTOutput("tableau"),
# Show log
verbatimTextOutput("log")
)
)
)
runApp(list(ui = ui, server = server))
Issue:
When I'm trying to change the selectinput for the 2 column. In the renderPrint, we see that the type of format doesn't change.
Some one could help me please?

Shiny ggvis reactive plot

I'd like to make Shiny app, which plots cumstom graphs on the parameters i choose using ggvis package.
If I choose All brands, I'd like to get this plot:
But when I select only one specific brand, the plot should look like this:
I tried different ways, but none of them gave me results I expected.
Could you please, give an ideas how to solve this issue?
Also I include reproducable example:
library(shiny)
library(shinydashboard)
library(plyr)
library(ggvis)
# Header -----------------------------------------------------------
header <- dashboardHeader(title= "DashBoard")
# Sidebar --------------------------------------------------------------
sm <- sidebarMenu(
menuItem(
text="GGVIS",
tabName="GGVIS",
icon=icon("eye")
)
)
sidebar <- dashboardSidebar(sm)
# Body --------------------------------------------------
body <- dashboardBody(
# Layout --------------------------------------------
tabItems(
tabItem(
tabName="GGVIS",
fluidPage(
fluidRow(
title = "Inputs", status = "warning", width = 2, solidHeader = TRUE, collapsible = TRUE,
uiOutput("Category"),
uiOutput("Brand"),
uiOutput("Values"),
ggvisOutput("p")
)
)
)
)
)
# Setup Shiny app UI components -------------------------------------------
ui <- dashboardPage(header, sidebar, body)
# Setup Shiny app back-end components -------------------------------------
server <- function(input, output) {
set.seed(1992)
n=101
Letter <- sample(c("a", "b", "c"), n, replace = TRUE, prob = NULL)
Category <- sample(c("Car", "Bus", "Bike"), n, replace = TRUE, prob = NULL)
Brand <- sample("Brand", n, replace = TRUE, prob = NULL)
Brand <- paste0(Brand, sample(1:14, n, replace = TRUE, prob = NULL))
USD <- abs(rnorm(n))*100
df <- data.frame(Letter, Category, Brand, USD)
# Inputs --------------------------------------
output$Category <- renderUI({
selectInput("Category", "Choose category:",
choices = c("Car","Bus", "Bike" ))
})
output$Brand <- renderUI({
df2 <- df[df$Category %in% input$Category,]
selectInput("Brand",
"Brand:",
c("All", unique(as.character(df2$Brand))))
})
# -----------------------------------------------------------------------------
data2 <- reactive({
df <- df[df$Category %in% input$Category,]
df <- df[df$Brand %in% input$Brand,] # if I comment this line, I get All brands graph
df <- droplevels(df)
df <- ddply(df, c("Letter", "Category", "Brand"), summarise, "USD" = sum(USD))
})
data2%>% group_by(Brand) %>%
ggvis(x = ~factor(Letter, levels = c("a", "b", "c")), y = ~USD, fill = ~Brand, fillOpacity := 1) %>%
layer_bars() %>%
add_axis("x", title = "Letter") %>% bind_shiny("p")
# -----------------------------------------------------------------------------
}
# Render Shiny app --------------------------------------------------------
shinyApp(ui, server)
Try
1) not change df into reactive
data2 <- reactive({
df3=df
df3 <- df3[df3$Category %in% input$Category,]
df3 <- df3[df3$Brand %in% input$Brand,] # if I comment this line, I get All brands graph
df3 <- droplevels(df3)
df3<- ddply(df3, c("Letter", "Category", "Brand"), summarise, "USD" = sum(USD))
})
2)to add if statement
if(!"All" %in% input$Brand){
df3 <- df3[df3$Brand %in% input$Brand,] # if I comment this line, I get All brands graph
}

Resources