Shiny + ggplot: How to subset reactive data object? - r

I am making a shiny app, that shows the user a ggplot after he selects the daterange he is interested in (= the range for the x-axis). So I guess I need to define a reactive data object (correct?).
The ggplot has some subsetting in it. R tells me that reactive data object is not subsettable. In my rookie understanding of ggplot, the subsetting has to be done inside the geom_bar(), geom_line() statements in order to obtain the graph that I want.
Can anyone suggest me how to proceed with the subsetting?
And how to reference the factor category in generating colors for the graph?
Thanks!
sample data
A = c(3, 4, 3, 5)
B = c(2, 2, 1, 4)
Z = c(1, 2, 1, 2)
R = c(-2, -1, -3, 0)
S = c(7,7,7,9)
mydata = data.frame(cbind(A,B,Z,R,S))
dates = c("2014-01-01","2014-02-01","2014-03-01","2014-04-01")
mydata$date = as.Date(dates)
mydata.m = melt(mydata,id="date")
names(mydata.m) = c("variable", "category","value")
shiny server: select observations as per user input (dateRangeInput)
data.r = reactive({
a = subset(mydata.m, variable %in% input$daterange)
return(a)
})
shiny server: make the plot
output$myplot = renderPlot({
# ggplot with proper reference to reactive function <<data.r()>>
s = ggplot(data.r(), aes(x=variable, fill=category)) +
# bars for categories A, B, Z: needs subsetting the data... but how?
+ geom_bar(data=subset(data.r(), category %in% c("A","B")), aes(y=value), stat="identity", position="stack")
+ geom_bar(subset=.(category=="Z"), aes(y=-value), stat="identity")
# lines for categories R, S: same.
+ geom_line(subset=.(category=="R"), aes(y=value))
+ geom_line(subset=.(category=="S"), aes(y=value))
# how to reference the factor <<category>> in reactive function <<data.r()>>?
+ scale_fill_manual(breaks = levels(category), values = mycolorgenerator(length(levels(category))))
print(s)
})
UI.R
# INPUT PART
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("My App"),
sidebarPanel(
dateRangeInput("daterange", "Date range:",
start = "2014-01-01",
end = "2014-04-01",
min = "2014-01-01",
max = "2014-04-01",
format = "dd/mm/yyyy",
separator = "-"),
submitButton(text="Update!")
),
# -----------------------------------------------
# OUTPUT PART
mainPanel(
tabsetPanel(
tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
)
)
))
SERVER.R
library(reshape)
library(shiny)
library(ggplot2)
# GEN DATA -----------------------------------------------
A = c(3, 4, 3, 5)
B = c(2, 2, 1, 4)
Z = c(1, 2, 1, 2)
R = c(-2, -1, -3, 0)
S = c(7,7,7,9)
mydata = data.frame(cbind(A,B,Z,R,S))
dates = c("2014-01-01","2014-02-01","2014-03-01","2014-04-01")
mydata$date = as.Date(dates)
mydata.m = melt(mydata,id="date")
names(mydata.m) = c("variable", "category","value")
# SERVER -----------------------------------------------
shinyServer(function (input, output) {
# DATA
data.r = reactive({
a = subset(mydata.m, variable %in% input$daterange)
return(a)
})
# GGPLOT
mycolorgenerator = colorRampPalette(c('sienna','light grey'))
output$myplot = renderPlot({
# ggplot with proper reference to reactive function <<data.r()>>
s = ggplot(data.r(), aes(x=variable, fill=category)) +
# bars for categories A, B, Z: needs subsetting the data... but how?
geom_bar(data=subset(data.r(), category %in% c("A","B")), aes(y=value), stat="identity", position="stack") +
geom_bar(subset=.(category=="Z"), aes(y=-value), stat="identity") +
# lines for categories R, S: same.
geom_line(subset=.(category=="R"), aes(y=value)) +
geom_line(subset=.(category=="S"), aes(y=value)) +
# how to reference the factor <<category>> in reactive function <<data.r()>>?
scale_fill_manual(breaks = levels(category), values = mycolorgenerator(length(levels(category))))
print(s)
})
})

(The complete server.R and ui.R really helped)
I'm not sure where you got the .() function from or the idea that geom_bar has a subset= parameter. But here's an updated renderPlot that doesn't seem to generate any errors at least
output$myplot = renderPlot({
dd<-data.r()
# ggplot with proper reference to reactive function <<data.r()>>
s = ggplot(dd, aes(x=variable, fill=category)) +
# bars for categories A, B, Z: needs subsetting the data... but how?
geom_bar(data=subset(dd, category %in% c("A","B")), aes(y=value),
stat="identity", position="stack") +
geom_bar(data=subset(dd, category=="Z"), aes(y=-value), stat="identity") +
# lines for categories R, S: same.
geom_line(data=subset(dd, category=="R"), aes(y=value)) +
geom_line(data=subset(dd, category=="S"), aes(y=value)) +
scale_fill_manual(breaks = levels(dd$category),
values = mycolorgenerator(length(levels(dd$category))))
print(s)
})
Mostly I changed the data= to explicit subset() calls

Related

Remove an aesthetic from a legend ggplotly R Shiny

I have a shiny dashboard with a graph - certain bars on the graph are highlighted based on a corresponding picker input, as you can see in this gif.
I only want the legend to reflect the fill, not the colour. I know how to do this in ggplot, but how can I accomplish this in a ggplotly object?
I've tried setting the guide to False in scale_color_manual, as well as setting guide(color = False), but no luck.
Also, of low priority, if anyone could give me an example of only having the outline around the whole of the stacked bar, not each individual segment, that would be appreciated.
Reproducible example:
library(shiny)
library(shinyWidgets)
library(tidyverse)
library(plotly)
dat <- data.frame(
location = rep(c("Loc1", "Loc2", "Loc3"), each = 3),
category = rep(c("cat1", "cat2", "cat3"), 3),
value = runif(9, 20, 50)
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(
inputId = "selected",
label = "Select a category:",
choices = c("Loc1", "Loc2", "Loc3")
)
),
mainPanel(
plotlyOutput("outputPlot")
)
)
)
server <- function(input, output) {
output$outputPlot <- renderPlotly({
dat_selected <- dat %>%
# Mutate flag based on selected location
mutate(selected = ifelse(location == input$selected, 1, 0)) %>%
ggplot(
aes(
x = value,
y = location,
group = category,
fill = category,
color = as.factor(selected)
)
) + geom_bar(stat = "identity") +
scale_fill_manual(values = c("yellow", "white", "blue")) +
scale_color_manual(values = c("white", "red"), guide = "none") +
guides(color = F)
ggplotly(dat_selected)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Note that logical values to scale arguments in guides are deprecated. In ggplot2 you would use guides(color = "none") instead.
In ggplotly you may select traces shown in the legend using the traces argument in style():
Replace ggplotly(dat_selected) by
p <- ggplotly(dat_selected) %>%
style(showlegend = FALSE, traces = c(2, 4, 6))
p
Changing legend entry labels is not straightforward. You may alter labels by modifying list entries in the generated object p:
p <- ggplotly(dat_selected) %>%
style(showlegend = FALSE, traces = c(2, 4, 6))
p$x$data[[1]]$name <- "cat1"
p$x$data[[3]]$name <- "cat2"
p$x$data[[5]]$name <- "cat3"
p
(Confusingly, indices of the nested lists in p$x$data we need to modify differ from the trace indices above. This is seen from looking at the structure of p at runtime.)
The result looks like this:

Error: Alpha must be 1 or either of length x.(Using renderPlotly in my code)

When I run this code with renderPlotly. It gives me error but without renderplotly it is working fine. Can you help me in fixing this code with renderPlotly? Thanks in advance.
output$tot_finalized_claims1 <- renderPlotly({
req(input$yearSelectInput)
#filter df to be used in graph
claims1 <- newly_formatted_logResults %>% filter(YEAR == input$yearSelectInput) %>% filter(PEND == "CMI") %>% select(YEAR,MONTH_NUM,PEND, TOTAL_FINALIZE,TOTAL)
data_pcode <- summarize(group_by(claims1,MONTH_NUM), actual_auto = round(sum(as.numeric(TOTAL_FINALIZE),na.rm = TRUE)/sum(as.numeric(TOTAL),na.rm = TRUE),digits = 2))
data_pcode <- data.frame(data_pcode)
ggplot(data = data_pcode,aes(x = MONTH_NUM, y = actual_auto )) +
geom_point() + geom_line() + # add the points and lines
stat_QC(method = "XmR" # specify QC charting method
auto.label = T, # Use Autolabels
label.digits = 2, # Use two digit in the label
show.1n2.sigma = T # Show 1 and two sigma lines
)+
labs(x = "Months",y = "Automation Rate",title = paste("Actual automations by CMI Pend code"))+
geom_text(aes(label=paste(actual_auto ,"%")), position=position_dodge(width=0.95), vjust=-0.5)+
scale_x_continuous(breaks = 1:12,labels = c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"))+
scale_y_continuous(breaks = seq(0.0, 1.0, 0.1))
}) #end tot finalized plot summary
Apart from the fact that you didn't even use the plotly function to create the plot, if you want to generate plotly output you must remember two things:
In server section renderPlotly instead of renderPlot
In UI section plotlyOutput instead of plotOutput
You can try this code to see how it works:
library(shiny)
library(ggplot2)
library(ggthemes)
library(plotly)
ui <- fluidPage(
titlePanel("Plotly"),
sidebarLayout(
sidebarPanel(),
mainPanel(
plotlyOutput("plot2"))
))
server <- function(input, output) {
output$plot2 <- renderPlotly({
ggplotly(
ggplot(data = mtcars, aes(x = disp, y = cyl)) +
geom_smooth(method = lm, formula = y~x) +
geom_point() +
theme_gdocs())
})
}
shinyApp(ui, server)

Manually adding colours to shiny/ggplot plot

I'm attempting to create a shiny app where the user can choose which of three columns to plot over time, consisting of the percentages of three candidates. So far the actual plot works perfectly, but I would like to add colours such that Cand_1 gets a blue line, Cand_2 a green, and Cand_3 a red one. I've attempted to use Plot + scale_colour_manuall = "c("Cand_1" = "blue", "Cand_2" = "green", "Cand_3" = "red) with and without "" around the variable names, and also if within the aes() such that:
Plot <- Plot + geom_line(aes(month, !! sym(input$cand)), group = 1, if(input$cand == "Cand_1){
colour = "blue"}
if(input$cand == "Cand_2"){colour = "green"}
if(input$cand == "Cand_2"){colour = "red})
But none of them works, either giving the error Attempted to create layer with no stat, or simply ignoring the argumens.
The whole code looks like this:
library(shiny)
library(tidyverse)
setwd("")
Data <- read.csv("Data.csv", stringsAsFactors = F)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Candidates"),
# Sidebar with a select input
sidebarLayout(
sidebarPanel(
selectInput("Cand",
"Candidates",
choices = colnames(Data)[2:4], multiple = TRUE)
),
mainPanel(
plotOutput("LederPlott"),
textOutput("length")
)
)
)
# Define server logic required to draw plot
server <- function(input, output) {
output$CandPlott <- renderPlot({
Plot <- ggplot(Data)
if(length(input$Cand) == 1){
Plot <- Plot + geom_line(aes(month, !! sym(input$Cand)), group = 1)
}
if(length(input$Cand) == 2){
Plot <- Plot + geom_line(aes(month, !! syms(input$Cand)[[1]]), group = 1)+
geom_line(aes(month, !! syms(input$Cand)[[2]]), group = 1)
}
if(length(input$Cand) == 3){
Plot <- Plot + geom_line(aes(month, !! syms(input$Cand)[[1]]), group = 1)
Plot <- Plot + geom_line(aes(month, !! syms(input$Cand)[[2]]), group = 1)
Plot <- Plot + geom_line(aes(month, !! syms(input$Cand)[[3]]), group = 1)
}
Plot <- Plot + theme_classic() + ylab("%") + ggtitle("%God")
Plot
})
output$length <- renderText(input$Cand)
}
# Run the application
shinyApp(ui = ui, server = server)
And here is some sample data:
Month Cand_1 Cand_2 Cand_3
2019-02-01 60,7 90,1 86,2
2019-03-01 58,9 90,2 80,3
2019-04-01 47,3 88,3 84,6
2019-05-01 54,5 87,3 90
2019-06-01 50,6 86 89
2019-07-01 49,8 84,2 87,1
You cannot assign colour like this,
Plot <- Plot + geom_line(aes(month, !! sym(input$cand)), group = 1, if(input$cand == "Cand_1){
colour = "blue"}
if(input$cand == "Cand_2"){colour = "green"}
if(input$cand == "Cand_2"){colour = "red})
Because colour is a parameter of the aes(). It must appear at top level, like this:
Plot <- Plot + geom_line(aes(month, !! sym(input$cand)), group = 1, colour = <your decision here>)
But also, this parameter serves another purpose. It serves to colour different groups with different colours. What you want is one variable per time. So it won't work either, for this kind of purpose.
What you need is to place the color= parameter in the geom_line() call, but outside the aes():
Plot <- Plot + geom_line(aes(month, !! sym(input$cand)), group = 1),
colour = if(input$cand == "Cand_1") "blue" else
if(input$cand == "Cand_2")"green" else
if(input$cand == "Cand_3") "red")
There are shorter ways of doing it, also:
color.list <- list(Cand_1 = "blue", Cand_2 = "green", Cand_3 = "red")
Plot <- Plot + geom_line(aes(month, !! sym(input$cand)), group = 1),
colour = color.list[[input$cand]])

Shiny creating a reactive legend

I am following a solution given in R shiny Aesthetics must be either length 1 or the same as the data (8): y for that annoying problem which I have happily fixed.
The next issue I want to solve is that I want my plot to have a reactive legend - I only want the legend to display what's actually chosen and on the plot
I also want to set the colours of the lines to the ones I want. And finally I want to make sure the legend is always in the order that I specify
Here is a reproducible example (the commented out code is my attempt at solving my own issues.
As you can see, the commented out section is how I've tried to get the legend and colours I want:
library(shiny)
library(tidyverse)
library(reshape2)
library(scales)
time <- seq(-9, 60, 1)
var1 <- rnorm(70, 35, 2)
var2 <- rnorm(70, 50, 2)
var3 <- rnorm(70, 24, 2)
var4 <- rnorm(70, 17, 2)
data <- data.frame(time = time,
var1 = var1,
var2 = var2,
var3 = var3,
var4 = var4)
datamelt <- melt(data, "time")
p <- ggplot(datamelt, aes(x = time, y = value, color = variable)) +
# scale_color_manual(values = c(
# 'first' = 'red',
# 'second' = 'blue',
# 'third' = 'green',
# 'fourth' = 'orange'
# ),
# breaks = c("first", "second", "third", "fourth")) +
# labs(color = 'Legend') +
theme_classic() +
theme(axis.ticks = element_blank()) +
labs(title = 'it means nothing',
subtitle = 'these are made up data') +
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)) +
scale_x_continuous(name ="a y variable", breaks = seq(-9, 60, 1)) +
scale_y_continuous(name = "yep an x variable",
breaks = seq(0, 60, 5), labels = comma) + geom_blank()
ui <- fluidPage(
titlePanel("trying to make this work"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("whichone", "Choose something:",
choiceNames = c("first",
"second",
"third",
"fourth"),
choiceValues = c("var1",
"var2",
"var3",
"var4"))
),
###the plot
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
data_filtered <- datamelt %>% filter(variable %in% input$whichone)
p + geom_line(data = data_filtered)
})
}
shinyApp(ui, server)
The problem occurs because ggplot uses all the factor levels, which stay in place when you filter. So you need to drop these levels first.
Secondly, you are generating the plot statically with all the levels. So you need to update the data in teh plto as well to let ggplot know which levels to show in the legend. Putting that together you can use the following:
server <- function(input, output) {
output$plot <- renderPlot({
## 1. drop unused levels from teh filtered database
data_filtered <- datamelt %>% filter(variable %in% input$whichone) %>%
droplevels()
## 2. tell ggplot to update the data
p %+% data_filtered + geom_line()
})
}
Note. This approach has the nasty (?) side effect, that if you do not select any data to show you see only an empty canvas. This can be also remedied, but would require some change in your code logic (basically moving the construction of the ggplot inside the renderPlot)
Screenshots

Problem passing variable names via selectInput() in R/Shiny

I'm building a shinyapp where I am passing variable names as arguments to the server with the selectInput() widget. The following static example illustrates the plot that I want displayed:
g <- ggplot(d, aes(y, fill = var1, colour = var1)) +
geom_density(alpha=.2)
Just to be clear, here is an image of the above plot
What I want to do in my shinyapp is to separate the plotted distributions by different variables that the user can choose via selectInput(). But when I substitute var1 in the above with a generic argument, this is not what I get. Please see the example:
library(ggplot2)
library(shiny)
d <- data.frame(var1=as.factor(sample(x = 1:4, size = 250, replace = TRUE)),
var2=as.factor(sample(x = 1:4, size = 250, replace = TRUE)),
y=rnorm(250, mean = 0, sd = 1))
nms <- names(d)
ui <- fluidPage(selectInput(inputId ="var", "Variable:",
choices = nms, selected = "var1"),
plotOutput(outputId = "plot")
)
server <- function(input, output) {
g <- ggplot(d, aes(y, fill = input$var, colour = input$var)) +
geom_density(alpha=.2)
output$plot <- renderPlot(g)
}
shinyApp(ui,server)
The actual output I get is
different from the static example I started with (click through for image).
Can someone please point out my error? Thankful for help.
input$var is a string. Therefore, do
output$plot <- renderPlot({
g <- ggplot(d, aes_string("y", fill = input$var, colour = input$var)) +
geom_density(alpha=.2)
g
})

Resources