Remove an aesthetic from a legend ggplotly R Shiny - r

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:

Related

Why does my plot look different in Shiny compared to ggplot and also different when combos are selecteD?

This is the snippet of the ui portion of this plot:
tabPanel("Total Weight",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("workout_name", "Workout:",
c("Legs" = "Legs",
"Push" = "Push",
"Pull" = "Pull"))
),
mainPanel(
plotOutput("total_weight", width = "100%"),
)
)
)
And this is the code for the plot from the server:
output$total_weight <- renderPlot({
ggplot(df3[df3$workout_name == input$workout_name,],
aes(x = datetime, y = total_weight)) +
geom_point(aes(group = workout_name, colour = workout_name)) +
geom_smooth(aes(group = workout_name, colour = workout_name), se = FALSE) +
theme_bw() +
labs(x = "Date",
y = "Weight (lbs)",
title = "Total Weight Lifted in Workout Sessions",
colour = "Workout") +
theme(plot.caption = element_text(hjust = 0, face = "bold"))
})
The plot should look like this when all options are selected:
However it instead looks like this in Shiny:
As you can see, the values are wrong in the Shiny app. I want to be able to select which ones can be shown. Any advice is appreciated.
You filter your data frame based on an equals condition.
df3[df3$workout_name == input$workout_name,]
But the value of input$workout_name is a character vector so if you want all rows of the df3 data frame where the workout name is one of the selected inputs then you should use %in% instead.
df3[df3$workout_name %in% input$workout_name, ]

SelectInput to change multiple elements in Shiny

Is there a way to have a selectInput change two elements of a plot? For example below, I created a reactive block to manipulate the data I want to plot in geom_point for each selectInput choice and it works perfectly. However, I also want the color of the points to change, a different color for each choice that is automatic, the user need not choose one themselves. So for one input$case points I want what is written in geom_point "orangered2". But if they choose the other input$case option, I would like the points in geom_point to be "gold".
Maybe an if statement but I am not sure where to nest that if so.
I posted a snippet of my UI and server bits.
UI snippet from a tab
tabPanel("Analysis",
sidebarLayout(
sidebarPanel(width = 4,
selectInput(inputId = "case",
label="Locations",
choices = c("TRUE", "FALSE")))
Server snippet
server <- function(input, output){
data_use <- reactive({
real_final[real_final$case %in% input$case,]
})
output$bathy <- renderPlot({
autoplot.bathy(shelf, geom=c("raster", "contour")) +
scale_fill_gradientn(name = "meters above\nsea level", colours = c("plum2", "steelblue4","steelblue3", "steelblue2", "steelblue1"),
breaks = c(-6000,0),
limits = c(-6000,0),
labels = c("-6000m","0m"),
na.value = "black") +
geom_point(data = data_use(), aes(long, lat), color = "orangered2", pch = ".") +
xlab("Longitude") +
ylab("Latitude") +
ggtitle("Seal Locations") +
theme(axis.text.x=element_text(size=6),
axis.text.y=element_text(size=6),
axis.title=element_text(size=10,face="bold"))
An option is to return a list with a reactive conductor:
data_and_color <- reactive({
list(
data = real_final[real_final$case %in% input$case,],
color = ifelse(input$case == "TRUE", "gold", "orangered2")
)
})
Then in the renderPlot:
x <- data_and_color()
ggplot(data = x$data, ......)
color = x$color

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
})

Select range in interactive shiny plots

I am trying to create an interactive visualisation of data in shiny. The visualisation shows the distribution (or histogramm) of parts of a series. For example, the following code creates a series and two selections (two is fixed) of parts of the series, which is then displayed using ggplot:
library(ggplot2)
set.seed(123)
dat <- data.frame(x = 1:1000,
y = cumsum(rnorm(1000, mean = 0.1)))
sel1 <- 200:400 # selection 1
sel2 <- 700:900 # Selection 2
# create a plot of the series
ggplot() + geom_line(data = dat, aes(x = x, y = y)) +
geom_rect(aes(xmin = sel1[1], xmax = sel1[length(sel1)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") +
geom_rect(aes(xmin = sel2[1], xmax = sel2[length(sel2)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "blue")
# Histogramm preparation
# create another df that contains the selection of the two selections
pdat <- rbind(data.frame(y = dat[dat$x %in% sel1, 2],
sel = 1),
data.frame(y = dat[dat$x %in% sel2, 2],
sel = 2))
# plot the histograms
ggplot(pdat, aes(x = y, fill = as.factor(sel))) +
geom_histogram(alpha = 0.5, position = "dodge")
which creates:
Now I want the user to be able to move the areas (preferably by dragging the shaded areas in plot 1 around!) using shiny.
I played around with the (new) interactive options of shiny (more info here, look for section "Interactive plots"). I think I can remember that there is an option to specify an area, which the user is able to drag around, but I can't find it anymore.
Any ideas?
As mentioned in the comments do look into rCharts and dygraphs, below is the example taken from tutorials with some modifications. Please note that the dygraphs require a timeseries object to plot, refer to official docs for more information. The summary statistics can be performed by a package of your choice. Also note that the shaded regions are user specified...
rm(list = ls())
library(shiny)
library(dygraphs)
library(xts)
library(rCharts)
index <- as.Date(c(seq(Sys.time(), length.out = 1000, by = "days")))
dat <- data.frame(x = index,y = cumsum(rnorm(1000, mean = 0.1)))
dat <- xts(dat[,-1], order.by=dat[,1])
ui <- fluidPage(
titlePanel("Shaded Regions using dygraphs and rCharts by Pork Chop"),
sidebarLayout(
sidebarPanel(
sliderInput("range_one", "Range One:",min = 100, max = 1000, value = c(200,300)),
sliderInput("range_two", "Range Two:",min = 100, max = 1000, value = c(500,600)),width=3),
mainPanel(
column(12,dygraphOutput("dygraph")),
column(12,showOutput("summary", "Highcharts"))
)
)
)
server <- function(input, output) {
output$dygraph <- renderDygraph({
dygraph(dat, main = "Sample Data") %>%
dyShading(from = index[input$range_one[1]], to = index[input$range_one[2]], color = "#FFE6E6") %>%
dyShading(from = index[input$range_two[1]], to = index[input$range_two[2]], color = "#CCEBD6")
})
output$summary <- renderChart2({
Selection1 <- dat[input$range_one[1]:input$range_one[2]]
Selection2 <- dat[input$range_two[1]:input$range_two[2]]
subset_data <- data.frame(merge(Selection1,Selection2))
a <- rCharts:::Highcharts$new()
a$chart(type = "column")
a$title(text = "Summary Stats")
a$yAxis(title = list(text = "Count"))
a$data(subset_data)
a$exporting(enabled=T)
a$set(width = 1200,height = "100%",slider = TRUE)
return(a)
})
}
shinyApp(ui, server)
I think I found a solution that is able to use interactive ggplot's in a shiny environment. The code looks like this:
library(shiny)
library(ggplot2)
ifna <- function(x, elseval = NA) ifelse(is.na(x) || is.null(x), elseval, x)
# two plots: as described in the question
ui <- fluidPage(
uiOutput("plotui"),
plotOutput("plot2")
)
server = function(input, output) {
set.seed(123)
dat <- data.frame(x = 1:1000,
val = cumsum(rnorm(1000, mean = 0.1)))
base <- 200:400 # Base Selection
# reactive expressions to get the values from the brushed area
selmin <- reactive(round(ifna(input$plot_brush$xmin, elseval = 700), 0))
selmax <- reactive(round(ifna(input$plot_brush$xmax, elseval = 900), 0))
# include the brush option: direction = "x" says that y values are fixed (min and max)
output$plotui <- renderUI({
plotOutput("plot", height = 300,
brush = brushOpts(id = "plot_brush", direction = "x",
fill = "blue", opacity = 0.5)
)
})
# render the first plot including brush
output$plot <- renderPlot({
ggplot() + geom_line(data = dat, aes(x = x, y = val)) +
geom_rect(aes(xmin = base[1], xmax = base[length(base)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") +
geom_rect(aes(xmin = 700, xmax = 900,
ymin = -Inf, ymax = Inf), alpha = 0.1, fill = "blue") +
ylab("Value") + xlab("t")
})
# render the second plot reactive to the brushed area
output$plot2 <- renderPlot({
# prepare the data
pdat <- rbind(data.frame(y = dat[dat$x %in% base, "val"],
type = "Base"),
data.frame(y = dat[dat$x %in% selmin():selmax(), "val"],
type = "Selection"))
ggplot(pdat, aes(x = y, fill = type)) +
geom_histogram(alpha = 0.5, position = "dodge") +
scale_fill_manual(name = "", values = c("red", "blue")) +
theme(legend.position = "bottom") + ylab("Frequency") + xlab("Value")
})
}
# run the app
shinyApp(ui, server)
Which gives something like this (the dark-blue box is interactive, as in you can push it around and the lower graph updates!
Picture of Shiny App

Resources