ggplot new scale_x function failing to work correctly

Viewed 115

In order to get rid of non-trading days of stocks (aka weekends) in ggplot instead of the date, I use the number of rows in the data and then add breaks and labels. The code below "works" does the trick and plots the data like chartSeries from the quantmod package. ggplot adds information that is not there or shows gaps depending on what kind of chart you are making. For dealing with stock prices this is not handy. Hence the works section.

But since this is just a labeling issue, an axis transformer function would be more logical and easier to use. I tried creating a scale_x_finance function (see does not work section), but I must be interpreting the inverse function incorrectly as I only get back a plot of 1 date and not the whole timeseries.

I read several SO questions like this one and this one, but no luck so far.

I know that a package called bdscale exists, but that hasn't been updated for over six years and the breaks / labels it creates are not what I need.

The outcome of using scale_x_finance should look like the plot from the works section. I wonder if someone has a clue of what I'm missing here.

I added some test data on the bottom of the question.

works

library(ggplot2)

# get the start date and the last days of the month for breaks and label positions
get_breaks <- function(x) {
  out <- c(1, which(ave(as.numeric(x),format(x,"%Y%m"), FUN = function(x) x == max(x)) == 1))
}

# use 1:nrow to be able to use scale_x_continuous
ggplot(test_data, aes(x = 1:nrow(test_data))) + 
  geom_line(aes(y = close)) +
  scale_x_continuous(name = "date",
                     breaks = get_breaks(test_data$date),
                     labels = test_data$date[get_breaks(test_data$date)])

enter image description here

does not work

scale_x_finance <- function (...,
                             dates,
                             breaks = get_breaks(dates)){
  
  my_transformer <- function(dates, breaks = get_breaks(dates)) {
    
    transform <- function(dates) seq_along(dates) 
    inverse <- function(nums) dates[nums] 
    
    scales::trans_new(name = "date",
                      transform = transform,
                      inverse = inverse,
                      breaks = breaks,
                      domain = range(dates))
  }
  
  scale_x_continuous(name = "date",
                     trans = my_transformer(dates = dates, breaks = breaks),
                     ...)
}


ggplot(test_data, aes(x = date)) + 
  geom_line(aes(y = close)) +
  scale_x_finance(dates = test_data$date) 

enter image description here

data:

test_data <- structure(list(date = structure(c(18995, 18996, 18997, 18998, 
                                               18999, 19002, 19003, 19004, 19005, 19006, 19010, 19011, 19012, 
                                               19013, 19016, 19017, 19018, 19019, 19020, 19023, 19024, 19025, 
                                               19026, 19027, 19030, 19031, 19032, 19033, 19034, 19037, 19038, 
                                               19039, 19040, 19041, 19045, 19046, 19047, 19048, 19051, 19052, 
                                               19053, 19054, 19055, 19058, 19059, 19060, 19061, 19062, 19065, 
                                               19066, 19067, 19068, 19069, 19072, 19073, 19074, 19075, 19076, 
                                               19079, 19080, 19081, 19082), class = "Date"), 
                            close = c(182.009995, 179.699997, 174.919998, 172, 172.169998, 172.190002, 175.080002, 
                                      175.529999, 172.190002, 173.070007, 169.800003, 166.229996, 164.509995, 
                                      162.410004, 161.619995, 159.779999, 159.690002, 159.220001, 170.330002, 
                                      174.779999, 174.610001, 175.839996, 172.899994, 172.389999, 171.660004, 
                                      174.830002, 176.279999, 172.119995, 168.639999, 168.880005, 172.789993, 
                                      172.550003, 168.880005, 167.300003, 164.320007, 160.070007, 162.740005, 
                                      164.850006, 165.119995, 163.199997, 166.559998, 166.229996, 163.169998, 
                                      159.300003, 157.440002, 162.949997, 158.520004, 154.729996, 150.619995, 
                                      155.089996, 159.589996, 160.619995, 163.979996, 165.380005, 168.820007, 
                                      170.210007, 174.070007, 174.720001, 175.600006, 178.960007, 177.770004, 
                                      174.610001)), row.names = c(NA, 62L), class = "data.frame")
1 Answers

The problem lies in your my_transformer object. This needs to be able to take dates that are not present in your data and transform them appropriately. For example, when ggplot comes to calculate the plot limits, it may pass a vector of two dates that don't belong in your dates vector. The transform function will convert any vector of two dates into the vector c(1, 2), which isn't what you want - you need arbitrary dates to be interpolated according to your dates vector.

A similar concept applies for the inverse function, which will have to handle arbitrary numbers and back-transform these into dates.

I think the easiest way to handle this is to ensure that dates are all treated numerically inside my_transformer, then retrospectively given labels at ghe rnd by the scale_x_continuous call.

So your transformer could be something like:

library(ggplot2)

my_transformer <- function(dates) {
  dates <- as.numeric(dates)
  pos   <- seq_along(dates) - 1
  
  transform <- function(x) {
    if(all(is.na(x))) return(x)
    x <- as.numeric(x)
    y <- numeric(length(x))
    in_range <- x >= min(dates) & x <= max(dates)
    y[in_range] <- approx(dates, pos, x[in_range])$y
    y[x < min(dates)] <- x[x < min(dates)] - min(dates)
    y[x > max(dates)] <- x[x > max(dates)] - max(dates) + max(pos)
    y
  }
  
  inverse <- function(x) {
    if(all(is.na(x))) return(x)
    x <- as.numeric(x)
    y <- numeric(length(x))
    y[is.na(x)] <- NA
    in_range <- x >= 0 & x <= max(pos) & !is.na(x)
    y[in_range] <- approx(pos, dates, x[in_range])$y
    y[x < 0] <- x[x < 0] + min(dates)
    y[x > max(pos)] <- max(dates) + x[x > max(pos)] - max(pos)
    y
  }
  
    scales::trans_new(name = "date",
                      transform = transform,
                      inverse   = inverse)
}

And scale_x_finance would be something like this:

scale_x_finance <- function (dates, ...) {
  
  scale_x_continuous(name = "date",  ..., 
                     trans = my_transformer(dates),
                     labels = ~ as.Date(.x, origin = "1970-01-01"))
}

So that your plot call is just:

ggplot(test_data, aes(x = date, y = close)) + 
  geom_line(aes(y = close)) +
  scale_x_finance(dates = test_data$date)

enter image description here

To demonstrate that gaps in the data simply remove space in the x axis (which seems to be the ultimate goal here), we can remove a week's worth of data and see that the dates on either side of the missing dates just move closer together:

test_data <- test_data[-(25:31),]

ggplot(test_data, aes(x = date, y = close)) + 
  geom_line(aes(y = close)) +
  scale_x_finance(dates = test_data$date)

enter image description here

Related