Highlight Areas Within Certain X Range in Ggplot2

highlight areas within certain x range in ggplot2

Using diff to get regions to color rectangles, the rest is pretty straightforward.

## Example data
set.seed(0)
dat <- data.frame(dates=seq.Date(Sys.Date(), Sys.Date()+99, 1),
value=cumsum(rnorm(100)))

## Determine highlighted regions
v <- rep(0, 100)
v[c(5:20, 30:35, 90:100)] <- 1

## Get the start and end points for highlighted regions
inds <- diff(c(0, v))
start <- dat$dates[inds == 1]
end <- dat$dates[inds == -1]
if (length(start) > length(end)) end <- c(end, tail(dat$dates, 1))

## highlight region data
rects <- data.frame(start=start, end=end, group=seq_along(start))

library(ggplot2)
ggplot(data=dat, aes(dates, value)) +
theme_minimal() +
geom_line(lty=2, color="steelblue", lwd=1.1) +
geom_point() +
geom_rect(data=rects, inherit.aes=FALSE, aes(xmin=start, xmax=end, ymin=min(dat$value),
ymax=max(dat$value), group=group), color="transparent", fill="orange", alpha=0.3)

Sample Image

How can I automatically highlight multiple sections of the x axis in ggplot2?

This may be a bit hacky, but I think it gives the result you are looking for. Let me create some data first that roughly corresponds to yours:

df <- data.frame(step = rep(1:100, 3), group = rep(letters[1:3], each = 100),
value = c(cumsum(c(50, runif(99, -1, 1))),
cumsum(c(50, runif(99, -1, 1))),
cumsum(c(50, runif(99, -1, 1)))))

df2 <- data.frame(step = 1:100, event = sample(c(TRUE, FALSE), 100, TRUE))

So the starting plot from df would look like this:

ggplot(df, aes(step, value, colour = group)) + geom_line()

Sample Image

and the event data frame looks like this:

head(df2)
#> step event
#> 1 1 FALSE
#> 2 2 FALSE
#> 3 3 FALSE
#> 4 4 TRUE
#> 5 5 FALSE
#> 6 6 TRUE

The idea is that you add a semi-transparent red geom_area to the plot, making FALSE values way below the bottom of the range and TRUE values way above the top of the range, then just set coord_cartersian so that the y limits are near to the limits of your main data. This will give you red vertical bands whenever your event is TRUE:

ggplot(df, aes(step, value, colour = group)) + 
geom_line() +
geom_area(data = df2, aes(x = step, y = 1000 * event),
inherit.aes = FALSE, fill = "red", alpha = 0.2) +
coord_cartesian(ylim = c(40, 60)

Sample Image

How to highlight time ranges on a plot?

I think drawing rectangles just work fine, I have no idea about better solution, if a simple vertical line or lines are not enough.

And just use alpha=0.5 instead of fill.alpha=0.5 for the transparency issue also specifying inherit.aes = FALSE in geom_rect(). E.g. making a plot from the diamonds data:

p <- ggplot(diamonds, aes(x=price, y=carat)) +
geom_line(aes(color=color))

rect <- data.frame(xmin=5000, xmax=10000, ymin=-Inf, ymax=Inf)
p + geom_rect(data=rect, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax),
color="grey20",
alpha=0.5,
inherit.aes = FALSE)

alt text

Also note that ymin and ymax could be set to -Inf and Inf with ease.

Customize background to highlight ranges of data in ggplot

You can add the "bars" with geom_rect() and setting ymin and ymax values to -Inf and Inf. But according to @sc_evens answer to this question you have to move data and aes() to geom_point() and leave ggplot() empty to ensure that alpha= of geom_rect() works as expected.

ggplot()+
geom_point(data=df,aes(x=y*abs(x),y=y),alpha=.2,size=5) +
geom_rect(aes(xmin=-0.1,xmax=0.1,ymin=-Inf,ymax=Inf),alpha=0.1,fill="green")+
geom_rect(aes(xmin=-0.25,xmax=-0.1,ymin=-Inf,ymax=Inf),alpha=0.1,fill="orange")+
geom_rect(aes(xmin=0.1,xmax=0.25,ymin=-Inf,ymax=Inf),alpha=0.2,fill="orange")+
theme_bw() +
coord_cartesian(xlim = c(-.5,.5),ylim=c(-1,1))

Sample Image

Highlight values with a rectangle/shaded area in ggplot2

As @dww mentioned geom_rect works. Adding the below layer:

  geom_rect(
aes(
xmin = as.Date('1993-06-01'),
xmax = as.Date('1994-11-01'),
ymin = min(index),
ymax = 0
),
fill = NA,
color = "black",
size = 2
)

Sample Image

In R, how to use plotly's highlight() function to activate a ggplot 2 graphic layer?

It looks like you're new to SO; welcome to the community! If you want great answers quickly, it's best to make your question reproducible. This includes sample data like the output from dput(head(dataObject)) and any libraries you are using (if it's not entirely obvious). Check it out: making R reproducible questions.

Now to answer that question...

This one was tricky! Highlight functionality isn't designed to change the visibility of the traces (the layers in ggplot == traces in Plotly).

First, I started identifying data to use for this answer. I used the dataset happiness from the package zenplots. (It's data from a few years of the World Happiness Report.)

I tried to stick to the general idea of what you were graphing and how you were graphing it, but some of it is inherently different since I don't have your data. I noticed that it mutilated the stat_cor layer. Let me know if you still want that layer as it appears in your ggplot object. I can probably help with that. You didn't mention it in your question, though.

library(tidyverse)
library(plotly)
library(ggpubr)

data("happiness", package = "zenplots")

d <- highlight_key(happiness,
~Region)

p <-ggplot(d, aes(x = Family, y = Happiness, group = Region,
color = Region, text = Country)) +
labs(y= "Happiness Score", x = "Family", title = "Family and Happiness") +
geom_smooth(aes(group = Region), method = "lm", se = FALSE, size = 0.5) +
geom_point(aes(size = GDP)) +
theme_bw() +
scale_color_manual(values = rainbow(10, alpha = 0.6)) +
scale_size_continuous(range = c(0, 10), name = '')

gg <- ggplotly(p, tooltip = "text") %>%
highlight(on = 'plotly_click', off = 'plotly_doubleclick',
opacityDim = .05)

At this point, this graph looks relatively similar to the graph you have in your question. (It's a lot busier, though.)

Sample Image

Now that I've closely established the plot you ended with, I have to hide the lines, change the legend (since it's only showing the lines), and then set the functionality up for making the lines visible when you change the highlight or if you escape the highlight.

Remove line visibility; change the legend to reflect the points instead.

# First, make the lines invisible (because no groups are highlighted)
# Remove the line legend; add the point legend
invisible(
lapply(1:length(gg$x$data),
function(j){
nm <- gg$x$data[[j]]$name
md <- gg$x$data[[j]]$mode
if(md == "lines") {
gg$x$data[[j]]$visible <<- FALSE
gg$x$data[[j]]$showlegend <<- FALSE
} else {
gg$x$data[[j]]$visible <<- TRUE
gg$x$data[[j]]$showlegend <<- TRUE
}
}
))

You could look at the plot at this point and see the lines were no longer visible and the legend has changed a bit.

Sample Image

To add visibility changes to the highlighting, you can use Plotly events. If you know anything about HTML or Javascript, this is the same thing as an event in a browser. This uses the package htmlwidgets. I didn't call the library with the other libraries, I just appended it to the function.

Some additional information regarding the JS: The content with /* */ is a comment in Javascript. I've added these so you might follow what's happening (if you wanted to). The curveNumber in the JS is the trace number of the Plotly object. While it only has 20 traces before rendering; it has 22 afterward. While R numbers elements starting at 1, JS (like MOST languages) starts at 0.

gg %>% htmlwidgets::onRender(
"function(el, x){
v = [] /* establish outside of the events; used for both */
for (i = 0; i < 22; i++) { /*1st 11 are lines; 2nd 11 are points */
if(i < 12){
v[i] = false;
} else {
v[i] = true;
}
}
console.log(x);
el.on('plotly_click', function(d) {
cn = d.points[0].curveNumber - 10; /*if [8] is the lines, [18] is the points*/
v2 = JSON.parse(JSON.stringify(v)); /*create a deep copy*/
v2[cn] = true;
update = {visible: v2};
Plotly.restyle(el.id, update); /* in case 1 click to diff highlight */
});
el.on('plotly_doubleclick', function(d) {
console.log('out ', d);
update = {visible: v}
console.log('dbl click ' + v);
Plotly.restyle(el.id, update);
});
}")

The rendered view:

Sample Image

A single click from rendered

Sample Image

A single click from a single click

Sample Image

A double click from a single click

Sample Image

Update to manage the text

To add the text into the plot, or rather fix the text there are several things that need to happen.
Assume that the code that follows is after the initial creation of the ggplotly object or gg.

Currently, the text traces all have the same x and y value, they don't have a key, legendgroup, or name, and they are out of order. This will require changes to the JS, as well.

To determine which order they should be in, along with what key should be assigned, I used the color and group assignment in the ggplot object and the colors in the plotly object.

# collect color order for text
pp <- ggplot_build(p)$data[[3]] %>%
select(colour, group)

k = vector()
invisible( # collect the order they appear in Plotly
lapply(1:length(gg$x$data),
function(q) {
md <- gg$x$data[[q]]$mode
if(md == "text") {
k[q - 20] <<- gg$x$data[[q]]$textfont$color
}
})
)
# they're HEX in ggplot and rgb in Plotly, set up to convert all to hex
k <- str_replace(k, 'rgba\\((.*)\\)', "\\1") %>%
str_replace_all(., ",", " ")

k <- sapply(strsplit(k, " "), function(i){
rgb(i[1], i[2], i[3], maxColorValue = 255)}) %>%
as.data.frame() %>% setNames(., "colour")

Now that the plotly colors are hex, I'll join the frames the get the order, then reorder the traces in the ggplotly object.

colJ = left_join(k, pp) # join and reorder
gg$x$data[21:30] <- gg$x$data[21:30][order(colJ$group)]

Next, I created a vector of y-values for the text traces. I used the variable that represents the y in my plot.

# new vals for y in text traces; use var that is `y` in plot
txy = seq(max(happiness$Happiness, na.rm = T),
min(happiness$Happiness, na.rm = T), # min, max Y in plot
length.out = nrow(happiness %>%
group_by(Region) %>%
summarise(n()))) # no of traces

Now I just need a list of the keys (names or legend groups).

reg <- happiness$Region %>% unique()

Now I'll use an expanded version of the method that I used to update visibility in my original answer. Now, this method will also be used to update the formatting of the text, add the missing content, update the y values, and add alignment. You should have 30 traces like my example, so the numbers work.

invisible(
lapply(1:length(gg$x$data),
function(j){
nm <- gg$x$data[[j]]$name
md <- gg$x$data[[j]]$mode
if(md == "lines") {
gg$x$data[[j]]$visible <<- FALSE
gg$x$data[[j]]$showlegend <<- FALSE
}
if(md == "markers") {
gg$x$data[[j]]$visible <<- TRUE
gg$x$data[[j]]$showlegend <<- TRUE
}
if(md == "text") {
tx = gg$x$data[[j]]$text
message(nm)
tx = str_replace(tx, "italic\\((.*)\\)", "<i>\\1</i>") %>%
str_replace_all(., "`", "") %>% str_replace_all(., "~", " ") %>%
str_replace(., "\\^2", "<sup>2</sup>")
gg$x$data[[j]]$text <<- tx
gg$x$data[[j]]$y <<- txy[j - 20]
gg$x$data[[j]]$textposition <<- "middle right"
gg$x$data[[j]]$visible <<- TRUE
gg$x$data[[j]]$key <<- list(reg[j - 20]) # for highlighting
gg$x$data[[j]]$name <<- reg[j - 20] # for highlighting
gg$x$data[[j]]$legendgroup <<- reg[j - 20] # for highlighting
}
}
))

Now for the JS. I've tried to make this a bit more dynamic.

gg %>% htmlwidgets::onRender(
"function(el, x){
v = [] /* establish outside of the events; used for both */
for (i = 0; i < x.data.length; i++) { /* data doesn't necessarily equate to traces here*/
if(x.data[i].mode === 'lines'){
v[i] = false;
} else if (x.data[i].mode === 'markers' || x.data[i].mode === 'text') {
v[i] = true;
} else {
v[i] = true;
}
}
const gimme = x.data.map(elem => elem.name);
el.on('plotly_click', function(d) {
var nn = d.points[0].data.name
v2 = JSON.parse(JSON.stringify(v)); /*create a deep copy*/
for(i = 0; i < gimme.length; i++){
if(gimme[i] === nn){ /*matching keys visible*/
v2[i] = true;
}
}
var chk = d.points[0].yaxis._traceIndices.length
if(v2.length !== chk) { /*validate the trace count every time*/
tellMe = chk - v2.length;
more = Array(tellMe).fill(true);
v2 = v2.concat(more); /*make any new traces visible*/
}
update = {visible: v2};
Plotly.restyle(el.id, update); /* in case 1 click to diff highlight */
});
el.on('plotly_doubleclick', function(d) {
update = {visible: v} /*reset styles*/
Plotly.restyle(el.id, update);
});
}")

Sample Image

Sample Image

Sample Image

ggplot2: highlight chart area

Based on code in the TA.R file of the quantmod package, here is code that uses rle to find the starts and ends of the rectangles.

runs <- rle(as.logical(spy[, 1] > spy[, 2]))
l <- list(start=cumsum(runs$length)[which(runs$values)] - runs$length[which(runs$values)] + 1,
end=cumsum(runs$lengths)[which(runs$values)])
rect <- data.frame(xmin=l$start, xmax=l$end, ymin=-Inf, ymax=Inf)

Combine that with some ggplot2 code from the accepted answer to the question you linked to:

ggplot(spy,aes(x=index(spy),y=spy$SPY.Adjusted))+geom_line()+geom_line(aes(x=index(spy),y=spy$sma))+geom_rect(data=rect, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), color="grey20", alpha=0.5, inherit.aes = FALSE)

And you get:

Sample Image

If you reverse the order of plotting and use alpha=1 in geom_rect it may (or may not) look more like you desire:

ggplot(spy,aes(x=index(spy),y=spy$SPY.Adjusted))+geom_rect(data=rect, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), border=NA, color="grey20", alpha=1, inherit.aes = FALSE)+geom_line()+geom_line(aes(x=index(spy),y=spy$sma))

Sample Image


Since you have an xts object. You may not even want to convert to a data.frame. Here is how you could plot it using the brand new plot.xts method in the xtsExtra package created by Michael Weylandt as part of a Google Summer of Code project.

spy <- as.xts(spy)
require(xtsExtra)
plot(spy, screens=1,
blocks=list(start.time=paste(index(spy)[l$start]),
end.time=paste(index(spy)[l$end]), col='lightblue'),
legend.loc='bottomright', auto.legend=TRUE)

Sample Image



Related Topics



Leave a reply



Submit