Shiny ggvis reactive plot - r

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
}

Related

Shiny: Assigning different dataframe names in if-else statement

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]]

Error in sankey plot variables in R shiny

Please run the script below, there are two charts created using the patients dataset from the bupaR library, the chart on the left displays a sankey chart showing relationship between the resource("employee") and activities("handling") and the chart on the right displays the details of link between the resource and activities when we perform "on-click". Basically, we see a subset of data with corresponding values say "r1" and "Registration" values when we click the link connecting "r1" to "Registration" and so on. However, when I run code with any other resource and activity column, the sankey chart does not get created and I get the following error "non-numeric argument to binary operator". Please try the script with a simple dataset and help:
a1 = c("A","B","C","A","B","B")
a2 = c("D","E","D","E","D","F")
a12 = data.frame(a1,a2)
library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)
library(bupaR)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader =
T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", height = "455",solidHeader
= T,
dataTableOutput("sankey_table"))
)
)
server <- function(input, output)
{
sankeyData <- reactive({
sankeyData <- patients %>%
group_by(employee,handling) %>%
count()
sankeyNodes <- list(label = c(sankeyData$employee,sankeyData$handling))
trace2 <- list(
domain = list(
x = c(0, 1),
y = c(0, 1)
),
link = list(
label = paste0("Case",1:nrow(sankeyData)),
source = sapply(sankeyData$employee,function(e) {which(e ==
sankeyNodes$label) }, USE.NAMES = FALSE) - 1,
target = sapply(sankeyData$handling,function(e) {which(e ==
sankeyNodes$label) }, USE.NAMES = FALSE) - 1,
value = sankeyData$n
),
node = list(label = sankeyNodes$label),
type = "sankey"
)
trace2
})
output$sankey_plot <- renderPlotly({
trace2 <- sankeyData()
p <- plot_ly()
p <- add_trace(p, domain=trace2$domain, link=trace2$link,
node=trace2$node, type=trace2$type)
p
})
output$sankey_table <- renderDataTable({
d <- event_data("plotly_click")
req(d)
trace2 <- sankeyData()
sIdx <- trace2$link$source[d$pointNumber+1]
Source <- trace2$node$label[sIdx + 1 ]
tIdx <- trace2$link$target[d$pointNumber+1]
Target <- trace2$node$label[tIdx+1]
patients %>% filter(employee == Source & handling == Target)
})
}
shinyApp(ui, server)
In order to make this "ready solution" with any dataset I think you need one character (cut and color were turned into character using as.character()) of column b for each character of column a. For example, in the patient dataset, there is only one possibility (registration) for r1; same for r2 to r7. Your app did not work with the full diamonds dataset. But using the same logic, the app works.
diamonds_b <- diamonds %>% filter(cut == "Ideal" & color == "D")
diamonds_c <- diamonds %>% filter(cut == "Fair" & color == "E")
diamonds_d <- rbind(diamonds_b, diamonds_c)
diamonds_d$cut <- as.character(diamonds_d$cut)
diamonds_d$color <- as.character(diamonds_d$color)
and now running the shiny app with the diamonds_d dataset works:
ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader =
T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", height = "455",solidHeader
= T,
dataTableOutput("sankey_table"))
)
)
server <- function(input, output)
{
sankeyData <- reactive({
sankeyData <- diamonds_d %>%
group_by(cut,color) %>%
count()
sankeyNodes <- list(label = c(sankeyData$cut,sankeyData$color))
trace2 <- list(
domain = list(
x = c(0, 1),
y = c(0, 1)
),
link = list(
label = paste0("Case",1:nrow(sankeyData)),
source = sapply(sankeyData$cut,function(e) {which(e == sankeyNodes$label) }, USE.NAMES = FALSE) - 1,
target = sapply(sankeyData$color,function(e) {which(e == sankeyNodes$label) }, USE.NAMES = FALSE) - 1,
value = sankeyData$n
),
node = list(label = sankeyNodes$label),
type = "sankey"
)
trace2
})
output$sankey_plot <- renderPlotly({
trace2 <- sankeyData()
p <- plot_ly()
p <- add_trace(p, domain=trace2$domain, link=trace2$link,
node=trace2$node, type=trace2$type)
p
})
output$sankey_table <- renderDataTable({
d <- event_data("plotly_click")
req(d)
trace2 <- sankeyData()
sIdx <- trace2$link$source[d$pointNumber+1]
Source <- trace2$node$label[sIdx + 1 ]
tIdx <- trace2$link$target[d$pointNumber+1]
Target <- trace2$node$label[tIdx+1]
diamonds %>% filter(cut == Source & color == Target)
})
}
shinyApp(ui, server)

Shiny Gvis Output is opening in browser and not within the app

I am trying to get my shinydashboard to plot a sankey chart within a box but when I run it it opens in another tab on my browser. Can I htmlOutput to have the sankey plot open in the box in the app? I tried changing it to DataTable and it works perfect, but with a sankey renderGvis and htmlOutput it doesn't seem to work.
Here's snipits on my code...
UI
tabItem("PatronTransactionFlow",
box(title = "Controls",
width = 12,
status = "success",
solidHeader = TRUE,
uiOutput("PurchaseColumnSankeyChoice"),
uiOutput("SankeyPurchaseFilterNum")),
box(title = paste0(eventname, " Patron Transaction Flow"),
width = 12,
status = "success",
solidHeader = TRUE,
htmlOutput("SankeyPurchasePlot")
)
)
Server
SankeyPurchaseData <- reactive({
sankey <- OverviewPurchaseData %>%
select(Time.y, Tag, Point) %>%
group_by(Time.y, Tag) %>%
arrange(Time.y) %>%
unique() %>%
group_by(Tag) %>%
mutate(n.order = paste('Transaction', c(1:n()), sep='')) %>%
dcast(Tag ~ n.order, value.var='Point', fun.aggregate = NULL)
sankey
})
output$PurchaseColumnSankeyChoice <- renderUI({
sankey <- SankeyPurchaseData()
colchoice <- mixedsort(colnames(sankey)[2:ncol(sankey)])
selectInput("PurchaseColumnSankeyChoice", "Choose Transactions to View",
choices = mixedsort(colnames(sankey)[2:ncol(sankey)]),
selected = mixedsort(colnames(sankey)[2:ncol(sankey)])[1:3],
selectize = TRUE,
multiple = TRUE)
})
SankeyPurchasePlotData <- reactive({
sankey <- SankeyPurchaseData()
sankeyplot <- sankey %>%
select_(.dots = input$PurchaseColumnSankeyChoice)
orders.plot <- data.frame()
for (i in 2:ncol(sankeyplot)) {
ord.cache <- sankeyplot %>%
group_by(sankeyplot[ , i-1], sankeyplot[ , i]) %>%
na.omit()%>%
summarise(n=n())
colnames(ord.cache)[1:2] <- c('from', 'to')
# adding tags to carts
ord.cache$from <- paste(ord.cache$from, '(', i-1, ')', sep='')
ord.cache$to <- paste(ord.cache$to, '(', i, ')', sep='')
orders.plot <- rbind(orders.plot, ord.cache)
}
orders.plot
})
output$SankeyPurchaseFilterNum <- renderUI({
data <- SankeyPurchasePlotData()
max1 <- max(data$n)
sliderInput("SankeyPurchaseFilterNum", "Choose Sequence Number to filter by:",
min = 1, max = max1, value = round(max1*0.7, digits = 0))
})
output$SankeyPurchasePlot <- renderGvis({
orders.plot <- SankeyPurchasePlotData()
orders.plot2 <- orders.plot[which(orders.plot$n >= as.numeric(input$SankeyPurchaseFilterNum)),]
plot <- plot(gvisSankey(orders.plot2, from='from', to='to', weight='n'))
plot
})

navbarPage shiny with two datasets and identical set of widgets - both ways dependence

I try to create a simple shiny app. What we have here is app with two tabPanel modules, each refers to different dataset. Actually both datasets have the same structure (i.e. name of column, name of factors within columns), only difference is column value and number of instances in those columns. I would like to create the same layout of each tabPanel. I try to depend widget in Module 1 on widget in Module 2. For example, if I choose product P2 in Module 1 and then change tabPanel into Module 2, widget automatically change value into P2. The main goal is to create mechanism which allow me to change the value of both widgets in both ways. For example, after I go to the Module 2 with value P2 and then I change it into P3 and come back to Module 1 I want to see P3 as well.
ui.R
library(ggvis)
library(shiny)
shinyUI(
navbarPage(title = '',
tabPanel("Module 1",
fluidRow(
selectInput('prod1','', prod),
ggvisOutput('ggvis_plot1')
)
),
tabPanel("Module 2",
fluidRow(
uiOutput('in_prod2'),
ggvisOutput('ggvis_plot2')
))
)
)
server.R
library(shiny)
library(ggvis)
library(dplyr)
shinyServer(function(input, output) {
# renderUI part
output$in_prod2 <- renderUI({
selectInput('prod2','',
choices = prod, selected = input$prod1)
})
# Code for data module1
data_mod1_0 <- reactive({
df <- module1_df
df <- df %>%
filter(prod == input$prod1)
})
ggvis_plot1 <- reactive({
plot <- data_mod1_0() %>%
ggvis(~id, ~value) %>%
layer_points(fill = ~part)
})
ggvis_plot1 %>% bind_shiny('ggvis_plot1')
# Code for data module2
data_mod2_0 <- reactive({
if (is.null(input$prod2))
df <- module2_df
else {
df <- module2_df
df <- df %>%
filter(prod == input$prod2)
}
})
ggvis_plot2 <- reactive({
plot1 <- data_mod2_0() %>%
ggvis(~id, ~value) %>%
layer_points(fill = ~part)
})
ggvis_plot2 %>% bind_shiny('ggvis_plot2')
})
global.R
library(dplyr)
prod <- c('P1','P2','P3')
level <- c('L1','L2','L3')
part <- c('p1','p2','p3','p4','p5')
axis_x <- list(L1 = list('Ordering' = 'id'),
L2 = list('Ordering' = 'id', 'Part name' = 'part'),
L3 = list('Ordering' = 'id', 'Part name' = 'part'))
# Data for module 1
set.seed(123)
module1_df <- data.frame(prod = sample(prod,300, replace = T),
level = sample(level, 300, replace = T),
part = sample(part, 300, replace = T),
value = rnorm(300))
module1_df <- module1_df %>%
group_by(prod) %>%
mutate(id = 1:n()) %>%
arrange(prod, id)
# Data for module 2
set.seed(321)
module2_df <- data.frame(prod = sample(prod,300, replace = T),
level = sample(level, 300, replace = T),
part = sample(part, 300, replace = T),
value = rnorm(300))
module2_df <- module2_df %>%
group_by(prod) %>%
mutate(id = 1:n()) %>%
arrange(prod, id)
Here is a very simple example of this. Basically you use observeEvent to determine when a selectInput has changed, and then use updateSelectnput to update the other select.
library(shiny)
ui <-navbarPage(title = '',
tabPanel("Module 1",
fluidRow(
selectInput('sel1','Select 1', choices=c("A","B","C")),
textOutput('select1')
)
),
tabPanel("Module 2",
fluidRow(
selectInput('sel2','Select 2', choices=c("A","B","C")),
textOutput('select2')
))
)
server <- function(input, output, session) {
output$select1<-renderText(input$sel1)
output$select2<-renderText(input$sel2)
observeEvent(input$sel1, updateSelectInput(session,input='sel2',selected=input$sel1))
observeEvent(input$sel2, updateSelectInput(session,input='sel1',selected=input$sel2))
}
shinyApp(ui = ui, server = server)

ShinyApp errors: selectInput, data-subsetting

I am creating shiny app. My goal is to visualize some data slices depending on the input.I am quite happy with the result.
However, my app has a few bugs while the app is loading. Before ploting the graph and visualizing inputs it shows some errors on screen (you can lauch the app and see the problem).
I believe, the first problem is with data filtering. I can't figure out how to deal with it and what is the problem. May I need to use other method or maybe other package? (see the output$Brand).
Error in grep(pattern, levels(vector)) : invalid 'pattern' argument
The second error comes when I am creating selectInput. I'd like to visualize all the brands of the specific category in one plot and to have an option to filter data by brand. However, my method is not working well. Any suggestions? (see the output$Brand).
Error in if (input$Brand == "All") { : argument is of length zero
Also, I enclose the code, which you can generate.
May you have any more suggestions how to simplify the code?
Thanks for the help!
library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
library(grid)
library(scales)
library(ggthemes)
# Header -----------------------------------------------------------
header <- dashboardHeader(title="Dashboard")
# Sidebar --------------------------------------------------------------
sm <- sidebarMenu(
menuItem(
text="Graph1",
tabName="Graph1",
icon=icon("home")
)
)
sidebar <- dashboardSidebar(sm)
# Body --------------------------------------------------
body <- dashboardBody(
# Layout --------------------------------------------
tabItems(
tabItem(
tabName="Graph1",
fluidPage(
fluidRow(
box(
title = "Inputs", status = "warning", width = 2, solidHeader = TRUE,
uiOutput("Year"),
uiOutput("Category"),
uiOutput("Brand"),
sliderInput("Finalas.Range", "Months:",
min = 1, max = 12, value = c(1,12))
),
box(
title = "Season", width = 10, status = "info", solidHeader = TRUE,
plotOutput("Graph1")
)
)
)
)
)
)
# Setup Shiny app UI components -------------------------------------------
ui <- dashboardPage(header, sidebar, body, skin="black")
# Setup Shiny app back-end components -------------------------------------
server <- function(input, output) {
# Generate data --------------------------------------
set.seed(1992)
n=99
Year <- sample(2013:2015, n, replace = TRUE, prob = NULL)
Month <- sample(1:12, 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(Year, Month, Category, Brand, USD)
# Inputs --------------------------------------
output$Year <- renderUI({
selectInput("Year",
"Year:",
c(unique(as.character(df$Year))), selected = "2015")
})
output$Category <- renderUI({
selectInput("Category", "Choose category:",
choices = c("Car","Bus", "Bike" ))
})
output$Brand <- renderUI({
df2 <- (data.table(df))[like(df$Category,input$Category)]
selectInput("Brand",
"Brand:",
c("All", unique(as.character(df2$Brand))))
})
# Plot --------------------------------
output$Graph1 <- renderPlot({
df <- data.table(df)
if (input$Brand == "All") {
df <- df[like(df$Year, input$Year)]
df <- df[like(df$Category,input$Category)]
ggplot(df, aes(x=factor(Month,levels=1:12), y=USD, fill=Brand))+
geom_bar(stat='identity')+
scale_x_discrete('Month', breaks=factor(1:12), drop=FALSE)+
scale_fill_gdocs(guide = guide_legend(title = "Brand"))
} else {
df <- df[like(df$Year, input$Year)]
df <- df[like(df$Category,input$Category)]
df <- df[which(df$Brand == input$Brand),]
validate(
need(sum(df$USD)>0, paste(input$Brand, "was inactive in Year:",input$Year))
)
ggplot(df, aes(x=factor(Month,levels=1:12), y=USD, fill=Brand))+
geom_bar(stat='identity')+
scale_x_discrete('Month', breaks=factor(1:12), drop=FALSE)
}
})
# -----------------------------------------------------------------------------
}
# Render Shiny app --------------------------------------------------------
shinyApp(ui, server)
The following should eliminate these errors: for #1 the function like in datatable gives out the error so I changed it to %in% instead. and for #2 you have a null as a default so take care of that with an if statement
rm(list = ls())
library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
library(grid)
library(scales)
library(ggthemes)
# Header -----------------------------------------------------------
header <- dashboardHeader(title="Dashboard")
# Sidebar --------------------------------------------------------------
sm <- sidebarMenu(
menuItem(
text="Graph1",
tabName="Graph1",
icon=icon("home")
)
)
sidebar <- dashboardSidebar(sm)
# Body --------------------------------------------------
body <- dashboardBody(
# Layout --------------------------------------------
tabItems(
tabItem(
tabName="Graph1",
fluidPage(
fluidRow(
box(
title = "Inputs", status = "warning", width = 2, solidHeader = TRUE,
uiOutput("Year"),
uiOutput("Category"),
uiOutput("Brand"),
sliderInput("Finalas.Range", "Months:",
min = 1, max = 12, value = c(1,12))
),
box(
title = "Season", width = 10, status = "info", solidHeader = TRUE,
plotOutput("Graph1")
)
)
)
)
)
)
# Setup Shiny app UI components -------------------------------------------
ui <- dashboardPage(header, sidebar, body, skin="black")
# Setup Shiny app back-end components -------------------------------------
server <- function(input, output) {
# Generate data --------------------------------------
set.seed(1992)
n=99
Year <- sample(2013:2015, n, replace = TRUE, prob = NULL)
Month <- sample(1:12, 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(Year, Month, Category, Brand, USD)
# Inputs --------------------------------------
output$Year <- renderUI({
selectInput("Year",
"Year:",
c(unique(as.character(df$Year))), selected = "2015")
})
output$Category <- renderUI({
selectInput("Category", "Choose category:",
choices = c("Car","Bus", "Bike" ))
})
output$Brand <- renderUI({
# first error
#df2 <- (data.table(df))[like(df$Category,input$Category)]
df2 <- df[df$Category %in% input$Category,]
selectInput("Brand",
"Brand:",
c("All", unique(as.character(df2$Brand))))
})
# Plot --------------------------------
output$Graph1 <- renderPlot({
df <- data.table(df)
if(is.null(input$Brand) || is.na(input$Brand)){return()}
else if (input$Brand == "All") {
df <- df[like(df$Year, input$Year)]
df <- df[like(df$Category,input$Category)]
ggplot(df, aes(x=factor(Month,levels=1:12), y=USD, fill=Brand))+
geom_bar(stat='identity')+
scale_x_discrete('Month', breaks=factor(1:12), drop=FALSE)+
scale_fill_gdocs(guide = guide_legend(title = "Brand"))
} else {
df <- df[like(df$Year, input$Year)]
df <- df[like(df$Category,input$Category)]
df <- df[which(df$Brand == input$Brand),]
validate(
need(sum(df$USD)>0, paste(input$Brand, "was inactive in Year:",input$Year))
)
ggplot(df, aes(x=factor(Month,levels=1:12), y=USD, fill=Brand))+
geom_bar(stat='identity')+
scale_x_discrete('Month', breaks=factor(1:12), drop=FALSE)
}
})
# -----------------------------------------------------------------------------
}
# Render Shiny app --------------------------------------------------------
shinyApp(ui, server)

Resources