my: R tools for quant research

#' read string data from target dir and parse the string according to specified pattern
#' 
#' @param dtaDir string
#' @param pattern string
#' @return data frame
#' @export
loadStr <- function(dtaDir, 
                    pattern='R|X1|X2|time|xchange|ticker|price|total_Volume|BP1|BV1|SP1|SV1|OI|settle_Price1|Volume|BP2|BP3|BP4|BP5|BV2|BV3|BV4|BV5|SP2|SP3|SP4|SP5|SV2|SV3|SV4|SV5|limit_up|limit_dn|open|cum_High|cum_Low|close|OI1|cum_VWAP|totalAmount|Amount',
                    colClass=list(cha=c(1,4,5,6), int=c(8,10,12,13,15,20,21,22,23,28,29,30,31,38), dbl=c(7,9,11,14,16,17,18,19,24,25,26,27,32,33,34,35,36,37,39,40,41),logi=c(2,3)),
                    ...)
{
  colnms <- unlist(strsplit(pattern,'\\|'))

  dta <- tryCatch(scan(dtaDir, what='', quiet=TRUE, sep = '~', ...), error=function(e)NULL)
  if(length(dta))
  {
    dta <- do.call('rbind',strsplit(dta, '\\|'))
    dta <- as.data.frame(dta, stringsAsFactors=FALSE)
    n <- ncol(dta)
    colClass <- lapply(colClass, function(x){
      return(x[x<=n])
    })
    colnms <- head(colnms,n)

    # set precision of variables
    if(is.null(dta)) return(NULL) else {
      if(length(colClass$int))
      {
        for(i in colClass$int[colClass$int<=ncol(dta)])
        {
          dta[,i] <- as.integer(dta[,i])
        }
      }
      if(length(colClass$logi[colClass$logi<=ncol(dta)]))
      {
        for(i in colClass$logi)
        {
          dta[,i] <- as.logical(dta[,i])
        }
      }
      
      if(length(colClass$dbl))
      {
        for(i in colClass$dbl[colClass$dbl<=ncol(dta)])
        {
          dta[,i] <- as.numeric(dta[,i])
        }
      }
    }
  # set colnames of dta
#   dta <- dta[, 1:(ncol(dta)-1)]

#   dta <- dta[, 1:n]
  names(dta)[seq_along(colnms)] <- colnms#[1:n]

#   dta$time <- sprintf('%s%s',ifelse(dta$time<10^8, '0',''),dta$time)
  dta$time <- sprintf('%s:%s:%s.%s', substr(dta$time,1,2), substr(dta$time,3,4), substr(dta$time,5,6),substr(dta$time,7,9))
  
  return(dta)
  } else return(NULL)
}


#' update local data files(night market)
#' 
#' keep local data files updated to the latest
#' @param tickers string vector. specify target tickers to save. if null, all existed tickers on save2path will be downloaded.
#' @param save2path string. specify target dir to save tick data to
#' @param shareDir string. specify the mapping driver of 'share', default 'Y:/'
#' @return NULL
#' @export
updateNightTick <- function(save2path='/home/yuanwei/data/night', shareDir=c('/mnt/futuredata/ZZFE/level2/stringl2/night','/mnt/futuredata/Dce/string/night','/mnt/futuredata/SHFE/string/night'), ...)
{
  temp = sapply(shareDir, function(x)list.files(x,full=FALSE))
  itemDict <- do.call('rbind', strsplit(unlist(temp), '_'))
  itemDict = data.frame(rep(shareDir, lapply(temp, length)), itemDict, row.names = NULL, stringsAsFactors = FALSE)
  f <- sprintf('%s/%s',itemDict[,1], paste(itemDict[,2], itemDict[,3], sep='_'))
  if(length(f)==0) return(NULL)

  for(i in seq_along(f))
  {
    dates <- substr(unlist(list.files(f[i],'[0-9\\-].txt$', full.names=FALSE)),1,10)
    if(!dir.exists(sprintf('%s/%s/', save2path, itemDict[i, 2])))dir.create(sprintf('%s/%s/', save2path, itemDict[i, 2]))
    dates <- setdiff(dates,gsub('.rda','',list.files((sprintf('%s/%s/', save2path, itemDict[i, 2])), full.names=FALSE)))
    
    cat(sprintf('%s(%s)(%s ~ %s) to update',itemDict[i,2],length(dates), min(dates), max(dates)))
    
    if(length(dates)==0) {
      cat(' local data base is already the latest version.\n')
      next
    }
    
    for(date in dates)
    {
      dta <- loadStr(dtaDir=sprintf('%s/%s.txt',f[i],date),...)
      
      assign(itemDict[i,2], dta)
      save(list=c(itemDict[i,2]), file=sprintf('%s/%s/%s.rda',save2path,itemDict[i,2],date))
      cat('.')
    }
    cat('over!\n')
  }
  
  cat(sprintf('%s tickers under the folder<%s> are updated!\n', length(tickers), save2path))
  return(invisible(NULL))
}

#' extract clock-wise bar from tick data
#' 
#' generic function for extracting clock-wise bar(sec bar, minute bar, hour bar or even daily bar) from tick data. 
#' @param dta data frame or matrix, with at least fields of date, time, price and volume optional. 
#' @param start.point character. specify the start point of each bar in the format of 'hh:mm:ss', default '00:00:00'
#' @param len character. specify the length of each bar in the format of 'hh:mm:ss'. if larger than 2 hours('02:0:00), daily bar data is returned. default '00:01:00'.
#' @param timespan ascendingly ordered character vector. specify the normal trading time period for invalid data filter. default c('09:15:00', '11:29:59', '13:00:00', '15:14:59'), which is the case of stock index future data.
#' @param volume.save whether to keep the volume in return bar data. default TRUE.
#' @return A dataframe with the fileds of Date, Time, Open, High, Low, Close and Volume optional.
#' @seealso Tick2bar.vol, OHLC.plot
#' @export

Tick2bar.time <- function(dta, len = '00:01:00',  timespan = NULL, volume.save = TRUE, start.point = '00:00:00')
{
#  require('xts')
  
  n <- length(timespan)/2
  stopifnot(n%%1==0)
  
  colnames(dta) <- tolower(colnames(dta))
  start.point <- chron::times(start.point)
  len <- chron::times(len)
  if(nrow(dta)==0) return(NULL)
  dta$ID <- 1:nrow(dta)
  if(class(dta[,'time'])!='times') dta[,'time'] <- chron::times(dta[,'time'])
  
  if(is.null(timespan))
  {
    if(grepl('IF',dta$symbol[1]))
      timespan <- c('09:15:00','11:30:01','13:00:00','15:15:01')
    else 
      timespan <- c('09:00:00','10:15:01','10:30:00','11:30:01','13:30:00','15:00:01')
    
    timespan <- chron::times(timespan)
    TS <- matrix(as.double(chron::times(timespan), digits=12), ncol=2, byrow=TRUE)
  } else 
  {
    timespan <- chron::times(timespan)
    TS <- matrix(as.double(chron::times(timespan), digits=12), ncol=2, byrow=TRUE)
  }
  dta <- dta[rowSums(apply(TS, 1, function(x)dta[,'time']>=x[1] & dta[,'time']<x[2]))>0,]
  if(nrow(dta)==0) return(NULL)
  
  dtm <- as.numeric(format(as.double(dta[,'time']),digit=12))
  
  if(len>='02:00:00')
  {
    TM <- range(timespan)
    lab <- as.character(tail(TM,1))
  } else
  {
    TM <- chron::times(c(unlist(apply(TS, 1, function(x)seq(from=x[1]+start.point, to=x[2], by=len)))))
    lab <- as.character(TM + len - chron::times('00:00:01'))
    TM <- c(TM, tail(TM, 1)+len)
  }
  
  inx <- as.character(cut(dtm, TM, right=FALSE, include.lowest=TRUE, ordered_result=FALSE,labels=lab))
  
  if(volume.save)
  {
    res <- aggregate(1:nrow(dta), list(Time=inx), function(id){
      with(dta[id, ], c(head(price,1),
                        max(price),
                        min(price),
                        tail(price,1),
                        mean(price*volume)/mean(volume),
                        tail(sp1,1),
                        tail(bp1,1),
                        sum(volume),
                        tail(ID,1)))})
    res <- do.call('data.frame', list(unclass(res), stringsAsFactors=FALSE))
    names(res) <- c('Time','Open','High','Low','Close','VWAP','SP1','BP1','Volume','tickID')
  } else 
  {
    res <- aggregate(1:nrow(dta), list(Time=inx), function(id){
      with(dta[id, ], c(head(price,1),
                        max(price),
                        min(price),
                        tail(price,1),
                        tail(sp1,1),
                        tail(bp1,1),
                        tail(ID,1)))})
    res <- do.call('data.frame',list(unclass(res), stringsAsFactors=FALSE))
    names(res) <- c('Time','Open','High','Low','Close','SP1','BP1','tickID')
  }
  
  if('date' %in% colnames(dta)){
    res <- data.frame(Symbol=dta$symbol[1], Time=lab, res[match(lab, res$Time),-(1)], row.names=NULL, stringsAsFactors=FALSE,check.rows=FALSE,check.names=FALSE)
  } else{
    res <- data.frame(Symbol=dta$symbol[1], Time=lab, res[match(lab, res$Time),-(1)], row.names=NULL, stringsAsFactors=FALSE,check.rows=FALSE,check.names=FALSE)
  }
  
  #res <- xts(res[,-(1:2)], as.POSIXlt(paste(res$Date,res$Time)))

  return(res)
}


#' extract volume-wise bar from tick data
#' 
#' generic function for extracting volume-wise bar from tick data.
#' @param dta data frame or matrix, with at least fields of date, time, price and volume optional. ORIGINAL tick data from data provider
#' @param unit integer. specify the unit of volume chunk as a bar. default 1200
#' @param timespan ascendingly ordered character vector. specify the normal trading time period for invalid data filter. default c('09:15:00', '11:29:59', '13:00:00', '15:14:59'), which is the case of stock index future data.
#' @return A dataframe with the fileds of Date, ID, Time, Open, High, Low, Close and Volume.
#' @seealso Tick2bar.time, OHLC.barplot
#' @export

Tick2barBy <- function(dta, By, unit = 1200, timespan =NULL)
{
  n <- length(timespan)/2
  stopifnot(n%%1==0)
  colnames(dta) <- tolower(colnames(dta))
  
  if(!is.null(timespan))
  {
    TS <- matrix(timespan, ncol=2, byrow=TRUE)
    dta <- dta[rowSums(apply(TS, 1, function(x)dta[,'time']>=x[1] & dta[,'time']<=x[2]))>0, ]
  }
  
  vol.total <- By
  if(tail(vol.total,1))
  {
    
    loc <- unclass(cut(vol.total, seq(vol.total[1]-unit/2, tail(vol.total,1)+unit/2, by=unit)))
    from <- c(0, which(diff(loc)!=0))+1
    to <- c(tail(from,-1)-1, length(vol.total))
    res <- sapply(seq_along(from), function(i){
      c(Open=dta[from[i],'price'],
        High=max(dta[from[i]:to[i],'price']),
        Low=min(dta[from[i]:to[i],'price']),
        Close=dta[to[i],'price'],
        VWAP=sum(dta[from[i]:to[i],'price']*dta[from[i]:to[i],'volume'])/sum(dta[from[i]:to[i],'volume']),
        SP1=dta[to[i],'sp1'],
        BP1=dta[to[i],'bp1']
      )
    })
    res <- data.frame(Time=dta$time[to], t(res), tickID=to, row.names = NULL)
  } else 
  {
    res <- data.frame(Time=tail(dta[,'time'],1),Open=NA, High=NA, Low=NA, Close=NA, VWAP=NA, SP1=NA, BP1=NA, tickID=NA, row.names=NULL)
  }
  
  return(res)
}


#' load original data and reshape into time-bar
#' 
#' load tick data from 'share' server and then reshape it into time-bar data
#' @param ticker string. 
#' @param start string(YYYY-MM-DD) or date. specify the start date of bar data. If null, take the earliest as possible
#' @param end string(YYYY-MM-DD) or date. specify the end date of bar data. If null, take the latest as possible
#' @param localDtaPath string. specify local dir where the tick data(.rda) files are saved
#' @param ... arguments to be passed to <tick2bar.time>
#' @return A dataframe or NULL. 
#' @export

loadBar <- function(ticker, start=NULL, end=NULL, localDtaPath, ...)
{
  require(foreach)
  
  dtadir <- sprintf('%s/%s/', localDtaPath, ticker)
  
  filenms <- list.files(dtadir, '.rda$', full.names=FALSE)
  dates <- substr(filenms, 1, 10)
  if(!is.null(start)) dates <- dates[dates>=start]
  if(!is.null(end)) dates <- dates[dates<=end]
  filedir <- sprintf('%s/%s.rda', dtadir, dates)
  
  if(length(dates)) cat(sprintf('Download %s (%s ~ %s)', ticker, min(dates), max(dates))) else cat('No data files found!')
  res <- foreach(ff = filedir, .combine='rbind')%do%
  {
    load(ff)
    if(is.null(get(ticker)))
    {
      res0 <- NULL
    } else res0 <- Tick2bar.time(get(ticker), ...)
    
    cat('.')
    return(res0)
  }
  cat('Over!\n')
  
  return(res)
}

#' plot american candlestick chart
#' 
#' @param OHLC data frame, with at least fields of O-H-L-C, e.g. return value of Tick2bar.* function
#' @param Time character vector, specify the time stamp of each bar. if NULL, try to find time field from OHLC. default NULL
#' @param up.col character, specify colour for up-ward bars
#' @param dn.col character, specify colour for down-ward bars
#' @param main string
#' @param sub string
#' @param lwd integer
#' @param mar integer vector
#' @param cex.axis numeric value
#' @param tcl integer
#' @param par.recover logical, whether to recover par settings after the plot. default TRUE
#' @param ... further arguments to be passed to <par>
#' @return NULL
#' @seealso Tick2bar.time, Tick2bar.vol
#' @export
OHLC.plot <- function(OHLC, Time=NULL, up.col='red2', dn.col='green4', main='', sub='', ylab='',lwd=1, mar=c(4,3,3,1), cex.axis=.8, tcl=-.1, axes=list(x=TRUE, y=TRUE), par.recover=TRUE, between=NULL, type='Japanese',...)
{
  type <- match.arg(type,c('American', 'Japanese'))
  if(length(Time)>0)
  {
    stopifnot(length(Time)==nrow(OHLC))
  } else if(any(grepl('time', names(OHLC), ignore.case=TRUE))) Time = OHLC$Time else Time = 1:nrow(OHLC)
  
  old.par <- par(mar=mar, cex.axis=cex.axis,tcl=tcl,...)
  
  n.bar <- nrow(OHLC)
  if(is.null(between)) between <- 1/4
  att <- round(seq(1, n.bar, len=20),0)
  
  plot(1,1,xlim=c(1,n.bar),ylim=range(OHLC[,c('High','Low')],na.rm=TRUE),type='n',main=main,sub=sub,xlab='',ylab=ylab, axes=FALSE)
  if(axes$x) {
    abline(v=att, col='grey90', lty='dotted')
    axis(1,att,labels=as.character(Time)[att])
  }
  if(axes$y) {
    axis(2,las=2)
  }
  box()
  
  hl <- c(OHLC[1,'Close'] > OHLC[1,'Open'],diff(OHLC[,'Close']) >= 0)
  if(type=='American')
  {
    segments(1:nrow(OHLC),OHLC[,'High'],1:nrow(OHLC),OHLC[,'Low'],col=c(dn.col,up.col)[hl/2+1.5],lwd=lwd)
    segments(1:nrow(OHLC)-between,OHLC[,'Open'], 1:nrow(OHLC),OHLC[,'Open'],col=c(dn.col,up.col)[hl/2+1.5],lwd=lwd)
    segments(1:nrow(OHLC),OHLC[,'Close'], 1:nrow(OHLC)+between,OHLC[,'Close'],col=c(dn.col,up.col)[hl/2+1.5],lwd=lwd)
  } else if(type=='Japanese')
  {
    bw <- c(-between, between,between, -between)
    col <- c(dn.col,up.col)[hl/2+1.5]
    for(i in 1:n.bar)
    {
      polygon(x=i+bw,y=rep(OHLC[i,c('Open','Close')],each=2),border=col[i], col=col[i])
    }
    segments(1:n.bar,OHLC$Low, 1:n.bar,OHLC$High,col=col,lwd=1)
  }
  
  if(par.recover) par(old.par)

  return(invisible(list(up.col=up.col, dn.col=dn.col, lwd=lwd, mar=mar, cex.axis=cex.axis, tcl=tcl, between=between,type=type)))
}

#' zoom in the details of plot
#' 
#' zoom in specified window of plot with your cursor
#' @param dta data frame/matrix. dta used to generate a snapshot
#' @param myplot string. user defined plot function name(return y variable from the key plot)
#' @seealso play
#' @details the arguments of function myplot include 2 parts: 1) datafeed(dta) of plot 2)other optional arguments(...). excpet plotting, myplot should return y-variable of the key part of plot, with optional attribute of note to cat.
#' @export
zoom <- function(dta, myplot, ...){
  myplot <- match.fun(myplot)
  n <- NROW(dta)
  if(is.null(time)) time <- 1:n
  
  sigLoc <- list('sig'%in%names(dta))
  if(sigLoc[[1]]) {
#     dta$sig <- sign(dta$sig)
    sigLoc[[2]] <- which(!is.na(tail(dta,1)$sig))
  }
  
  lastView <- NULL
  lastView[[1]] <- timespan <- c(1, n)
  X11(title='<zoom mode>') #windows()
  i <- 0
  
  cat('zoom mode ready:
      \t double click two ends of window to <zoom in>
      \t double click left margin to <quit>
      \t double click right margin to <backward view>
      \t double click bottom margin back to <birdView> ...\n') #      \t double click top margin to <forward view>
  
  while(TRUE)
  {
    cat(sprintf('(%i ~ %i)\n',timespan[1],timespan[2]))
    dev.hold()
#     if(timespan[2]==n){
#       ans <- myplot(dta, ...)
#     } else {
      ans <- myplot(dta[timespan[1]:timespan[2],], ...)
#       if(!is.null(highlight)){
#         highlight <- NULL
#       }
#     }
    dev.flush()
    
    if('note' %in% names(attributes(ans)) && (!is.na(attr(ans,'note'))) && nchar(attr(ans,'note'))) cat(sprintf('* %s\n',attr(ans,'note')))
#     ylim <- min(dta[timespan[1]:timespan[2],target])
    ylim <- range(ans,na.rm=TRUE)
    loc <- locator(2)
    
    if(!is.null(loc)){
      if(max(loc$x)<1){
        dev.off()
        break
      } else if(min(loc$x)>diff(timespan)+1){
        if(i>1){
          timespan <- lastView[[i]]
          i <- i-1
        } else {
          i <- 0
          lastView <- NULL
          timespan <- c(1,n)
        }
      } else if(max(loc$y)<ylim[1]){
        i <- i+1
        lastView[[i]] <- timespan
        timespan <- c(1,n)
      } else 
#         if(min(loc$y)>ylim[2]){
#         if(!is.null(lastView) && i<=length(lastView)){
#           i <- i+1
#           timespan <- lastView[[i]]
#         }
#       } else 
        {
        i <- i+1
        lastView[[i]] <- timespan
        loc$x <- pmax(1, pmin(loc$x,diff(timespan)+1))
        timespan <- seq(max(1,timespan[1]-1),min(n,timespan[2]+1))[range(round(loc$x))]
      }
    }
  }
  
  cat(' quit <zoom> mode!\n')
  return(invisible(timespan[1]:timespan[2]))
}

#' animation play
#' 
#' play animation step by step
#' @param dta data.frame/matrix. dta used to generate a figure
#' @param myplot string. user defined plot funciton name
#' @param hold integer. number of seconds to hold each snapshot
#' @param window integer. length of window of each snapshot
#' @param stepwise integer/vector/NULL. specify the track/steps of play
#' 
#' @seealso zoom
#' @export
play <- function(dta, myplot, hold=.5, window=NA, cumView=FALSE, stepwise=NULL, ...)
{
  stopifnot(!is.null(dim(dta)))
  window <- ifelse(is.na(window), NROW(dta), window)
  myplot <- match.fun(myplot)
  n <- NROW(dta)
  save <- FALSE
  
  if(save)
  { ## not work properly...
    require('animation')
    saveGIF(
      for(i in stepwise)
      {
#         dev.hold()
        myplot(dta[max(1,i-window+1):i,],...)
#         dev.flush()
      }, movie.name='~/animation.gif', interval=hold
    )
  } else 
  {
    cat('playing...\n press <Alt> to suspend and once again to continue\n')
    if(is.null(stepwise)) stepwise <- 1:n else stepwise <- stepwise[stepwise>=1 & stepwise<=n]
    x11(title='<play mode> press ESC to quit')
    
    for(i in stepwise)
    {
      dev.hold()
      myplot(dta[ifelse(cumView, 1, max(1,i-window+1)):i,],...)
      dev.flush()
      Sys.sleep(hold)
    }
  }
}


#' example sub-function of zoom
#' 
#' show an example function of 'myplot' which is a parameter of zoom function. here we test to zoom in the tick data - order book.
#' 
#' @seealso zoom
#' @export
zoom.myplot <- function(dta, n)
{
  stopifnot(all(c('Time','Price','BV1','SV1','BP1','SP1','Volume')%in%colnames(dta)))
  if(nrow(dta)==n)
  {
    layout(matrix(1))
    plot(ifelse(dta[,'Price']<.001, NA, dta[,'Price']),type='l',col='grey',ylab='',pch=20,cex=.5)
    if('sig'%in%names(dta))
    {
      loc <- which(!is.na(dta$sig))
      points(loc, ifelse(dta$sig[loc]>0, dta$SP1[loc], dta$BP1[loc]),col=(3:2)[dta$sig[loc]/2+1.5],pch=20,lwd=2)
    }
  } else 
  {
    layout(matrix(1:2))
    par(mar=c(0,3,2,2),cex.axis=.7)
    matplot(dta[,c('Volume','BV1','SV1')],type='l',lty=1,col=c('grey','red','green'),lwd=2,axes=FALSE,ylab='')
    axis(2,las=2)
    box()
    grid()
    par(mar=c(2,3,0,2))
    matplot(dta[,c('BP1','SP1')],col=2:3,lty=1,type='l',ylab='',axes=FALSE,ylim=range(dta[,c('BP1','SP1')][dta[,c('BP1','SP1')]>.001]))
    points(ifelse(dta[, 'Price']>.001, dta[, 'Price'], NA), col='grey', pch=20, cex=.7)
    axis(1)
    axis(2,las=2)
    box()
    points(ifelse(dta[,'Volume']>0, dta[,'Price'], NA),col='grey', pch=20, cex=.5)
    if('sig'%in%names(dta)) points(ifelse(dta$sig>0,dta$SP1,dta$BP1),col=(3:2)[dta$sig/2+1.5],pch=20,lwd=2)
    box()
    grid()
  }
  
  ans <- dta$BP1
  attr(ans,'note') <- sprintf('%s~%s', dta$Time[1],tail(dta$Time,1))
  return(ans)
}

#' image plot with matrix
#' 
#' @param x matrix
#' @return NULL 
#' @export
myImagePlot <- function(x, ...){
    min <- min(x)
    max <- max(x)
    yLabels <- rownames(x)
    xLabels <- colnames(x)
    title <-c()
    # check for additional function arguments
    if( length(list(...)) ){
        Lst <- list(...)
        if( !is.null(Lst$zlim) ){
            min <- Lst$zlim[1]
            max <- Lst$zlim[2]
        }
        if( !is.null(Lst$yLabels) ){
            yLabels <- c(Lst$yLabels)
        }
        if( !is.null(Lst$xLabels) ){
            xLabels <- c(Lst$xLabels)
        }
        if( !is.null(Lst$title) ){
            title <- Lst$title
        }
    }
    # check for null values
    if( is.null(xLabels) ){
        xLabels <- c(1:ncol(x))
    }
    if( is.null(yLabels) ){
        yLabels <- c(1:nrow(x))
    }
    
    layout(matrix(data=c(1,2), nrow=1, ncol=2), widths=c(5,1), heights=c(1,1))
    
    # Red and green range from 0 to 1 while Blue ranges from 1 to 0
    ColorRamp <- rgb( seq(0,1,length=256),  # Red
                      seq(0,1,length=256),  # Green
                      seq(1,0,length=256))  # Blue
    ColorLevels <- seq(min, max, length=length(ColorRamp))
    
    # Reverse Y axis
    reverse <- nrow(x) : 1
    yLabels <- yLabels[reverse]
    x <- x[reverse,]
    
    # Data Map
    par(mar = c(3,5,2.5,2))
    image(1:length(xLabels), 1:length(yLabels), t(x), col=ColorRamp, xlab="",
          ylab="", axes=FALSE, zlim=c(min,max))
    if( !is.null(title) ){
        title(main=title)
    }
    axis(BELOW<-1, at=1:length(xLabels), labels=xLabels, cex.axis=0.7)
    axis(LEFT <-2, at=1:length(yLabels), labels=yLabels, las= HORIZONTAL<-1,
         cex.axis=0.7)
    
    # Color Scale
    par(mar = c(3,2.5,2.5,2), cex=.7)
    image(1, ColorLevels,
          matrix(data=ColorLevels, ncol=length(ColorLevels),nrow=1),
          col=ColorRamp,
          xlab="",ylab="",
          xaxt="n")
    
    layout(1)
}

#' ordbook building with pv info
#' 
#' @param p data.frame/matrix price, [BS]1,[BS]2,[BS]3,[BS]4,...
#' @param v data.frame/maxtirx volume, mapping with price
#' @param tick numeric/integer minimum tick
#' @param bsFlag integer 1: buy, -1: sell
#' @return array ordbook
#' @export

pv2ordbook <- function(p, v, tick, bsFlag, locf=TRUE)
{
  # bsFlag=1, bpv, b1,b2,b3,...
  # bsFlag=-1, spv, s1,s2,s3...
  nr <- nrow(p)
  nc <- ncol(p)
  stopifnot(nc==ncol(v) && nr==nrow(v))
  p <- as.matrix(p)
  p <- ifelse(p<.0001, NA, p)
  v <- as.matrix(v)
  
  prng <- range(p, na.rm = TRUE)
  if(any(is.na(prng))) return(NULL)
  
  pgrid <- seq(prng[1], prng[2], by=tick)
  npg <- length(pgrid)
  ord <- array(NA, dim = c(nr, npg), dimnames = list(NULL, pgrid))
  
  l <- (p-prng[1])/tick+1
  storage.mode(l) <- 'integer'
  l <- 1:nr+(l-1)*nr
  l1 <- l[,1]
  l2 <- l[,nc]
  
  ord[l[!is.na(l)]] <- v[!is.na(l)]
  
  l0 <- 1:nr+(matrix(1:npg, byrow=T, ncol=npg, nrow=nr)-1)*nr
  
  ord[(l0-l1)*bsFlag>0] <- 0
  ord[is.na(ord) & (l0-l2)*bsFlag>0] <- 0
  if(locf) ord <- na.locf(ord, na.rm=F)
  
  attr(ord, 'loc') <- l1
  attr(ord, 'I') <- l0
  
  return(ord)
}


#' change time to integer
#' 
#' @param time hh:mm:ss:mmm...
#' @return vector
#' @export
time2int <- function(tt)
{
  tt <- do.call('rbind', strsplit(tt, '(:)|(\\.)'))
  storage.mode(tt) <- 'integer'
  tt[,4] <- round(tt[,4]*10^-6)
  
  return(tt%*%c(3600000000, 60000000, 1000000, 1))
}