pointandfigure <- function(high, low, times, boxsize, thresh=3,
grid.x = 10, grid.y=7, xlab="Time", ylab="Value") {
## break DOWN when not rising AND low is three boxes below
## last high
## break UP when falling AND high is three boxes above
## last low
n <- length(high)
if(length(low)!=n) stop("low and high different lengths")
## try and choose a boxsize
if(missing(boxsize)) {
w <- diff(range(c(high,low)))
k <- ceiling(log(w/35)/log(10))
bs <- 10^k
if((w/bs)<7) { bs<-bs/5 }
else
{ if((w/bs)<21) bs<-bs/2 }
boxsize <- bs
c(boxsize,w/boxsize)
}
low.box <- as.integer(low/boxsize)
high.box <- as.integer(high/boxsize)
state <- NULL ## "X" or "O"
bar.high <- NULL ## highest point of X or O bar
bar.low <- NULL ## lowest point of X or O bar
bar.first <- NULL ## index of first data point in bar
state[1] <- "X"
bar.high[1] <- high.box[1]
bar.low[1] <- high.box[1]
bar.first[1] <- 1
curr.bar <- 1
for(i in 2:n) {
switch(state[curr.bar],
## on upswing
X= {
if( (high.box[i] <= bar.high[curr.bar]) &&
(low.box[i] <= bar.high[curr.bar]-thresh)) {
## switch state
curr.bar <- curr.bar+1
bar.first[curr.bar] <- i
state[curr.bar] <- "O"
bar.low[curr.bar] <- low.box[i]
bar.high[curr.bar] <- bar.high[curr.bar-1]-1
} else {
## same state
bar.high[curr.bar] <- max(bar.high[curr.bar],high.box[i])
}},
## on downswing
O= {
if( (low.box[i] >= bar.low[curr.bar]) &&
(high.box[i] >= bar.low[curr.bar]+thresh)) {
## switch state
curr.bar <- curr.bar+1
bar.first[curr.bar] <- i
state[curr.bar] <- "X"
bar.high[curr.bar] <- high.box[i]
bar.low[curr.bar] <- bar.low[curr.bar-1]+1
} else {
## same state
bar.low[curr.bar] <- min(bar.low[curr.bar],low.box[i])
}},
stop("Strange symbol!"))
}
## do the plot
barsizes <- bar.high - bar.low + 1
bardims <- cbind(bar.low, bar.high)
seqs <- function(X) unlist(apply(X, 1,
function(v) seq(v[1],v[2])))
x.all <- 1:length(state)
x.X <- x.all[state=="X"]
x.X <- rep(x.X, barsizes[state=="X"])
y.X <- seqs(bardims[state=="X",])
x.O <- x.all[state=="O"]
x.O <- rep(x.O, barsizes[state=="O"])
y.O <- seqs(bardims[state=="O",])
r <- range(c(bar.high,bar.low))
plot(1:length(state), ylim=r,
type="n",xaxt="n",yaxt="n", xlab=xlab,ylab=ylab)
## axes
x.axpt <- seq(1,max(x.all),by=grid.x)
abline(v=x.axpt,col=16,lty=2)
if(missing(times)) times<-1:n
axis(1,x.axpt,labels=times[bar.first[x.axpt]])
y.axpt <- pretty(r*boxsize,nint=grid.y)
y.axpt <- y.axpt[y.axpt>min(r*boxsize) & y.axpt<max(r*boxsize)]
axis(2,y.axpt/boxsize, y.axpt, adj=1)
abline(h=y.axpt/boxsize,col=16,lty=2)
## points
points(x.X,y.X,pch="X",col=8)
points(x.O,y.O,pch="O",col=2)
## add Java interactivity
bar.first <- c(bar.first, length(state)+1)
for(i in 1:length(state)) {
java.identify(x1=i,
labels=paste(times[bar.first[i]],"-",
times[bar.first[i+1]-1]," High",
format(bar.high[i]*boxsize,nsmall=2),
"Low",format(bar.low[i]*boxsize,nsmall=2)), adj=0.4)
}
#title(paste(boxsize,"x",thresh))
}