8

I'd like to do a vertical histogram. Ideally I should be able to put multiple on a single plot per day.

If this could be combined with quantmod experimental chart_Series or some other library capable of drawing bars for a time series that would be great. Please see the attached screenshot. Ideally I could plot something like this.

Is there anything built in or existing libraries that can help with this?

Market Profile Example

Dave
  • 2,386
  • 1
  • 20
  • 38

3 Answers3

11

I wrote something a year or so ago to do vertical histograms in base graphics. Here it is, with a usage example.

VerticalHist <- function(x, xscale = NULL, xwidth, hist,
                         fillCol = "gray80", lineCol = "gray40") {
    ## x (required) is the x position to draw the histogram
    ## xscale (optional) is the "height" of the tallest bar (horizontally),
    ##   it has sensible default behavior
    ## xwidth (required) is the horizontal spacing between histograms
    ## hist (required) is an object of type "histogram"
    ##    (or a list / df with $breaks and $density)
    ## fillCol and lineCol... exactly what you think.
    binWidth <- hist$breaks[2] - hist$breaks[1]
    if (is.null(xscale)) xscale <- xwidth * 0.90 / max(hist$density)
    n <- length(hist$density)
    x.l <- rep(x, n)
    x.r <- x.l + hist$density * xscale
    y.b <- hist$breaks[1:n]
    y.t <- hist$breaks[2:(n + 1)]

    rect(xleft = x.l, ybottom = y.b, xright = x.r, ytop = y.t,
         col = fillCol, border = lineCol)
}



## Usage example
require(plyr) ## Just needed for the round_any() in this example
n <- 1000
numberOfHists <- 4
data <- data.frame(ReleaseDOY = rnorm(n, 110, 20),
                   bin = as.factor(rep(c(1, 2, 3, 4), n / 4)))
binWidth <- 1
binStarts <- c(1, 2, 3, 4)
binMids <- binStarts + binWidth / 2
axisCol <- "gray80"

## Data handling
DOYrange <- range(data$ReleaseDOY)
DOYrange <- c(round_any(DOYrange[1], 15, floor),
                      round_any(DOYrange[2], 15, ceiling))

## Get the histogram obects
histList <- with(data, tapply(ReleaseDOY, bin, hist, plot = FALSE,
    breaks = seq(DOYrange[1], DOYrange[2], by = 5)))
DOYmean <- with(data, tapply(ReleaseDOY, bin, mean))

## Plotting
par(mar = c(5, 5, 1, 1) + .1)
plot(c(0, 5), DOYrange, type = "n",
     ann = FALSE, axes = FALSE, xaxs = "i", yaxs = "i")

axis(1, cex.axis = 1.2, col = axisCol)
mtext(side = 1, outer = F, line = 3, "Length at tagging (mm)",
      cex = 1.2)
axis(2, cex.axis = 1.2, las = 1, line = -.7, col = "white",
    at = c(75, 107, 138, 169),
    labels = c("March", "April", "May", "June"), tck = 0)
mtext(side = 2, outer = F, line = 3.5, "Date tagged", cex = 1.2)
box(bty = "L", col = axisCol)

## Gridlines
abline(h = c(60, 92, 123, 154, 184), col = "gray80")

biggestDensity <- max(unlist(lapply(histList, function(h){max(h[[4]])})))
xscale <- binWidth * .9 / biggestDensity

## Plot the histograms
for (lengthBin in 1:numberOfHists) {
    VerticalHist(binStarts[lengthBin], xscale = xscale,
                         xwidth = binWidth, histList[[lengthBin]])
    }

verticalhistograms

Gregor Thomas
  • 136,190
  • 20
  • 167
  • 294
  • I really found this useful and ended up writing a wrapper to use it in more flexible way. Published it on https://github.com/ozgen92/VerticalHist, I hope you dont mind :) – ozgeneral Mar 21 '18 at 15:40
  • 1
    Thanks! I don't mind, but it would be nice to have a shout-out, either a line at the end of the readme or a comment in the code saying *"Based on this Stack Overflow answer created by Gregor Thomas: https://stackoverflow.com/a/13334294/903061"* – Gregor Thomas Mar 21 '18 at 17:05
  • Of course, Im so sorry to not add it in the first place. This is the first time I improved someone elses code so no plagiarism intended, just sharing so that other people can have plug and play – ozgeneral Mar 21 '18 at 20:08
4

Violin plots might be close enough to what you want. They are density plots that have been mirrored through one axis, like a hybrid of a boxplot and a density plot. (Much easier to understanding by example than description. :-) )

Here is a simple (somewhat ugly) example of the ggplot2 implementation of them:

library(ggplot2)
library(lubridate)

data(economics) #sample dataset

# calculate year to group by using lubridate's year function
economics$year<-year(economics$date)

# get a subset 
subset<-economics[economics$year>2003&economics$year<2007,]    

ggplot(subset,aes(x=date,y=unemploy))+
    geom_line()+geom_violin(aes(group=year),alpha=0.5)

violin plot over a line plot of a time series

A prettier example would be:

ggplot(subset,aes(x=date,y=unemploy))+ 
    geom_violin(aes(group=year,colour=year,fill=year),alpha=0.5, 
    kernel="rectangular")+    # passes to stat_density, makes violin rectangular 
    geom_line(size=1.5)+      # make the line (wider than normal)
    xlab("Year")+             # label one axis
    ylab("Unemployment")+     # label the other
    theme_bw()+                     # make white background on plot
    theme(legend.position = "none") # suppress legend

enter image description here

To include ranges instead of or in addition to the line, you would use geom_linerange or geom_pointrange.

MattBagg
  • 10,268
  • 3
  • 40
  • 47
1

If you use grid graphics then you can create rotated viewports whereever you want them and plot to the rotated viewport. You just need a function that will plot using grid graphics into a specified viewport, I would suggest ggplot2 or possibly lattice for this.

In base graphics you could write your own function to plot the rotated histogram (modify the plot.histogram function or just write your own from scratch using rect or other tools). Then you can use the subplot function from the TeachingDemos package to place the plot wherever you want on a larger plot.

Greg Snow
  • 48,497
  • 6
  • 83
  • 110