How to make plotly secondary x axis to work with rangeslider? - r

Context & problem:
I am trying to show the evolution of a value over time and some events that occured during the same period. One x-axis shows dates and I would like to get another x-axis, on top of the plot, that shows alternative tick-labels for dates i.e. events.
Here is a ggplot version of this plot:
library(ggplot2)
# here is a dummy dataset
df <- data.frame(
timeaxis = seq.Date(from = as.Date.character("2020-01-01"),
to = as.Date.character("2020-02-01"),
by = "days"),
avalue = runif(32)
)
# now I want to add a secondary axis to show events that occured during this time period
df_event <- data.frame(
eventdate = as.Date.character(c("2020-01-05", "2020-01-17", "2020-01-20", "2020-01-25")),
eventlabel = c("diner", "exam", "meeting", "payday")
)
# and the basic plot related to it
p <- ggplot(data = df, aes(x = timeaxis, y = avalue)) +
geom_line()
# I can add a new axis like so:
p <- p + scale_x_date(sec.axis = sec_axis(
~ .,
breaks = df_event$eventdate,
labels = df_event$eventlabel
))
print(p)
Created on 2022-02-11 by the reprex package (v2.0.1)
I need to use plotly for the awesome rangeslider that adds a very nice to use way to zoom in specific time periods.
Demo:
library(dplyr)
library(plotly)
plotly::ggplotly(p) %>%
plotly::layout(
# as you can see the rangeslider is linked to xaxis, is it possible to link it to xaxis2?
xaxis = list(rangeslider = list(visible = TRUE))
)
# note that using rangeslider() does not show the plot right...
As you can see, the second x-axis is not showing. Problem is that plotly does not have, yet, a good handling of secondary axis. First, if you use ggplot2::scale_x_date(sec.axis = ggplot2::sec_axis() to get a secondary x-axis, it is not transfered to the plotly plot by using plotly::ggplotly(). Second, if you manually define a secondary x-axis using plotly functions (as proposed here or there, this axis does not change according to the rangeslider (I guess because the rangeslider is actually bound to xaxis and should de defined for xaxis2 as well). Not to mention, I was not able to change the labels of the breaks to get the "events" displayed (even the example on
Demo:
plotly::ggplotly(p) %>%
# making an invisible trace
plotly::add_lines(
data = df_event,
x = ~ eventdate,
y = 0,
color = I("transparent"),
hoverinfo = "skip",
showlegend = FALSE,
xaxis = "x2"
) %>%
plotly::layout(
xaxis = list(rangeslider = list(visible = TRUE)),
xaxis2 = list(overlaying = "x", side = "top")
)
And with the actual event labels:
plotly::ggplotly(p) %>%
# making an invisible trace
plotly::add_lines(
data = df_event,
x = ~ eventdate,
y = 0,
color = I("transparent"),
hoverinfo = "skip",
showlegend = FALSE,
xaxis = "x2"
) %>%
plotly::layout(
xaxis = list(rangeslider = list(visible = TRUE)),
xaxis2 = list(overlaying = "x",
side = "top",
tickvals = df_event$eventdate,
ticktext = df_event$eventlabel)
)
I tried to add matches = "x", anchor = "x", scaleanchor = "x" to xaxis2 list but nothing changed.
Question:
How to make a second axis in a plotly plot that reacts to "zoom" using rangeslider?
If you think there is a better way of achieving this, please go ahead! Any idea is very welcome, I am quite new to plotly and I certainly have overlooked its functionalities.

Related

R Markdown not able to display two plots within the same if-statement

I am creating an R-Markdown document to help with reporting final exam results at our school. For the mathematics exam, I need a conditional statement to display appropriate plots, because the students do not need to take an oral exam (Oral = NA) if their written score is above a certain threshold. So I have an if-statement that checks whether the sum of the Oral_Exam variable (1 for those who had to take it, 0 otherwise) is larger than zero, and if so, create a 3D scatterplot where the students who had to take an oral exam are marked with red, followed by another plot of the same type, only with the students who had to go to the oral exam, colored according to oral exam result. If none of the students had to go to an oral exam, it is checked in a later if-statement, and only one plot is produced. My code looks like this:
```{r warning = FALSE, message = FALSE, echo = FALSE, eval = params$subj == "Matematika"}
if(sum(fulldata$Oral_exam) > 0){
fulldata_color = fulldata %>% mutate(Oral_exam, = as.character(Oral_exam), color = recode(Oral_exam, '1' = "red", '0' = "green"))
div(plot_ly(data = fulldata_color, x = ~Long_A_percent, y = ~Long_B_percent, z = ~Short_percent, marker = list(color = ~color), type="scatter3d", mode="markers", text = ~Name, width = 800, height = 800) %>% layout(
scene = list(aspectmode = "cube", xaxis = list(range = c(0,100), title = 'Long A (x)'),yaxis = list(range = c(0,100), title = 'Long B (y)'), zaxis = list(range = c(0,100), title = 'Short (z)'))), align = "center")
enter code here
Oral_data = fulldata %>% filter(!is.na(Oral_percent))
div(plot_ly(data = Oral_data, x = ~Long_A_percent, y = ~Long_B_percent, z = ~Short_percent,color = ~Oral_percent, type="scatter3d", mode="markers", text = ~Name, width = 800, height = 800) %>% layout(
scene = list(aspectmode = "cube", xaxis = list(range = c(0,100), title = 'Long A (x)'),yaxis = list(range = c(0,100), title = 'Long B (y)'), zaxis = list(range = c(0,100), title = 'Short (z)'))), align = "center")
}
This code, when knit, results in only the second plot being created, and it looks like the way I intend it to. However, if I break it up into two if statements with the same condition, and put one plotting command (and the corresponding command for the creation of the data frame), both plots are displayed correctly
I can work around it by having two if-statements instead of two, but it would be good to know why it doesn't work, especially since I have used multiple plots in the same code chunk (although not in the same if-statement) in the same document, and it has always worked as intended.
You can store plotly objets in variables and print them outside if:
```{r}
p1 <- NULL
p2 <- NULL
if(TRUE) {
p1 <- plot_ly(x = 1, y = 1, type = "scatter", mode = "marker")
p2 <- plot_ly(x = 1, y = 10, type = "scatter", mode = "marker")
}
p1
p2
```

Crosstalk interactive slider not working with histogram

I want to create an interactive histogram in R using crosstalk. Specifically, I want to use a slider to select what data appears on a histogram. To do so, I used the following code:
shared_data <- highlight_key(mpg)
widgets <- bscols(
widths = 12,
filter_slider("displ", "displ", shared_data, ~displ))
bscols(widths = 10, widgets,
plot_ly(x = ~mpg$displ, type = "histogram",
histnorm = "probability"))
This creates a histogram as well as an interactive slider. However, the slider doesn't actually do anything.
I've tried an alternate piece of code to do this, but similarly to the previous code, it creates the histogram and a slider which fails to filter the data.
shared_data <- mpg %>%
SharedData$new()
plot_ref <- plot_ly(x = ~mpg$displ, type = "histogram",
histnorm = "probability") %>%
layout(title = "Reference Histogram (Displ)",
xaxis = list(title = "Displ"),
yaxis = list(title = "Percentage (%)"))
bscols(widths = 10,
list(filter_slider(id = "slider_ap", label = "Displ",
sharedData = shared_data, column = ~displ),
plot_ref))
Can anyone explain what is wrong with the code above? I read somewhere that crosstalk interactivity isn't specifically optimized for histograms, could this be the reason it doesn't work? Any help is greatly appreciated!
The purpose of SharedData is to share the data. When you called the plot, you didn't use the shared data, so the filter had no way of matching the plot.
Check it out:
shared_data <- mpg %>%
SharedData$new()
plot_ref <- plot_ly(data = shared_data, # <- share it
x = ~displ, type = "histogram",
histnorm = "probability") %>%
layout(title = "Reference Histogram (Displ)",
xaxis = list(title = "Displ"),
yaxis = list(title = "Percentage (%)"))
bscols(widths = 10,
list(filter_slider(id = "slider_ap", label = "Displ",
sharedData = shared_data, column = ~displ),
plot_ref))

Reducing space between y-axis and plot title/axis ticks

I am outputting a scatterplot in R using plotly with the code below:
library(tidyverse)
library(plotly)
set.seed(1)
data.frame(state = c(rep(state.name, 2)),
value = sample(1:100, 100)) %>%
plot_ly(x = ~value,
y = ~state,
type = "scatter",
mode = "markers") %>%
layout(title = list(text = "State Information"))
The issue that I am running into is that the code above renders a plot with an excessive amount of space between the y-axis and the plot title and x-axis ticks respectively:
Can anyone tell me how I can shrink this space so that the plot margins are tighter?
Edit: I know that a similar question was asked here, but this relates to a numeric y-axis, not a categorical one:
R Plotly - Large unused space on top and bottom of graph when setting height
We can use the same procedure for a categorical axis.
Please run schema() and navigate: object ► layout ► layoutAttributes ► yaxis ► range:
[...] If the axis type is category, it should be numbers, using
the scale where each category is assigned a serial number from zero in
the order it appears.
library(plotly)
library(datasets)
set.seed(1)
DF <- data.frame(state = c(rep(state.name, 2)),
value = sample(1:100, 100))
plot_ly(
data = DF,
x = ~ value,
y = ~ state,
type = "scatter",
mode = "markers"
) %>%
layout(
title = list(text = "State Information"),
xaxis = list(
range = ~ c(-1, length(unique(value)) + 1)
),
yaxis = list(
range = ~ c(-1, length(unique(state))),
title = list(text = "state", standoff = 0L)) # maybe needed? sets distance between title and labels
)

how to change order of R plotly hover labels with "x unified" mode

I'm looking to see if there's a way to change the order of the hoverlabels when using hovermode = "x unified" in the newest version of the R package of plotly (4.9.3). Alternatively, is it possible to revert back to the way the old version of plotly displayed the hoverlabels while still using the current version of the plotly package? From a data visualization perspective, the old way is much clearer in my opinion.
I've included a minimum reproducible example below. When I run this using plotly v4.9.2.1, I get the result shown in Figure A and when I run it in plotly v4.9.3, I get the result shown in Figure B. The benefits to Figure A over Figure B are:
Figure A labels are in descending order relative to the data on each line at the time specified. Also this is reactive to the time period, so if one line moves above another at a different time period, the relative positioning of the label also moves to reflect the ordering of the data. You can see in Figure B that the dark green (y1) line has the lowest value (66) yet it is shown at the top of the hoverlabel box. In figure B, the y1 label is at the bottom.
Figure A labels are attached to the individual lines, so its easier to see the hovertext as it applies to the line in question
Figure A:
Figure B:
Code:
library(plotly)
library(tidyr)
df <- data.frame(Date = seq(as.Date("2018-01-01"),
as.Date("2021-01-01"),
by = "months"),
stringsAsFactors = F)
df$y1 <- seq(0, 100, length.out = nrow(df))
df$y2 <- seq(0, 600, length.out = nrow(df))
df$y3 <- seq(0, 300, length.out = nrow(df))
df$y4 <- seq(0, 200, length.out = nrow(df))
df <- df %>%
pivot_longer(cols = -Date,
names_to = "yname",
values_to = ) %>%
arrange(yname, Date)
mycols <- c("#006633", "#70AD47", "#1F4E78", "#2F75B5", "#C65911", "#EF8C4F",
"#C00000", "#FF8B8B", "#7030A0", "#9966FF")
mycols <- mycols[1:length(unique(df$yname))]
p <- plot_ly()
p <- p %>%
add_trace(data = df,
x = ~Date,
y = ~value,
text = ~yname,
hovertemplate = paste('<b>%{text}</b>',
'<br>%{x}',
'<br>%{y}',
'<extra></extra>'),
color = ~yname, colors = mycols,
name = ~yname, yaxis = "y",
type = "scatter", mode = "lines",
showlegend = T)
p <- p %>%
layout(hovermode = "x unified",
legend = list(x = 1.12, y = .5, xanchor = "left"),
yaxis = list(fixedrange = T),
xaxis = list(title = "",
fixedrange = T,
hoverformat = "%b %d, %Y"),
showlegend = T)
p
Two answers:
the ordering of traces in the unified hoverlabel is always the same, regardless of the relative Y values of the traces. The order is the same as in the legend, so it will follow the ordering of the colors.
You can revert to the previous behavior with hovermode = "x" rather than hovermode = "x unified"

R: Colors in dumbell plot seem to mix in inappropriate ways

I am trying to produce a dumbell plot in R. In this case, there are four rows, and they need to have different and specific colors each. I define the colors as part of the dataset using colorRampPalette(). Then when I produce the plot, the colors get mixed in inappropriate ways. See the image below, and in particular the legend.
As you can see, the orange is supposed to be #7570B3 according to the legend. But this is not correct. The color 7570B3 is purple ! For this reason, the colors that I had defined in the dataset are mixed in the plot. "Alt 2" sound be in orange and "Alt 3" should be in purple.
Does anyone know how to fix this ? Any help would be very appreciated.
Here is a simple version of the code:
table_stats_scores <- data.frame(alt=c("alt1","alt2","alt3","alt4"),
average=c(15,20,10,5),
dumb_colors= colorRampPalette(brewer.pal(4,"Dark2"))(4),
min=c(10,15,5,0),max=c(20,25,15,10)
)
table_stats_scores # This is the dataset
table_stats_scores <- table_stats_scores[order(-
table_stats_scores$average),] # ordering
table_stats_scores$alt <- factor(table_stats_scores$alt,
levels = table_stats_scores$alt[order(table_stats_scores$average)])
# giving factor status to alternatives so that plot_ly() picks up on this
p <- plot_ly(table_stats_scores, x=table_stats_scores$average, color = ~
dumb_colors,
y=table_stats_scores$alt,text=table_stats_scores$alt) %>%
add_segments(x = ~min, xend = ~max, y = ~alt, yend = ~alt,name = "Min-Max
range", showlegend = FALSE, line = list(width = 4)) %>%
add_markers(x = ~average, y = ~alt, name = "Mean",
marker=list(size=8.5),showlegend = FALSE) %>%
add_text(textposition = "top right") %>%
layout(title = "Scores of alternatives",
xaxis = list(title = "scores"),
yaxis = list(title = "Alternatives")
)
p
Yes color can be an issue in plotly, because there are several ways to specify it, and the assignment order of the various elements from the dataframe can be hard to keep in sync.
The following changes were made:
added a list of brighter colors to your dataframe because I couldn't easily visualize the brewer.pal colors. Better to debug with something obvious.
changed the color parameter to the alt column, because it is really just used only indirectly to set the color, and mostly it determines the text in the legend.
added the colors to the text parameter (instead of alt) so I could see if it was assigning the colors correctly.
changed the sort order to the default "ascending" on the table_stat_scores sort because otherwise it assigned the colors in the incorrect order (don't completely understand this - seems like there is some mysterious sorting/re-ordering going on internally)
added a colors parameter to the add_segments and add_markers so that they set the color in the same way using the same column.
I think this gets you want you want:
library(plotly)
library(RColorBrewer)
table_stats_scores <- data.frame(alt=c("alt1","alt2","alt3","alt4"),
average=c(15,20,10,5),
dumb_colors= colorRampPalette(brewer.pal(4,"Dark2"))(4),
min=c(10,15,5,0),max=c(20,25,15,10)
)
table_stats_scores # This is the dataset
table_stats_scores$bright_colors <- c("#FF0000","#00FF00","#0000FF","#FF00FF")
table_stats_scores <- table_stats_scores[order(table_stats_scores$average),] # ordering
table_stats_scores$alt <- factor(table_stats_scores$alt,
levels = table_stats_scores$alt[order(table_stats_scores$average)])
# giving factor status to alternatives so that plot_ly() picks up on this
p <- plot_ly(table_stats_scores, x=~average, color = ~alt, y=~alt,text=~bright_colors) %>%
add_segments(x = ~min, xend = ~max, y = ~alt, yend = ~alt,name = "Min-Max range",
colors=~bright_colors, showlegend = FALSE, line = list(width = 4)) %>%
add_markers(x = ~average, y = ~alt, name = "Mean",
marker=list(size=8.5,colors=~bright_colors),showlegend = FALSE) %>%
add_text(textposition = "top right") %>%
layout(title = "Scores of alternatives",
xaxis = list(title = "scores"),
yaxis = list(title = "Alternatives")
)
p
yielding this:

Resources