2012-11-11 139 views
6

我想做一个垂直直方图。理想情况下,我应该能够每天在一个单一的情节上放多个。垂直直方图

如果这可以与quantmod实验chart_Series或其他一些能够绘制时间序列条形图的库结合使用,那将会很棒。请参阅附件截图。理想情况下,我可以策划这样的事情。

有什么内置或现有的库可以帮助这个吗?

Market Profile Example

回答

1

如果您使用的网格图形,那么你可以创建等。无论您希望他们和情节,以旋转的旋转视视。你只需要一个函数,将使用网格图形绘制到指定的视口,我会建议ggplot2或可能格为此。

在基础图形中,您可以编写自己的函数来绘制旋转的直方图(修改plot.histogram函数或仅使用rect或其他工具从头开始编写自己的函数)。然后,您可以使用TeachingDemos软件包中的subplot函数将剧情放在任何你想要的地方放大。

3

小提琴情节可能足够接近你想要的。它们是通过一个轴镜像的密度图,就像箱形图和密度图的混合。 (由例如比描述的理解要容易得多:-))。

这里是GGPLOT2执行起来简单(有点丑陋)例如:

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

更漂亮的例子是:

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

要包含范围而不是或除了该行之外,可以使用geom_linerange或geom_pointrange。

9

我在一年前写了一些东西来做基本图形中的垂直直方图。这里是一个使用示例。

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