SelectInput to change multiple elements in Shiny - r

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

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

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:

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