boxplot annotation to outliers using r plotly - r

Using the iris dataset below how do I get the ID of the flower on hover of the outliers
library(plotly)?
I've tried something like:
iris_ids <- iris %>%
mutate(id = rownames(iris))
plot_ly(iris, y = ~Sepal.Length, x= ~Species, type = 'box') %>%
layout(title = 'Box Plot',
xaxis = list(title = "cond", showgrid = F),
yaxis = list(title = "rating"),
annotations = list(
x = boxplot.stats(Species)$out,
# use boxplot.stats() to get the outlier's y coordinate
y = boxplot.stats(Sepal.Length)$out,
# I want the ID of the flower
# of the outliers
text = c("ID:", id),
showarrow = FALSE,
xanchor = "right"
)
) %>%
config(displayModeBar = FALSE)
And also tried using the ggplotly wrapper:
ggplotly(
ggplot(iris_id, aes(x = Species, y = Sepal.Length)) +
geom_boxplot()
) %>%
#....what goes here....
I prefer the second way because I'm more comfortable with theming in ggplot2 but I'm open to any and all suggestions!! Thank you.

Try this approach, for sure you can customize further:
library(ggplot2)
library(plotly)
library(dplyr)
#Data
iris_ids <- iris %>%
mutate(id = rownames(iris))
#Plot
gg <- ggplotly(
ggplot(iris_ids, aes(x = Species, y = Sepal.Length)) +
geom_boxplot()
)
hoverinfo <- with(iris_ids, paste0("id: ", id, "</br></br>",
"Sepal.Length: ", Sepal.Length, "</br>"))
gg$x$data[[1]]$text <- hoverinfo
gg$x$data[[1]]$hoverinfo <- c("text", "boxes")
gg
Output:

Related

R plotly histogram hover text

This is my code. Just a simple historgram. But what I wanted to do is to customize the hover text so that when I hover, it will display all species included in that histogram bar. Can you help me?
iris %>%
plot_ly(x=~Sepal.Length, color=~Sepal.Width, text=~Species) %>%
add_histogram()
Here's the output. But when I hover it seems the text is only displaying the first species in the table.
plotly_hist
I'm not sure whether this is possible. Probably you are demanding too much from plotly. After trying some options I think there are two ways to go if you want the different Species to show up in the tooltip:
First option is to use a stacked histogram using hovermode = "unified" like so:
library(plotly)
fig <- plot_ly()
fig <- fig %>% add_trace(data = filter(iris, Species == "setosa"),
x = ~Sepal.Length,
color = ~Species,
text = ~Species,
type='histogram',
bingroup=1, showlegend = FALSE)
fig <- fig %>% add_trace(data = filter(iris, Species == "versicolor"),
x = ~Sepal.Length,
color = ~Species,
text = ~Species,
type='histogram',
bingroup=1, showlegend = FALSE)
fig <- fig %>% add_trace(data = filter(iris, Species == "virginica"),
x = ~Sepal.Length,
color = ~Species,
text = ~Species,
type='histogram',
bingroup=1, showlegend = FALSE)
fig <- fig %>% layout(
hovermode="unified",
barmode="stack",
bargap=0.1)
fig
The second option would be to make the computations yourself, i.e. binning and summarising and to make a bar chart of the counts.
iris %>%
mutate(Sepal.Length.Cut = cut(Sepal.Length, breaks = seq(4, 8, .5), right = FALSE)) %>%
group_by(Sepal.Length.Cut, Species) %>%
summarise(n = n(), Sepal.Width = sum(Sepal.Width)) %>%
tidyr::unite("text", Species, n, sep = ": ", remove = FALSE) %>%
summarise(n = sum(n), Sepal.Width = sum(Sepal.Width) / n, text = paste(unique(text), collapse = "\n")) %>%
plot_ly(x = ~Sepal.Length.Cut, y = ~n, text = ~text) %>%
add_bars(marker = list(colorscale = "Rainbow"), hovertemplate = "%{y}<br>%{text}")
Edit A third option would be to use ggplotly(). This way it is an easy task to add annotations displayling the total numbers per bin. This way we can make use of the stats layers in ggplot2 which will do all the computations. To the best of my knowledge that couldn't be done that easily using "pure" plotly.
library(plotly)
ggplot(iris, aes(Sepal.Length, fill = Species)) +
stat_bin(breaks = seq(4, 8, .5), closed = "left") +
stat_bin(breaks = seq(4, 8, .5), closed = "left", geom = "text", mapping = aes(Sepal.Length, label = ..count..), inherit.aes = FALSE, vjust = -.5) +
theme_light()
ggplotly()

How do I split grouped bar chart in R by variable

I am trying to split the attached grouped bar chart by the variable spec. Two thoughts on best way to do this are by adding facet_grid() or if a filter can be applied to the static output? Can either be done? Any advice appreciated.
a sample is below:
period <- c('201901', '201901', '201904', '201905')
spec <- c('alpha', 'bravo','bravo', 'charlie')
c <- c(5,6,3,8)
e <- c(1,2,4,5)
df <- data.frame(period, spec, c,e)
library(tidyverse)
library(plotly)
plot_ly(df, x =~period, y = ~c, type = 'bar', name = "C 1", marker = list(color = 'lightsteelblue3'))
%>%
add_trace(y = ~e, name = "E 1", marker = list(color = 'Gray')) %>%
layout(xaxis = list(title="", tickangle = -45),
yaxis = list(title=""),
margin= list(b=100),
barmode = 'group'
)
I am not sure if you are plotting what you actually want to achieve? My suggestion is to create your plot using standard ggplot and then use ggplotly.
For this, you also need to reshape your data and make it a bit longer.
library(tidyverse)
library(plotly)
period <- c('201901', '201901', '201904', '201905')
spec <- c('alpha', 'bravo','bravo', 'charlie')
c <- c(5,6,3,8)
e <- c(1,2,4,5)
df <- data.frame(period, spec, c,e) %>%
pivot_longer(cols = c(c,e), names_to = 'var', values_to = 'val')
p <- ggplot(df, aes(period, val, fill = var)) +
geom_col(position = position_dodge()) +
facet_grid(~spec)
ggplotly(p)
It's probably easier to use facets here, but a more "interactive" option would be to use a filter transforms which gives you a drop-down menu in the top left corner of your plot.
spec.val <- unique(df$spec)
plot_ly(
df %>% pivot_longer(-c(period, spec)),
x = ~period, y = ~value, color = ~name,
type = "bar",
transforms = list(
list(
type = "filter",
target = ~spec,
operation = "=",
value = spec.val[1]))) %>%
layout(
updatemenus = list(
list(
type = "drowdown",
active = 0,
buttons = map(spec.val, ~list(
method = "restyle",
args = list("transforms[0].value", .x),
label = .x)))))

How to remove duplicate legend entries w/ plotly subplots()

How can I remove the duplicates in my legend when using plotly's subplots()?
Here is my MWE:
library(plotly)
library(ggplot2)
library(tidyr)
mpg %>%
group_by(class) %>%
do(p = plot_ly(., x = ~cyl, y = ~displ, color = ~trans, type = 'bar')) %>%
subplot(nrows = 2, shareX = TRUE, titleX = TRUE) %>%
layout(barmode = 'stack')
plotly does not have facet like ggplot2 so it will add legend for each subplot or you can turn it off for some of them.
Here we do not have a layer with all the ~class entries nor two plots with no intersection in class which their combination also covers all of them. In that case, we could set showlegend to TRUE for those specific plot(s) and set it to FALSE for the rest and also set the legendgroup to trans so we get a unique but also complete legend.
As I said, here we do not have that special case. So What I can think of are two possibilities:
Adding the whole data (duplicating whole dataframe) and assigning class of All to them. Then plotting that along with original data but keep the legend only for class == All.
Using ggplot::facet_wrap and then ggplotly to make a plotly object. However, this would cause some issues with x-axis (compare ggplot object to plotly ones).
library(plotly)
library(ggplot2)
library(dplyr)
ly_plot <- . %>%
plot_ly(x = ~cyl, y = ~displ, color = ~trans,
type = 'bar', showlegend = ~all(legendC)) %>%
add_annotations(
text = ~unique(class),
x = 0.5,
y = 1,
yref = "paper",
xref = "paper",
xanchor = "middle",
yanchor = "top",
showarrow = FALSE,
font = list(size = 15))
mpg %>%
mutate(class= "_All_") %>%
rbind(.,mpg) %>%
mutate(legendC = (class == "_All_")) %>%
group_by(class) %>%
do(p = ly_plot(.)) %>%
subplot(nrows = 2, shareX = TRUE, titleX = TRUE) %>%
layout(barmode = 'stack')
#> Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large,
#> allowed maximum for palette Set2 is 8
#> Returning the palette you asked for with that many colors
p <- ggplot(data = mpg, aes(x=cyl, y=displ, fill=trans))+
geom_bar(stat="identity") +
facet_wrap(~class)
p
ggplotly(p) #seems for this we should also set "colour = trans"
Another workaround using the tidyverse. The following steps are added to the original MWE:
Convert the trans column to a factor.
Use tidyr's complete to fill (non-NA) dummy values for the missing factor levels in each class group.
Follow M-M's suggestion setting showlegend to TRUE for a single group and legendgroup to trans to link the legend entries between subplots.
library(plotly)
library(tidyverse)
mpg %>%
mutate_at("trans", as.factor) %>%
group_by(class) %>%
group_map(.f = ~{
## fill missing levels w/ displ = 0, cyl = first available value
complete(.x, trans, fill = list(displ = 0, cyl = head(.x$cyl, 1))) %>%
plot_ly(x = ~cyl, y = ~displ, color = ~trans, colors = "Paired", type = "bar",
showlegend = (.y == "2seater"), legendgroup = ~trans) %>%
layout(yaxis = list(title = as.character(.y)), barmode = "stack")
}) %>%
subplot(nrows = 2, shareX = TRUE, titleY = TRUE)

How to set different text and hoverinfo text

I am working with the plotly package, and I cannot find a way to display different things on the chart itself and in the hoverinfo.
Here is an example of a barchart:
library(plotly)
library(dplyr)
data(iris)
df <- iris %>%
group_by(Species) %>%
summarise(n = n(),
avg = mean(Sepal.Length))
p1 <- plot_ly(data = df,
x = ~Species,
y = ~n,
type = "bar",
text = ~paste("Species :", Species,
"<br> Avg :", avg),
textposition = "auto",
hoverinfo = "text")
From this code I get this:
And I would like to display the frequency (n) value in each bar instead of the same thing as the hoverinfo.
I have been looking at this thread but the solution described is too complicated for me and I think there must be an easier way to solve this issue.
Something like this?
p1 <- plot_ly(data = df,
x = ~Species,
y = ~n,
type = "bar",
text = ~n,
textposition = "auto",
hoverinfo = "text",
hovertext = paste("Species :", df$Species,
"<br> Avg :", df$avg))

Plotly legendgroup for subplots so a single legend controls all charts

I'm using plotly in r to generate a number of subplots. A toy example is shown below.
library(shiny)
library(dplyr)
library(plotly)
## Toy Example
ui <- fluidPage(
h3("Diamonds"),
plotlyOutput("plot", height = 600)
)
server <- function(input, output, session) {
# reduce down the dataset to make the example simpler
dat <- diamonds %>%
filter(clarity %in% c("I1", "IF")) %>%
mutate(clarity = factor(clarity, levels = c("I1", "IF")))
output$plot <- renderPlotly({
# Generates the chart for a single clarity
byClarity <- function(df){
Clarity <- df$clarity[1];
plot_ly(df, x = ~carat, y = ~price, color = ~cut, name = ~clarity) %>%
add_trace(
type="bar"
## Also tried adding this with no success
# legendgroup = ~cut
) %>%
layout(
barmode = "stack"
)
}
dat %>%
split(.$clarity) %>%
lapply(byClarity) %>%
subplot(nrows = NROW(.), shareX = TRUE, which_layout = "merge")
})
}
shinyApp(ui, server)
I would like to make the legends such that clicking on a 'Cut' on the legend will show/hide that 'Cut' from both charts instead of just the chart associated with that legend.
I looked at legendgroup but can't figure out how to associate it with cut instead of clarity (clarity is the grouping I'm using to make the subplots).
I also need the solution to work with raw plot_ly and not ggplotly as there are other plot_ly functionalities I need that aren't available in ggplotly.
Any help would be appreciated. I am using plotly_4.5.2, dplyr_0.5.0, and shiny_0.14.
Ok, here is a solution using ggplot2:
library(ggplot2)
library(dplyr)
library(plotly)
dat <- diamonds %>%
filter(clarity %in% c("I1", "IF")) %>%
mutate(clarity = factor(clarity, levels = c("I1", "IF")))
# Function for nice labels
k_label <- function(x) {
c(0, paste0((x)/1000,"K")[-1])
}
# ggplot
p <- ggplot(dat,aes(x=carat, y=price, fill=cut)) +
geom_bar(stat="identity") +
facet_wrap(~clarity,nrow=2, scales = "free_y") +
scale_y_continuous(labels = k_label) +
theme_minimal() + ylab("") + xlab("") +
theme(legend.title=element_blank(),
panel.grid.major.x=element_blank())
# a plotly
ggplotly(p)
Try adding legendgroup = ~cut to both traces and setting showlegend = F for one of them. Then in layout set showlegend = T
Like this:
plot_ly(df, x = ~carat, y = ~price, color = ~cut, name = ~clarity, legendgroup = ~cut, showlegend = T) %>%
add_trace( type="bar", legendgroup = ~cut, showlegend = F) %>%
layout(
barmode = "stack",showlegend = T
)

Resources