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
})
Related
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:
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)
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
I want to produce an application using R's shiny package. I would like to upload ggplots from another project and add some interactive content.
When I add a data point using geom_point() to a ggplot that was created in the same R code this works fine. However, when I save and re-read the ggplot again (*), an error occurs. I could still add the geom_point (**), but it does not accept the interactive content from input$slider.
ui.R
library(shiny)
shinyUI(
fluidPage(
# Title
titlePanel(""),
# sidebar
sidebarLayout(
sidebarPanel("",
sliderInput("slider", "slider",
min = 100, max = 500, value = 300, step = 10)
),
# Main
mainPanel("",
plotOutput("ggplt")
)
)
)
)
server.R
library(shiny)
shinyServer(
function(input, output){
# produce a plot
output$ggplt <- renderPlot({
# ggplot scatterplot
library(ggplot2)
gg <- ggplot(data = mtcars, aes(x = disp, y = mpg)) +
geom_point()
# (*) save ggplot
#saveRDS(gg, "plt.rds")
#rm(gg)
#gg <- readRDS("plt.rds")
# x-coordinate for geom_point
xc <- as.numeric(input$slider)
gg + geom_point(aes(x = xc, y = 20), size = 5, colour = "red")
## (**) alternative
#gg + geom_point(aes(x = 400, y = 20), size = 5, colour = "red")
})
}
)
I don't really know what is going on here, and I think it is probably some subtle interaction between the ggplot2 environment handling and the shiny reactive environment handling. It might be worth flagging as a bug.
However there are a number of ways to make it work with small changes. I think the best is to use a reactive function for the slider value, although just assigning xc with the frowned upon <<- also seems to work and is a smaller change.
You could also just use input$slider directly in the aes(..) function as that seems to work too, but using a reactive function feels cleaner.
So this is what I suggest as a workaround:
library(shiny)
library(ggplot2)
u <- shinyUI(
fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel("", sliderInput("slider", "slider",
min = 100, max = 500, value = 300, step = 10)
),
mainPanel("", plotOutput("ggplt")
)
)))
s <- shinyServer( function(input, output){
sliderval <- reactive({input$slider})
output$ggplt <- renderPlot({
req(input$slider)
gg <- ggplot(data = mtcars) +
geom_point(aes(x = disp, y = mpg))
# (*) save ggplot
saveRDS(gg, "plt.rds")
rm(gg)
gg <- readRDS("plt.rds")
gg + geom_point(aes(x = sliderval(), y = 20), size = 5, colour = "red")
})
})
shinyApp(u,s)
yielding:
I have a situation in which I would like to have multiple ggplot graphics in a Shiny app. Typically this is addressed via the facet techniques. However, in my case some of my x values are categorical and others are continuous. To try to address this issue, I have use the gridExtra package to combine the multiple plots into a single plot using the arrangeGrob and grid.arrange function. When I use the click action on the plot, the returned coordinates do not correspond to the points in the plot. The following is a self-contained example:
library(shiny)
library(miniUI)
library(ggplot2)
library(gridExtra)
test_addin <- function() {
ui <- miniPage(
miniTitleBar(title = 'Example', right = miniTitleBarButton("done", "Done", primary = TRUE)),
miniContentPanel(plotOutput('plot', height = '100%', click = 'plot_click'))
)
server <- function(input, output, session) {
observeEvent(input$plot_click, {
tmp = isolate(input$plot_click)
cat(sprintf('Location was: %0.2f, %0.2f\n', tmp$x, tmp$y))
})
plot_reactive = reactive({
contdata = data.frame(x = 1:10, y = runif(10), term = as.factor('one'))
discdata = data.frame(x = as.factor(rep(c('A', 'B'), each = 5)), y = runif(10), term = as.factor('two'))
contplot = ggplot(contdata) + theme_bw() +
geom_line(aes(x = x, y = y)) +
labs(x = '', y = '')
discplot = ggplot(discdata) + theme_bw() +
geom_point(aes(x = x, y = y)) +
labs(x = '', y = '')
p1 = ggplot_gtable(ggplot_build(contplot))
p2 = ggplot_gtable(ggplot_build(discplot))
grid.arrange(arrangeGrob(p1, p2, layout_matrix = matrix(c(1, 2), ncol = 2, byrow = TRUE)))
})
observe({
output$plot <- renderPlot({
plot_reactive()
})
})
observeEvent(input$done, {
stopApp()
})
}
viewer <- paneViewer(300)
runGadget(ui, server, viewer = viewer)
}
test_addin()
Can somebody point me in the right direction to make this function as intended? I have spent far too long on this (read as browsing ggplot and shiny source code) to not ask the question. Thanks for any help.