cranvas: Interactive statistical graphics based on Qt

Documented in qtime

##' Draw an interactive time plot
##'
##' Draw an interactive time plot.
##'
##' Arrow up/down: in-/de-crease size of points.
##'
##' Arrow left/right: wrap the time series in the initial mode, and
##' drag the series in the series selection mode.
##'
##' Shift + right: Time series will be folded
##' directly to the width of maximal value in argument shift.
##'
##' Shift + left: Time series will be backed to the original xaxis
##' position.
##'
##' Key '+'/'-': de-/in-crease alpha level (starts at alpha=1 by
##' default).
##'
##' Key 'u'/'d': separate/mix the series groups or the period by shifting them up
##' and down.
##'
##' Shift + 'u'/'d': for multivariate y's, separate/mix them by shifting
##' up and down.
##'
##' Key 'h'/'v': horizontally or vertically faceting the series.
##' 
##' Shift + 'h'/'v': horizontally or vertically mix the faceting panels.
##' 
##' Key 'g': change the wrapping period circularly in the values of
##' parameter 'shift'.
##'
##' Key 'm': Switch the mode for series selection. Default to be off.
##' When there are more than one series in the plot, users can turn it
##' on to hold a series and shift the series horizontally by dragging
##' with the mouse.
##'
##' Key 'y': y-wrapping
##'
##' Shift + 'y': y-wrapping backward
##'
##' Key 'r': switch to the area plot
##'
##' Key 'f': fold the series to a horizon plot
##'
##' Wheel: Zoom in/out. Then users can drag the series horizontally
##' to see the details.
##'
##' @param time the variable indicating time on the horizontal axis.
##' @param y a vertor of all the variable names of interest.
##' @param data Mutaframe data generated by \code{\link{qdata}}.
##' @param vdiv a vector of variable names that will be used in faceting vertically.
##' @param hdiv a vector of variable names that will be used in faceting horizontally.
##' @param shift Wrapping speed selector. The default possible speeds
##' are 1,7(for days a week),12(for months),24(for hours).
##' @param size Point size, default to be 2.
##' @param alpha Transparency level, 1=completely opaque, default to be 1.
##' @param asp Ratio between width and height of the plot.
##' @param series.stats Whether to show the statistics which measure the similarity between series when wrapping. It gives the ACF, corr, and R square for one, two, and more series respectively.
##' @param fun.base a function to compute the baseline of the area plot
##' @param main main title for the plot.
##' @param xlab label on horizontal axis, default is name of x variable
##' @param ylab label on vertical axis, default is name of y variable
##' @param infolab the variable(s) shown when identifying the points.
##' Note that the x, y, and group information is already shown.
##' @return A time plot.
##' @author Xiaoyue Cheng
##' @example inst/examples/qtime-ex.R
##' @export
##' @family plots

qtime = function(time, y, data, vdiv=NULL,hdiv=NULL,
                  shift=c(1,4,7,12,24), alpha=1, size=2, asp=NULL,
                  series.stats=ifelse(nrow(data)<1000,TRUE,FALSE), fun.base=min,
                  main=NULL, xlab=NULL, ylab=NULL,infolab=NULL,...){

  #####################
  ## data processing ##----------
  #####################

  data = check_data(data)
  call = as.list(match.call()[-1])
  time = as.character(call$time)
  y = as.character(call$y)
  if(y[1] == "c") y = y[-1]
  vdiv = as.character(call$vdiv)
  if(length(vdiv) && vdiv[1] == "c") vdiv = vdiv[-1]
  hdiv = as.character(call$hdiv)
  if(length(hdiv) && hdiv[1] == "c") hdiv = hdiv[-1]
  #if(length(intersect(vdiv,hdiv))) hdiv = setdiff(hdiv, vdiv)
  group = union(vdiv,hdiv)
  tdata = time_qdata(data, y, c(time,group))
  meta = Time.meta$new(varname = list(x = time, y = y), minor = 'xy')
  meta$brush = brush(tdata)
  time_meta_initialize(meta, call, data=tdata, hdiv=hdiv, vdiv=vdiv,
                       shift=shift, alpha=alpha, size=size, asp=asp,
                       main=main, xlab=xlab, ylab=ylab, infolab=infolab)
  #if ('g' %in% names(meta$varname) & series.stats) series.stats = FALSE
  meta$active = TRUE
  tree = createTree(data.frame(x=meta$data$xtmp,y=meta$data$ytmp))
  update_meta_group(meta)
  update_meta_xwrap_color(meta,tdata)
  compute_area(meta,tdata,fun.base)
  
  ####################
  ## event handlers ##----------
  ####################

  mouse_press = function(layer, event) {
    common_mouse_press(layer, event, tdata, meta)
    if ((meta$mode$serie | meta$mode$zoom) & event$button() == Qt$Qt$LeftButton) {
      meta$brush$cursor = 18L
      meta$data$xstart = meta$data$xtmp
    }
  }

  mouse_move = function(layer, event) {
    if (event$button() != Qt$Qt$NoButton) {
      meta$brush$cursor = 0L
    }
    meta$pos = as.numeric(event$pos())
    if (meta$mode$serie) {
      hits = selected(tdata)[meta$data$order]
      meta$data$xtmp[hits] = meta$data$xstart[hits] + meta$pos[1] - meta$start[1]
      qupdate(layer.brush)
      return()
    }
    if (meta$mode$zoom){
      meta$limits[1:2] = meta$limits[1:2] - meta$pos[1] + meta$start[1]
      if (meta$limits[1,1]<extend_ranges(meta$data$xtmp)[1]) {
        meta$limits[1:2] = meta$limits[1:2] - meta$limits[1,1] + extend_ranges(meta$data$xtmp)[1]
      } else if (meta$limits[2,1]>extend_ranges(meta$data$xtmp)[2]) {
        meta$limits[1:2] = meta$limits[1:2] - meta$limits[2,1] + extend_ranges(meta$data$xtmp)[2]
      }
      meta$xat = axis_loc(meta$limits[1:2])
      meta$xlabels = format(meta$xat)
      return()
    }
    rect = as.matrix(qrect(update_brush_size(meta)))
    hits = rectLookup(tree, rect[1, ], rect[2, ])
    if (length(hits)<1) {
      selected(tdata) = FALSE
      return()
    }
    selected(tdata) = meta$data$order[hits]
  }

  mouse_release = function(layer, event){
    mouse_move(layer, event)
    if (meta$mode$serie) {
      meta$limits[1:2] = extend_ranges(range(meta$data$xtmp, na.rm = TRUE))
      tree <<- createTree(data.frame(x=meta$data$xtmp,y=meta$data$ytmp))
    }
  }

  mouse_wheel = function(layer, event) {
    pos = as.numeric(event$pos())
    lim = meta$limits
    p = (pos - lim[1, ]) / (lim[2, ] - lim[1, ])
    meta$limits[1:2] = extend_ranges(meta$limits[1:2], -sign(event$delta()) * 0.05 * c(p[1], 1 - p[1]))
    meta$keys = paste("Wheel: Zoom",ifelse(sign(event$delta())>0,"in","out"))
    tmprange = extend_ranges(unlist(meta$data$xtmp))
    meta$limits[1,1] = max(meta$limits[1,1],min(tmprange))
    meta$limits[2,1] = min(meta$limits[2,1],max(tmprange))
    meta$mode$zoom = ifelse(meta$limits[1,1]<=min(tmprange) & meta$limits[2,1]>=max(tmprange), FALSE, TRUE)
    meta$xat = axis_loc(meta$limits[1:2,1])
    meta$xlabels = format(meta$xat)
    qupdate(layer.keys)
  }

  identify_hover = function(item, event, ...) {
    if (!meta$brush$identify && !meta$mode$serie) return()
    meta$brush$cursor = 2L
    meta$pos = as.numeric(event$pos())
    rect = as.matrix(identify_rect(meta))
    if (meta$mode$serie){
      xdiff = diff(meta$limits[1:2])*0.9/min(sort(table(meta$data$vidgroup),decreasing=TRUE)[1],50)
      ydiff = diff(meta$limits[3:4])*0.9/meta$ngroup$vid
    } else {
      xdiff = meta$radius/layer.root$size$width() * diff(meta$limits[1:2])
      ydiff = meta$radius/layer.root$size$height() * diff(meta$limits[3:4])
    }
    rect = rect + matrix(c(-xdiff,xdiff,-ydiff,ydiff),nrow=2)
    meta$identified = rectLookup(tree, rect[1, ], rect[2, ])

    if (!length(hits <- meta$identified)) return()

    if (meta$mode$serie){
      hitgroup = meta$data[hits,c('xtmp','ytmp','vargroup','idgroup','vidgroup'),drop=FALSE]
      if (length(unique(hitgroup$vidgroup))>1){
        hitgroup$dist = sqrt(((hitgroup$xtmp-meta$pos[1])/xdiff)^2+((hitgroup$ytmp-meta$pos[2])/ydiff)^2)
        hitdist = tapply(hitgroup$dist,hitgroup$vidgroup,function(x){sum(1/(x+0.5))})
        hitgroupname = names(hitdist)[which.max(hitdist)]
        hitgroup = hitgroup[hitgroup$vidgroup==hitgroupname,,drop=FALSE]
      }
      hitsall = which(meta$data$vidgroup==hitgroup$vidgroup[1])
      selected(tdata) = meta$data$order[hitsall]
      qupdate(layer.brush)
      return()
    }

    qupdate(layer.identify)
  }

  key_press = function(layer, event){
    common_key_press(layer, event, tdata, meta)
    keys = c('M','G','F','U','D','R','Y','H','V','T','O','P','Left','Right','Up','Down')
    meta$shiftKey = shift_on(event)
    key = keys[match_key(keys,event)]
    if (!length(key)) return()
    switch(key,
           M = switch_serie_mode(meta, tdata),
           G = shift_wrap_gear(meta),
           F = switch_fold_mode(meta, tdata),
           U = separate_group(meta),
           D = mix_group(meta),
           R = switch_area_mode(meta),
           Y = y_wrap_forward(meta,tdata),
           H = horizontal_facet(meta),
           V = vertical_facet(meta),
           T = transpose_facet(meta),
           O = rotate_h_facet(meta),
           P = rotate_v_facet(meta),
           Left = x_wrap_backward(meta,tdata),
           Right = x_wrap_forward(meta,tdata),
           Up = size_up(meta),
           Down = size_down(meta)
    )
    tree <<- createTree(data.frame(x=meta$data$xtmp,y=meta$data$ytmp))
    qupdate(layer.point)
    qupdate(layer.line)
    qupdate(layer.area)
  }

  key_release = function(layer, event){
    common_key_release(layer, event, tdata, meta)
  }

  ############
  ## layers ##----------
  ############

  point_draw = function(layer,painter){
    col_fill = alpha(tdata$.color[meta$data$order], meta$data$fill*meta$alpha)
    col_stroke = alpha(tdata$.border[meta$data$order], meta$data$stroke*meta$alpha)
    qdrawGlyph(painter, qglyphCircle(r = meta$radius), meta$data$xtmp, meta$data$ytmp,
               fill=col_fill, stroke=col_stroke)
  }

  line_draw = function(layer,painter){
    qlineWidth(painter) = meta$radius / 2
    compute_line(meta, tdata)
    qdrawSegment(painter,meta$line$df$xs,meta$line$df$ys,
                 meta$line$df$xe,meta$line$df$ye,stroke=meta$line$df$col)
  }

  area_draw = function(layer,painter){
    if (! meta$mode$area) return()
    compute_area(meta, tdata, fun.base)
    qdrawPolygon(painter, meta$area$poly$x, meta$area$poly$y,
                 stroke=alpha(meta$area$color,0.01), fill=meta$area$color)
  }

  brush_draw = function(layer, painter) {

    if (any(is.na(meta$pos))) return()

    hits = selected(tdata)[meta$data$order]
    if (any(hits)) {compute_area(meta, tdata, fun.base); selected_draw(meta,b,hits,painter)}

    if (meta$mode$zoom || meta$mode$serie) return()

    draw_brush(layer, painter, tdata, meta)
  }

  identify_draw = function(item, painter, exposed, ...) {
    if (!meta$brush$identify || !length(hits <- meta$identified)) return()
    if (meta$ngroup$id==1) {
      info = data.frame(meta$varname$x,meta$data[hits,c('x','yorig','vargroup',meta$varname$identify),drop=FALSE])
    } else {
      info = data.frame(meta$varname$x, meta$data[hits,c('x','yorig','vargroup',meta$varname$identify,'idgroup'),drop=FALSE])
    }
    meta$identify.labels = sprintf('%s: %s\n%s: %s',
      meta$varname$x, paste(info[, 2], collapse = ', '),
      info$vargroup[1], paste(info[, 3], collapse = ', '))
    if (meta$ngroup$id>1) {
      meta$identify.labels = paste(meta$identify.labels,"\nGroup:",paste(info$idgroup,collapse=', '))
    }
    if (!is.null(meta$varname$identify)) {
      for (i in 1:length(meta$varname$identify)) {
        meta$identify.labels = paste(meta$identify.labels,"\n",meta$varname$identify[i],": ",paste(info[,4+i],collapse=', '),sep='')
      }
    }
    if (length(hits)>1){
      meta$identify.labels = paste("    ",length(hits)," points\n",meta$identify.labels,sep='')
    }
    draw_identify(layer, painter, tdata, meta)
    if (all(tdata$.size==tdata$.size[1])) {
      qdrawGlyph(painter, qglyphCircle(r = sqrt(meta$brush$size) * meta$radius),
                 meta$data$xtmp[hits], meta$data$ytmp[hits], stroke = meta$brush$color, fill = NA)
    } else {
      qdrawCircle(painter, meta$data$xtmp[hits], meta$data$ytmp[hits],
                  r = sqrt(meta$brush$size) * tdata$.size[meta$data$order][hits],
                  stroke = meta$brush$color, fill = NA)
    }
  }

  stats_draw = function(layer, painter){
    if (meta$ngroup$id > 1) return()
    if (meta$ngroup$xwrap == 1){
      ytmpacf = unname(tapply(meta$data$yscaled,meta$data$vargroup,function(z) acf(z,lag.max=max(30,max(meta$steplen$xwrap)),plot=FALSE)$acf[meta$steplen$xwrap[1]+1]))
      tmpprint = paste(meta$varname$y,": ACF(lag=",meta$steplen$xwrap[1],"):",round(ytmpacf,2),sep="")
    } else if (meta$ngroup$xwrap==2) {
      ytmpcor = as.vector(by(meta$data[,c('ytmp','xwrapgroup')],meta$data$vargroup,function(x){
        cor(x$ytmp[x$xwrapgroup==1][1:sum(x$xwrapgroup==2)],x$ytmp[x$xwrapgroup==2])
      }))
      tmpprint = paste(meta$varname$y,": Corr. of two series = ",round(ytmpcor,2),sep="")
    } else {
      if (nrow(meta$data)>1000) print(paste("Before the model:", Sys.time()))
      ytmpR2 = as.vector(by(meta$data[,c('xtmp','ytmp')],meta$data$vargroup,function(x){
        res=summary(lm(x$ytmp~factor(x$xtmp)))$r.squared
      }))
      tmpprint = paste(meta$varname$y,": R square = ",round(ytmpR2,2),sep="")
      if (nrow(meta$data)>1000) print(paste("After the model:", Sys.time()))
    }
    if (meta$mode$varUP) {
      qdrawText(painter,tmpprint,
                rep(meta$limits[1,1],meta$ngroup$y),meta$yat-diff(meta$yat[1:2])/2,
                halign='left',valign='bottom',color='gray50')
    } else {
      qdrawText(painter,paste(tmpprint,collapse="\n"),
                meta$limits[1,1],meta$limits[1,2],
                halign='left',valign='bottom',color='gray50')
    }
  }

  #####################
  ## draw the canvas ##----------
  #####################

  scene = qscene()
  layer.root = qlayer(scene)
  layer.title = qmtext(meta = meta, side = 3)
  layer.xlab = qmtext(meta = meta, side = 1)
  layer.ylab = qmtext(meta = meta, side = 2)
  layer.xaxis = qaxis(meta = meta, side = 1)
  layer.yaxis = qaxis(meta = meta, side = 2)
  layer.grid = qgrid(meta = meta)
  layer.keys = key_layer(meta)
  layer.point = qlayer(paintFun = point_draw,
                       limits = qrect(meta$limits),
                       hoverMoveFun = identify_hover,
                       mousePressFun = mouse_press,
                       mouseReleaseFun = mouse_release,
                       mouseMoveFun = mouse_move,
                       wheelFun = mouse_wheel,
                       keyPressFun = key_press,
                       keyReleaseFun = key_release,
                       focusInFun = function(layer, event) {
                         common_focus_in(layer, event, data, meta)
                       }, focusOutFun = function(layer, event) {
                         common_focus_out(layer, event, data, meta)
                       }, clip=TRUE)
  layer.line = qlayer(paintFun=line_draw,limits=qrect(meta$limits),clip=TRUE)
  layer.area = qlayer(paintFun=area_draw,limits=qrect(meta$limits),clip=TRUE)
  layer.brush = qlayer(paintFun=brush_draw, limits=qrect(meta$limits))
  layer.identify = qlayer(paintFun=identify_draw, limits=qrect(meta$limits))
  layer.keys = key_layer(meta)
  if (series.stats) layer.stats = qlayer(paintFun=stats_draw, limits=qrect(meta$limits))

  layer.root[0, 2] = layer.title
  layer.root[2, 2] = layer.xaxis
  layer.root[3, 2] = layer.xlab
  layer.root[1, 1] = layer.yaxis
  layer.root[1, 0] = layer.ylab
  layer.root[1, 2] = layer.grid
  if (series.stats) layer.root[1, 2] = layer.stats
  layer.root[1, 2] = layer.area
  layer.root[1, 2] = layer.line
  layer.root[1, 2] = layer.point
  layer.root[1, 2] = layer.brush
  layer.root[1, 2] = layer.identify
  layer.root[1, 2] = layer.keys

  ## set sizes of layers (arrange the layout)
  set_layout = function() {
    fix_dimension(layer.root,
                  row = list(id = c(0, 2, 3), value = c(prefer_height(meta$main),
                                                        prefer_height(meta$xlabels),
                                                        prefer_height(meta$xlab))),
                  column = list(id = c(1, 0, 3), value = c(prefer_width(meta$ylabels),
                                                           prefer_width(meta$ylab, FALSE),
                                                           10)))
  }
  set_layout()

  ## layout is dynamic (listen to changes in xlab/ylab/xlabels/ylabels...)
  meta$mainChanged$connect(set_layout)
  meta$xlabChanged$connect(set_layout); meta$ylabChanged$connect(set_layout)
  meta$xlabelsChanged$connect(set_layout); meta$ylabelsChanged$connect(set_layout)

  ## listeners on the data (which column updates which layer(s))
  d.idx = add_listener(tdata, function(i, j) {
    switch(j, .brushed = qupdate(layer.brush),
           .color = {
             qupdate(layer.point)
             qupdate(layer.line)
             qupdate(layer.area)
           }, {
             qupdate(layer.grid); qupdate(layer.xaxis); qupdate(layer.yaxis)
             layer.point$invalidateIndex()
             layer.line$invalidateIndex()
             layer.area$invalidateIndex()
             qupdate(layer.point)
             qupdate(layer.line)
             qupdate(layer.area)
           })
  })
  qconnect(layer.point, 'destroyed', function(x) {
    remove_listener(tdata, d.idx)
  })
  meta$brush$cursorChanged$connect(function() {
    set_cursor(view, meta$brush$cursor)
  })
  sync_limits(meta, layer.point, layer.line, layer.area, layer.brush, layer.identify,layer.keys,
              if (series.stats){layer.stats} else {NA})
  meta$manual.brush = function(pos) {
    mouse_move(layer = layer.point, event = list(pos = function() pos))
  }

  # aspect ratio
  if (is.null(asp)) {
    a <- asp_ratio(meta$data$xtmp,meta$data$ytmp)
    if (a<0.35) {
      xWidth <- 1280
      yWidth <- max(round(xWidth*a),320)
    } else {
      yWidth <- 750
      xWidth <- round(yWidth/a)
    }
  } else {
    yWidth <- 600
    xWidth <- round(yWidth*asp)
  }

  view = qplotView(scene=scene)
  view$setWindowTitle(meta$main)
  view$resize(xWidth,yWidth)
  attr(view, 'meta') = meta
  view
}

Time.meta = setRefClass("Time_meta",
                        contains = "CommonMeta",
                        fields = properties(list(
                        varname = 'list', # including the variable names for y, x, idgroup
                        ngroup = 'list', # including the number of groups for y, idgroup
                        data = 'data.frame', # with x,yorig,xtmp,ytmp,vargroup,idgroup,xwrapgroup,finalgroup,order,htvar,htid,htywrap,htfinal,areabaseline
                        mode = 'list', # including area,yfold,xwrap,zoom,serie,idSep,varUP,varDOWN
                        line = 'list', # including df,firstrow,lastrow
                        area = 'list', # including x,y,poly,color
                        hits = 'list',
                        cutbound = 'list', # including orig,cut
                        ywrapline = 'list',
                        yfoldline = 'data.frame',
                        facet = 'list', # hdiv, vdiv
                        steplen = 'list',
                        singleVarLen = 'integer',
                        shiftKey = 'logical',
                        linkID = 'character',
                        radius = 'numeric',
                        ylab.init = 'character',
                        brush = 'BRUSH'
                       )))

## Create a new mutaframe for drawing time plots
##
## The new mutaframe is only used for the qtime function.
## @param regular_qdata a data frame or mutaframe used for time plot
## @param yVar a character vertor of all the variable names of interest
## @param link a character vector of the variable names, to link two mutaframes
## @inheritParams qdata
## @return a mutaframe with multiple y's
time_qdata = function(regular_qdata, yVar, link) {
  yCol = length(yVar)
  data = as.data.frame(regular_qdata)
  usecol = colnames(data) %in% c(".brushed",".visible",".color",".border",".size")
  setting = data[, usecol]
  settingh = setting[0,]
  data = data[, !usecol]
  newdat = data.frame(.variable="A",.value=0,data[1,],stringsAsFactors=FALSE)[0,]
  for (i in 1:yCol) {
    tmpnewdat = data.frame(.variable=rep(yVar[i],nrow(data)),.value=data[,yVar[i]],data,stringsAsFactors=FALSE)
    tmpnewdat[,yVar[i]] = TRUE
    tmpnewdat[,yVar[-i]] = FALSE
    newdat = rbind(newdat, tmpnewdat)
    settingh = rbind(settingh, setting)
  }
  newdat$.variable = factor(newdat$.variable,levels=yVar)
  rownames(newdat) = 1:nrow(newdat)
  newdat = qdata(newdat,
                 color = if (yCol>1 && all(settingh[,".color"]=='gray15')) {
                   .variable} else {as.character(settingh[,".color"])},
                 border = if (yCol>1 && all(settingh[,".border"]=='gray15')) {
                   .variable} else {as.character(settingh[,".border"])},
                 size = settingh[,".size"], brushed = settingh[,".brushed"],
                 visible = settingh[,".visible"])
  link_cat(newdat,link,regular_qdata,link)
  attr(newdat,"regular_nrow") = nrow(data)
  return(newdat)
}

# Initialize the Time.meta
time_meta_initialize = function(meta, call, data, hdiv, vdiv,
                                 shift, alpha, size, asp,
                                 main, xlab, ylab, infolab, ...){

  meta$singleVarLen = attr(data,"regular_nrow")
  data = as.data.frame(data)

  meta$data = data.frame(x = as.numeric(data[,meta$varname$x]),
                         yorig = data$.value)

  ## X axis setting
  meta$data$xtmp = meta$data$xtmp0 = meta$data$x
  meta$xlab = ifelse(is.null(xlab), meta$varname$x, xlab)

  ## Y axis setting
  meta$varname$y = as.character(unique(data$.variable))
  meta$ngroup$y = length(meta$varname$y)
  meta$data$vargroup = factor(data$.variable,levels=meta$varname$y)
  meta$data$yscaled = meta$data$yorig
  ylist = data[,meta$varname$y,drop=FALSE]
  if (meta$ngroup$y > 1) {
    for (i in 1:meta$ngroup$y) {
      tmprow = ylist[,i]
      tmprowdat = meta$data$yorig[tmprow]
      meta$data$yscaled[tmprow] = (tmprowdat - min(tmprowdat, na.rm = TRUE))/
        diff(range(tmprowdat, na.rm = TRUE))
    }
  }
  meta$data$ytmp = meta$data$yscaled
  meta$ylab = ifelse(is.null(ylab), paste(meta$varname$y,collapse=', '), ylab)
  meta$ylab.init = meta$ylab

  ## Group for panel data
  meta$varname$g = union(vdiv, hdiv)
  if (length(meta$varname$g)==0) {
    meta$ngroup$id = 1
    meta$data$idgroup = 1
  } else {
    meta$ngroup$id = nrow(unique(data[,meta$varname$g,drop=FALSE]))
    meta$data$idgroup = bind_var(data,meta$varname$g)
  }

  ## Other groups
  meta$data$xwrapgroup = 1
  meta$ngroup$xwrap = 1
  meta$data$ywrapgroup = 1
  meta$ngroup$ywrap = 1

  ## Group y-axis
  meta$data$htvar=0
  meta$data$htid=0
  meta$data$htywrap=0
  meta$data$htperiod=0
  
  ## facet
  meta$data$vfacet = 0
  meta$data$hfacet = 0
  meta$varname$hfacet = hdiv
  meta$varname$vfacet = vdiv

  ## order the data by vargroup, idgroup, and x
  orderEnter = order(meta$data$vargroup, meta$data$idgroup, meta$data$x, decreasing=FALSE)
  meta$data$order = 1:nrow(meta$data)
  meta$data = meta$data[orderEnter,]

  ## Mode settings
  meta$mode$area = FALSE
  meta$mode$yfold = FALSE
  meta$mode$xwrap = FALSE
  meta$mode$ywrap = FALSE
  meta$mode$period = FALSE
  meta$mode$zoom = FALSE
  meta$mode$serie = FALSE
  meta$mode$idSep = FALSE
  meta$mode$varUP = FALSE
  meta$mode$varDOWN = FALSE
  meta$mode$hfacet = 0
  meta$mode$vfacet = 0

  ## Other
  meta$steplen$xwrap = shift
  meta$steplen$xzoom = diff(range(meta$data$x,na.rm=TRUE))+1
  meta$steplen$ywrap = 0.9
  meta$steplen$yzoom = 1
  meta$steplen$id = 0 # vertconst
  meta$shiftKey = FALSE
  meta$linkID = NULL
  meta$varname$identify = infolab

  ## Range, axes, etc.
  meta$limits = matrix(c(extend_ranges(range(meta$data$xtmp, na.rm = TRUE)),
                         extend_ranges(range(meta$data$ytmp, na.rm = TRUE))), nrow=2)
  meta$xat = axis_loc(meta$limits[1:2])
  meta$yat = axis_loc(meta$limits[3:4])
  meta$xlabels = format(meta$xat)
  meta$ylabels = format(meta$yat)

  ## Radius, color, etc.
  meta$radius = size
  meta$alpha = alpha
  meta$data$stroke = 1
  meta$data$fill = 1

  ## Brush etc.
  meta$pos = c(NA, NA)
  meta$start = c(NA, NA)
  meta$brush.move = TRUE
  meta$brush.size = c(diff(meta$limits[1:2]),-diff(meta$limits[3:4]))/30
  
  ## Title
  meta$main = if (is.null(main))
    sprintf("Time Plot of %s And %s", meta$varname$x,
            paste(meta$varname$y, collapse=', ')) else main

  ## include the variables needed
  include_var(c(hdiv,vdiv,infolab),meta, data)
}

# bind variables into factor with reasonable levels
bind_var = function(dat, varnames, simplify=TRUE) {
  classes = sapply(dat[,varnames,drop=FALSE], function(a) class(a)[1])
  if (length(varnames)==1) {
    newgroup = dat[,varnames]
    if (!classes %in% c('factor','ordered')) 
      newgroup = factor(as.character(newgroup), levels=sort(unique(newgroup)))
  } else {
    group = unname(apply(dat[,varnames],1,paste,collapse=','))
    level = list()
    levelbind = 'start'
    for (i in 1:length(varnames)){
      tmpdat = dat[,varnames[i]]
      level[[i]] = if (classes[i] %in% c('factor','ordered')) {levels(tmpdat)} else {as.character(sort(unique(tmpdat)))}
      levelbind = as.vector(t(outer(levelbind,level[[i]],paste,sep=',')))
    }
    levelbind = gsub('^start,','',levelbind)
    if (simplify) levelbind = levelbind[levelbind %in% group]
    newgroup = factor(group,levels=levelbind)
  }
  return(newgroup)
}

# Include some variables in meta$data
include_var = function(varname, meta, dat) {
  if (length(varname) && length(setdiff(colnames(meta$data),varname))) {
    varname = setdiff(varname, colnames(meta$data))
    meta$data = cbind(meta$data, dat[meta$data$order,varname])
    colnames(meta$data)[1:length(varname) + ncol(meta$data) - length(varname)] = varname
  }
}

# Update the groups of points to make the line
update_meta_group = function(meta){
  meta$data$finalgroup = paste(meta$data$vargroup, meta$data$idgroup, meta$data$xwrapgroup)
  meta$data$vidgroup = paste(meta$data$vargroup, meta$data$idgroup)
  #meta$data$htfinal = sum(meta$data$htvar, meta$data$htid, meta$data$htywrap)
  meta$ngroup$final = length(unique(meta$data$finalgroup))
  meta$ngroup$vid = length(unique(meta$data$vidgroup))
  meta$ngroup$xwrap = length(unique(meta$data$xwrapgroup))
  meta$mode$xwrap = ifelse(meta$ngroup$xwrap>1,TRUE,FALSE)
}

# Update the colors of points when x-wrapping
update_meta_xwrap_color = function(meta, data){
  color_seq = seq(1,0,length=meta$ngroup$xwrap+1)
  meta$data$fill = color_seq[meta$data$xwrapgroup]
  meta$data$stroke = color_seq[meta$data$xwrapgroup]
}

# Update the xtmp when x-wrapping
update_meta_xwrap = function(meta){
  meta$data$xtmp = meta$data$x-min(meta$data$x,na.rm=TRUE)+1
  meta$data$xwrapgroup = ceiling(meta$data$xtmp/meta$steplen$xzoom)
  meta$data$xtmp = meta$data$xtmp %% meta$steplen$xzoom
  if (all(meta$data$xtmp == meta$data$xtmp[1])){
    message('Can not wrap forward any longer. Please use the left arrow to wrap backward.')
  }
  if (sum(meta$data$xtmp==0)){
    meta$data$xwrapgroup[meta$data$xtmp==0] = meta$data$xwrapgroup[which(meta$data$xtmp==0)-1]
    meta$data$xtmp[meta$data$xtmp==0] = meta$steplen$xzoom
  }
  meta$data$xtmp = meta$data$xtmp + min(meta$data$x,na.rm=TRUE)-1
  meta$data$xtmp0 = meta$data$xtmp
}

# Update the height of variables -- htvar
update_meta_htvar = function(meta){
  meta$data$htvar = if (meta$mode$varUP & meta$steplen$id>0) {
    (as.integer(meta$data$vargroup)-1) * (1 + (meta$ngroup$id-1)*meta$steplen$id) * 1.02
  } else if (meta$mode$varUP) {
    (as.integer(meta$data$vargroup)-1) * 1.02
  } else 0
  if (meta$mode$ywrap) meta$data$htvar = meta$data$htvar * meta$steplen$yzoom * 1.05
}

# Get the horizontal lines to cut the series
compute_cutbound = function(meta){
  tmp = if (meta$mode$yfold){
      meta$data$hrznbaseline + abs(meta$data$hrznydiff)
    } else if (meta$steplen$id==0) {
      meta$data$yscaled
    } else {(meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE))}
  meta$cutbound$diff = tapply(tmp,meta$data$vargroup,function(x){
    diff(range(x))*meta$steplen$yzoom})
  meta$cutbound$orig = tapply(tmp,meta$data$vargroup,function(x){
    d = diff(range(x))*meta$steplen$yzoom
    dcut = seq(from=min(x),by=d,length=meta$ngroup$ywrap+1)
    return(dcut)})
  meta$cutbound$cut = lapply(meta$cutbound$orig,function(x){
    x[1]=x[1]-1
    x[length(x)]=x[length(x)]+1
    return(x)})
}

# Set up meta$line
compute_line = function(meta, data){
  update_meta_group(meta)
  tmpcolor = alpha(data$.color[meta$data$order],meta$data$fill*meta$alpha)
  if (meta$mode$ywrap){
    meta$line$df = data.frame()
    for (i in 1:length(meta$ywrapline)){
      for (j in 1:length(meta$ywrapline[[i]])){
        tmpdat = meta$ywrapline[[i]][[j]]$data
        tmprow = sapply(tmpdat$id,function(x) which(rownames(meta$data)==x))
        tmpn = nrow(tmpdat)
        tmpline = data.frame(xs=tmpdat$xtmp[-tmpn],
                             ys=tmpdat$ytmp[-tmpn],
                             xe=tmpdat$xtmp[-1],
                             ye=tmpdat$ytmp[-1],
                             col=tmpcolor[tmprow][-tmpn],
                             id=tmprow[-tmpn])
        meta$line$df = rbind(meta$line$df, tmpline[complete.cases(tmpline),])
      }
    }
    return()
  }
  if (meta$mode$yfold) {
    tmpcolor = alpha(meta$yfoldline$.color,meta$yfoldline$fill*meta$alpha)
    tmpdat = meta$yfoldline
    tmpid = tmpdat$id
  } else {
    tmpdat = meta$data
    tmpid = 1:nrow(meta$data)
  }
  meta$line$lastrow = which(c(diff(as.integer(factor(tmpdat$finalgroup)))!=0,TRUE))
  meta$line$firstrow = c(1,(meta$line$lastrow[-length(meta$line$lastrow)]+1))
  meta$line$df = data.frame(xs=tmpdat$xtmp[-meta$line$lastrow],
                            ys=tmpdat$ytmp[-meta$line$lastrow],
                            xe=tmpdat$xtmp[-meta$line$firstrow],
                            ye=tmpdat$ytmp[-meta$line$firstrow],
                            col=tmpcolor[-meta$line$lastrow],
                            id=tmpid[-meta$line$lastrow])
}

# Set up meta$area
compute_area = function(meta, data, fun.base){
  compute_line(meta, data)
  tmpcolor = alpha(data$.color[meta$data$order],meta$data$fill*meta$alpha/2)
  meta$area$x = data.frame(x1=meta$line$df$xs,x2=meta$line$df$xe,x3=meta$line$df$xe,
                           x4=meta$line$df$xs,x5=meta$line$df$xs,x6=NA)
  if (meta$mode$ywrap){
    areabaseline = (meta$data$htvar + meta$data$htid + meta$data$vfacet)[meta$line$df$id]
    meta$area$y = data.frame(y1=areabaseline,y2=areabaseline,y3=meta$line$df$ye,
                             y4=meta$line$df$ys,y5=areabaseline,y6=NA)
    meta$area$color = tmpcolor[meta$line$df$id]
  } else {
    areabaseline = tapply(meta$data$ytmp,meta$data$vargroup,fun.base)
    meta$data$areabaseline = meta$data$htvar + meta$data$htid + meta$data$htperiod + meta$data$vfacet
    if (all(meta$data$areabaseline==0)) meta$data$areabaseline = areabaseline[meta$data$vargroup]
    if (meta$mode$yfold) {
      tmpcolor = alpha(meta$yfoldline$.color,meta$yfoldline$fill*meta$alpha/2)
      tmpdat = meta$yfoldline
      areabaseline = tapply(tmpdat$ytmp,tmpdat$vargroup,fun.base)
      areabaseline2 = tapply(meta$data$htid,meta$data$finalgroup,`[`,1)
      tmpdat$areabaseline = areabaseline[tmpdat$vargroup] + areabaseline2[tmpdat$finalgroup]
    } else {
      tmpdat = meta$data
    }
    meta$area$y = data.frame(y1=tmpdat$areabaseline[-meta$line$lastrow],
                             y2=tmpdat$areabaseline[-meta$line$lastrow],
                             y3=meta$line$df$ye, y4=meta$line$df$ys,
                             y5=tmpdat$areabaseline[-meta$line$lastrow],
                             y6=NA)
    meta$area$color = tmpcolor[-meta$line$lastrow]
  }
  meta$area$poly = data.frame(x=as.vector(as.matrix(t(meta$area$x))),
                              y=as.vector(as.matrix(t(meta$area$y))),
                              group=rep(1:nrow(meta$area$x),each=6))
}

# Draw the selected data in qtime
selected_draw = function(meta,b,hits,painter){
  qdrawGlyph(painter, qglyphCircle(r = meta$radius*2), meta$data$xtmp[hits],
             meta$data$ytmp[hits], stroke = meta$brush$color, fill = meta$brush$color)
  qlineWidth(painter) = max(meta$radius,1)
  idx = (hits[-length(hits)] & hits[-1])[-meta$line$lastrow]
  qdrawSegment(painter,meta$area$x[idx,4],meta$area$y[idx,4],
               meta$area$x[idx,3],meta$area$y[idx,3],stroke=meta$brush$color)
  if (meta$mode$area){
    tmpx=as.vector(as.matrix(t(meta$area$x[idx,])))
    tmpy=as.vector(as.matrix(t(meta$area$y[idx,])))
    qdrawPolygon(painter, tmpx, tmpy, stroke=alpha(meta$brush$color,0.01), fill=alpha(meta$brush$color,0.8))
  }
}

# Set limits for xaxis in qtime
meta_xaxis = function(meta) {
  if(meta$mode$hfacet) {
    tmpidx = !duplicated(meta$data[,meta$varname$hfacet[1:meta$mode$hfacet]])
    meta$xat = meta$data$hfacet[tmpidx]
    meta$xlabels = as.character(bind_var(meta$data,meta$varname$hfacet[1:meta$mode$hfacet]))[tmpidx]
    tmporder = order(meta$xat)
    meta$xat = meta$xat[tmporder]
    meta$xlabels = meta$xlabels[tmporder]
    meta$xlab = paste(meta$varname$hfacet[1:meta$mode$hfacet],collapse=',')
  } else {
    meta$limits[1:2] = extend_ranges(meta$data$xtmp)
    meta$xat = axis_loc(meta$limits[1:2])
    meta$xlabels = format(meta$xat)
    meta$xlab = meta$varname$x
  }
}

# Set limits for yaxis in qtime
meta_yaxis = function(meta) {
  if(meta$mode$vfacet) {
    tmpidx = !duplicated(meta$data[,meta$varname$vfacet[1:meta$mode$vfacet]])
    meta$yat = meta$data$vfacet[tmpidx]
    meta$ylabels = format(bind_var(meta$data,meta$varname$vfacet[1:meta$mode$vfacet])[tmpidx],justify='right')
    tmporder = order(meta$yat)
    meta$yat = meta$yat[tmporder]
    meta$ylabels = meta$ylabels[tmporder]
    meta$ylab = paste(meta$varname$vfacet[1:meta$mode$vfacet],collapse=',')
  } else if (meta$steplen$id) {
    if (meta$mode$varUP) {
      meta$yat = (meta$data$htid+meta$data$htvar)[!duplicated(meta$data$vidgroup)]+0.5*meta$steplen$id
      meta$ylabels = format(unique(meta$data$vidgroup),justify='right')
    } else {
      meta$yat = meta$data$htid[!duplicated(meta$data$idgroup)]+0.5*meta$steplen$id*ifelse(meta$mode$varUP,meta$ngroup$y,1)
      meta$ylabels = format(unique(meta$data$idgroup),justify='right')
    }
    meta$ylab = paste(meta$varname$g,collapse=',')
  } else if (meta$mode$varUP) {
    tmpyat = sort(unique(meta$data$htvar))
    meta$yat = tmpyat + diff(tmpyat[1:2])/2
    meta$ylabels = meta$varname$y
    meta$ylab = ""
  } else if (meta$mode$varDOWN) {
    meta$yat = axis_loc(meta$limits[3:4])
    meta$ylabels = format(meta$yat,justify='right')
    meta$ylab = paste(meta$varname$y,collapse=', ')
    meta$mode$varUP = FALSE
  } else {
    #if (meta$ngroup$id==1 | !meta$steplen$id){
      meta$yat = axis_loc(meta$limits[3:4])
    #} else {
    #  meta$yat = (1:meta$ngroup$id-0.5)*meta$steplen$id
    #}
    #if (meta$steplen$id==0) {
      meta$ylabels = format(meta$yat,justify='right')
      meta$ylab = meta$ylab.init
    #} else {
    #  meta$ylabels = format(unique(meta$data$idgroup))
    #  meta$ylab = meta$varname$g
    #}
  }
}

# key M for switching the serie mode on the serie mode users can drag any serie horizontally
switch_serie_mode = function(meta,data){
  if (meta$mode$zoom) {
    meta$mode$zoom = FALSE
    meta$mode$serie = FALSE
    return()
  }
  if (meta$ngroup$id>1 & meta$ngroup$y==1){
    meta$mode$serie = !meta$mode$serie
    if (!meta$mode$serie) {
      remove_listener(data,meta$linkID)
      meta$linkID = NULL
    } else {
      if (class(data[,meta$varname$g])=='factor'){
        meta$linkID = link_cat(data, meta$varname$g)
      } else {
        message("The group variable is not a factor. Please change to factor before pressing M.")
        meta$mode$serie = FALSE
      }
    }
  } else if (meta$ngroup$vid>1) {
    meta$mode$serie = !meta$mode$serie
  }
}

# key G for shifting the wrapping gear, i.e. changing the period/frequency
shift_wrap_gear = function(meta){
  meta$steplen$xwrap = c(meta$steplen$xwrap[-1],meta$steplen$xwrap[1])
}

# key R for turning on/off the area mode
switch_area_mode = function(meta){
  meta$mode$area = !meta$mode$area
}

# key F for fold/unfold the time series by mean
switch_fold_mode = function(meta,data){
  meta$mode$yfold = !meta$mode$yfold
  tmpdat = if (meta$steplen$id>0 & (!meta$mode$varUP)) {
    (meta$data$yscaled - min(meta$data$yscaled))/diff(range(meta$data$yscaled))
  } else {meta$data$yscaled}
  if (meta$mode$yfold) {
    hrznbaseline = tapply(tmpdat,meta$data$vargroup,mean,na.rm=TRUE)
    meta$data$hrznbaseline = hrznbaseline[meta$data$vargroup]
    meta$data$hrznydiff = tmpdat - meta$data$hrznbaseline
    meta$data$ytmp = abs(meta$data$hrznydiff) + meta$data$hrznbaseline + meta$data$htvar + meta$data$htid
    meta$data$hrzncolor = data$.color[meta$data$order]
    meta$data$hrznborder = data$.border[meta$data$order]
    data$.color[meta$data$order] = c('#E69F00','grey15','#56B4E9')[sign(meta$data$hrznydiff)+2]
    data$.border = data$.color
    
    meta$yfoldline = cbind(meta$data[,c('xtmp','ytmp','hrznydiff','vargroup','finalgroup','fill')],data[meta$data$order,'.color',drop=FALSE])
    meta$yfoldline$finalgroup = as.integer(factor(meta$yfoldline$finalgroup))
    rownames(meta$yfoldline) = 1:nrow(meta$yfoldline)
    idx = which((abs(diff(sign(meta$yfoldline$hrznydiff)))==2) & (diff(meta$yfoldline$finalgroup)==0))
    zeroline = data.frame(xtmp=(meta$yfoldline$xtmp[idx]*abs(meta$yfoldline$hrznydiff[idx+1])+meta$yfoldline$xtmp[idx+1]*abs(meta$yfoldline$hrznydiff[idx]))/(abs(meta$yfoldline$hrznydiff[idx])+abs(meta$yfoldline$hrznydiff[idx+1])),
                          ytmp=meta$data$hrznbaseline[idx] + meta$data$htvar[idx] + meta$data$htid[idx],
                          hrznydiff=NA,
                          vargroup=meta$yfoldline$vargroup[idx],
                          finalgroup=meta$yfoldline$finalgroup[idx],
                          fill=meta$yfoldline$fill[idx],
                          .color=meta$yfoldline$.color[idx+1])
    rownames(zeroline) = idx+0.5
    meta$yfoldline = rbind(meta$yfoldline,zeroline)
    meta$yfoldline = meta$yfoldline[order(as.numeric(rownames(meta$yfoldline))),]
    meta$yfoldline$id = round(as.numeric(rownames(meta$yfoldline)))
  } else {
    meta$data$ytmp = tmpdat + meta$data$htvar + meta$data$htid
    data$.color[meta$data$order] = meta$data$hrzncolor
    data$.border[meta$data$order] = meta$data$hrznborder
  }
  if (meta$shiftKey | !meta$mode$yfold) {
    meta$limits[3:4] =  extend_ranges(range(meta$data$ytmp,na.rm=TRUE))
    meta_yaxis(meta)
  }
}

# key U for separating the groups by shifting up
separate_group = function(meta){
  if (meta$ngroup$y>1 & meta$shiftKey) {
    meta$data$htvar = as.integer(meta$data$vargroup) - 1
    meta$data$htid = (as.integer(meta$data$idgroup)-1)*meta$steplen$id*meta$ngroup$y
    meta$data$ytmp = meta$data$yscaled + meta$data$htvar + meta$data$htid
    meta$mode$varUP = TRUE
  } else if (meta$ngroup$id>1) {
    meta$steplen$id = meta$steplen$id + 0.05
    if (meta$steplen$id>1) meta$steplen$id = 1
    meta$data$htid = (as.integer(meta$data$idgroup)-1)*meta$steplen$id
    if (meta$mode$varUP) meta$data$htvar = (as.integer(meta$data$vargroup)-1) * (1+(meta$ngroup$id-1)*meta$steplen$id)
    meta$data$ytmp = (meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE)) + meta$data$htid + meta$data$htvar
  } else if (meta$ngroup$y == 1 && meta$ngroup$id == 1 && meta$ngroup$xwrap>1 && !meta$mode$ywrap) {
    meta$mode$period = TRUE
    meta$data$htperiod = as.integer(meta$data$xwrapgroup) - 1
    meta$data$ytmp = (meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE)) + meta$data$htperiod
  }
  meta$limits[3:4] =  extend_ranges(range(meta$data$ytmp,na.rm=TRUE))
  meta_yaxis(meta)
}

# key D for mixing the groups
mix_group = function(meta){
  # meta$mode$varUP = FALSE
  if (meta$ngroup$y>1 & meta$shiftKey) {
    meta$data$htvar = 0
    meta$data$htid = (as.integer(meta$data$idgroup)-1)*meta$steplen$id
    meta$data$ytmp = meta$data$yscaled + meta$data$htid + meta$data$htvar
    meta$mode$varUP = FALSE
    meta$mode$varDOWN = TRUE
  } else if (meta$ngroup$y == 1 && meta$ngroup$id == 1 && meta$mode$period) {
    meta$mode$period = FALSE
    meta$data$htperiod = 0
    meta$data$ytmp = meta$data$yscaled + meta$data$htid + meta$data$htvar
  } else {
    if (meta$ngroup$id>1) {
      meta$steplen$id = meta$steplen$id - 0.05
      if (meta$steplen$id<0) meta$steplen$id = 0
      if (!meta$steplen$id) {
        meta$data$htid = 0
        #meta$data$htvar = as.integer(meta$data$vargroup) - 1
        meta$data$ytmp = meta$data$yscaled + meta$data$htid + meta$data$htvar
        meta$limits[3:4] =  extend_ranges(range(meta$data$ytmp,na.rm=TRUE))
      } else {
        meta$data$htid = (as.integer(meta$data$idgroup)-1)*meta$steplen$id
        if (meta$mode$varUP) meta$data$htvar = (as.integer(meta$data$vargroup)-1) * (1+(meta$ngroup$id-1)*meta$steplen$id)
        meta$data$ytmp = (meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE)) + meta$data$htid + meta$data$htvar
      }
    }
  }
  meta$limits[3:4] =  extend_ranges(range(meta$data$ytmp,na.rm=TRUE))
  meta_yaxis(meta)
}

# update the horizontal faceting by the current setting
update_h_facet = function(meta){
  if (meta$mode$hfacet == 0){
    meta$data$hfacet = 0
    meta$data$xtmp = meta$data$xtmp0
  } else {
    meta$data$hfacet = as.integer(bind_var(meta$data,meta$varname$hfacet[1:meta$mode$hfacet])) - 1
    meta$data$hfacet = meta$data$hfacet * diff(range(meta$data$xtmp0,na.rm=TRUE))*1.1
    meta$data$hfacet = meta$data$hfacet + min(meta$data$xtmp0)
    meta$data$xtmp = meta$data$xtmp0 + meta$data$hfacet - min(meta$data$xtmp0)
  }
  meta$limits[1:2] =  extend_ranges(range(meta$data$xtmp,na.rm=TRUE))
  meta_xaxis(meta)
}

# update the vertical faceting by the current setting
update_v_facet = function(meta){
  if (meta$mode$vfacet==0){
    meta$data$vfacet = 0
    meta$data$ytmp = meta$data$yscaled
  } else {
    meta$data$vfacet = as.integer(bind_var(meta$data,meta$varname$vfacet[1:meta$mode$vfacet])) - 1
    meta$data$vfacet = meta$data$vfacet * diff(range(meta$data$yscaled,na.rm=TRUE))*1.02 
    meta$data$vfacet = meta$data$vfacet + min(meta$data$yscaled)
    meta$data$ytmp = meta$data$yscaled + meta$data$vfacet - min(meta$data$yscaled)
  }
  meta$limits[3:4] =  extend_ranges(range(meta$data$ytmp,na.rm=TRUE))
  meta_yaxis(meta)
}

# key H for faceting the series horizontally
horizontal_facet = function(meta){
  h = length(meta$varname$hfacet)
  if (h==0) return()
  if (meta$shiftKey) {
    meta$mode$hfacet = max(meta$mode$hfacet-1, 0)
  } else {
    meta$mode$hfacet = min(meta$mode$hfacet+1, h) 
  }
  update_h_facet(meta)
}

# key V for faceting the series vertically
vertical_facet = function(meta){
  v = length(meta$varname$vfacet)
  if (v==0) return()
  if (meta$shiftKey) {
    meta$mode$vfacet = max(meta$mode$vfacet-1, 0)
  } else {
    meta$mode$vfacet = min(meta$mode$vfacet+1, v)
  }
  update_v_facet(meta)
}

# key T for transposing the h/v faceting
transpose_facet = function(meta){
  tmp = meta$varname$hfacet
  meta$varname$hfacet = meta$varname$vfacet
  meta$varname$vfacet = tmp
  tmp = meta$mode$hfacet
  meta$mode$hfacet = meta$mode$vfacet
  meta$mode$vfacet = tmp
  update_h_facet(meta)
  update_v_facet(meta)
}

# key for rotating h-faceting
rotate_h_facet = function(meta){
  h=length(meta$varname$hfacet)
  if (meta$shiftKey) {
    meta$varname$hfacet = meta$varname$hfacet[c(h,1:(h-1))]
  } else {
    meta$varname$hfacet = meta$varname$hfacet[c(2:h,1)]
  }
  update_h_facet(meta)
}

# key for rotating v-faceting
rotate_v_facet = function(meta){
  v = length(meta$varname$vfacet)
  if (meta$shiftKey) {
    meta$varname$vfacet = meta$varname$vfacet[c(v,1:(v-1))]
  } else {
    meta$varname$vfacet = meta$varname$vfacet[c(2:v,1)]
  }
  update_v_facet(meta)
}

# key Right for x-wrapping
x_wrap_forward = function(meta,data){
  if (meta$mode$serie) {
    hits = selected(data)[meta$data$order]
    if (sum(hits)) {
      if (min(meta$data$xtmp[hits],na.rm=TRUE)<=max(meta$data$x,na.rm=TRUE)){
        meta$data$xtmp[hits] = meta$data$xtmp[hits] + diff(range(meta$data$x,na.rm=TRUE))/meta$singleVarLen
      }
      meta_xaxis(meta)
    }
    return()
  }
  if (meta$shiftKey) {
    meta$steplen$xzoom = max(meta$steplen$xwrap)
    if (meta$steplen$xzoom<2) meta$steplen$xzoom = diff(range(meta$data$x,na.rm=TRUE))/4
    update_meta_xwrap(meta)
  } else {
    crt_range = diff(range(meta$data$xtmp,na.rm=TRUE))+1
    bd = max(c(3,min(abs(diff(meta$data$x)))))
    while (diff(range(meta$data$xtmp,na.rm=TRUE))+1 >= crt_range &
           meta$steplen$xzoom > max(c(bd,meta$steplen$xwrap[1])) ) {
      meta$steplen$xzoom = meta$steplen$xzoom - meta$steplen$xwrap[1]
      if (meta$steplen$xwrap[1]==1 & meta$steplen$xzoom<bd){
        meta$steplen$xzoom = bd
      } else if (meta$steplen$xwrap[1]!=1 & meta$steplen$xzoom<meta$steplen$xwrap[1]){
        meta$steplen$xzoom = meta$steplen$xzoom %% meta$steplen$xwrap[1]
        #if (meta$steplen$xzoom<=0) meta$steplen$xzoom = meta$steplen$xwrap[1]
      }
      update_meta_xwrap(meta)
    }
  }
  update_meta_group(meta)
  update_meta_xwrap_color(meta,data)
  meta_xaxis(meta)
  if (meta$mode$period){
    meta$data$htperiod = as.integer(meta$data$xwrapgroup) - 1
    meta$data$ytmp = (meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE)) + meta$data$htperiod
    meta$limits[3:4] = extend_ranges(meta$data$ytmp)
  }
}

# key Left for x-backward-wrapping
x_wrap_backward = function(meta,data){
  if (meta$shiftKey) {
    meta$data$xtmp = meta$data$xtmp0 = meta$data$x
    meta$data$xwrapgroup = 1
    meta$steplen$xzoom = diff(range(meta$data$x, na.rm=TRUE))+1
    meta$mode$zoom = FALSE
    if (meta$mode$period) {
      meta$data$ytmp = meta$data$yscaled
      meta$mode$period=FALSE
      meta$limits[3:4] = extend_ranges(meta$data$ytmp)
      meta_yaxis(meta)
    }
  } else {
    hits = selected(data)[meta$data$order]
    if (meta$mode$serie & sum(hits)) {
      if (max(meta$data$xtmp[hits],na.rm=TRUE) >= min(meta$data$x,na.rm=TRUE)) {
        meta$data$xtmp[hits] = meta$data$xtmp[hits] - diff(range(meta$data$x,na.rm=TRUE))/meta$singleVarLen
      }
    } else if (!meta$mode$serie) {
      crt_range = diff(range(meta$data$xtmp,na.rm=TRUE))+1
      while (diff(range(meta$data$xtmp,na.rm=TRUE))+1 <= crt_range &
             meta$steplen$xzoom < diff(range(meta$data$x,na.rm=TRUE))+1) {
        meta$steplen$xzoom = meta$steplen$xzoom + meta$steplen$xwrap[1]
        if (meta$steplen$xzoom > diff(range(meta$data$x,na.rm=TRUE))+1) {
          meta$steplen$xzoom = diff(range(meta$data$x,na.rm=TRUE))+1
        }
        update_meta_xwrap(meta)
      }
      if (meta$mode$period){
        meta$data$htperiod = as.integer(meta$data$xwrapgroup) - 1
        if (any(meta$data$htperiod > 0)) {
          meta$data$ytmp = (meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE)) + meta$data$htperiod
        } else {meta$mode$period=FALSE; meta$data$ytmp = meta$data$yscaled}
        meta$limits[3:4] = extend_ranges(meta$data$ytmp)
        meta_yaxis(meta)
      }
    }
  }
  update_meta_group(meta)
  update_meta_xwrap_color(meta,data)
  meta_xaxis(meta)
}

# key Y for y-wrapping, and Shift+Y for y-backward-wrapping
y_wrap_forward = function(meta,data){
  if (meta$mode$xwrap) return()
  # shift the ywrap for one step to the left or right
  meta$steplen$yzoom = meta$steplen$yzoom * if (meta$shiftKey){1/meta$steplen$ywrap} else {meta$steplen$ywrap}
  if (meta$steplen$yzoom>1) meta$steplen$yzoom=1
  if (meta$steplen$yzoom<0.1) meta$steplen$yzoom=0.1
  meta$data$htid = (as.integer(meta$data$idgroup)-1)*(meta$steplen$id+0.05) * meta$steplen$yzoom
  meta$ngroup$ywrap = ceiling(1/meta$steplen$yzoom)
  # when the ywrap mode is off, reset ytmp
  if (meta$steplen$yzoom == 1){
    update_meta_htvar(meta)
    meta$mode$ywrap = FALSE
    meta$data$ywrapgroup = 1
    meta$data$ytmp = meta$data$htvar + meta$data$htid + if (meta$mode$yfold){
      meta$data$hrznbaseline + abs(meta$data$hrznydiff)
    } else if (meta$steplen$id==0) {
      meta$data$yscaled
    } else {(meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE))}
    meta$limits[3:4] = extend_ranges(range(meta$data$ytmp,na.rm=TRUE))
    meta_yaxis(meta)
    return()
  }
  # when the ywrap mode is on
  meta$mode$area = TRUE
  meta$mode$ywrap = TRUE
  compute_cutbound(meta)
  update_meta_htvar(meta)
  meta$data$ywrapgroup = 1
  ytmp = if (meta$mode$yfold) {meta$data$hrznbaseline + abs(meta$data$hrznydiff)} else if (meta$steplen$id==0) {meta$data$yscaled} else {(meta$data$yscaled-min(meta$data$yscaled,na.rm=TRUE))/diff(range(meta$data$yscaled,na.rm=TRUE))}
  # for each variable, calculate the new ywrapgroup and ytmp
  for (i in 1:meta$ngroup$y){
    tmprows = (meta$data$vargroup==meta$varname$y[i])
    meta$data$ywrapgroup[tmprows] = as.integer(cut(ytmp[tmprows],meta$cutbound$cut[[i]]))
    meta$data$ytmp[tmprows] = ytmp[tmprows] - meta$cutbound$orig[[i]][meta$data$ywrapgroup[tmprows]] + meta$data$htvar[tmprows] + meta$data$htid[tmprows]
  }
  # for each wrapped line, get the coordinates
  meta$ywrapline = list()
  for (i in unique(meta$data$vidgroup)){
    tmpdata = meta$data[meta$data$vidgroup==i,,drop=FALSE]
    tmpdata$yscaled = ytmp[meta$data$vidgroup==i]
    tmpvargroup = tmpdata$vargroup[1]
    for (j in 1:meta$ngroup$ywrap) {
      meta$ywrapline[[i]][[j]] = list(data=tmpdata[,c('xtmp','ytmp'),drop=FALSE])
      meta$ywrapline[[i]][[j]]$data$id = rownames(meta$ywrapline[[i]][[j]]$data)

      dominant = which(tmpdata$ywrapgroup==j)
      if (length(dominant) && all(dominant==1:nrow(tmpdata))) next
      boundary = setdiff(1:nrow(tmpdata),dominant)
      boundary_upper = boundary[tmpdata$ywrapgroup[boundary]>j]

      dominant_left = boundary[c(diff(boundary)>1,TRUE)]
      if (rev(dominant_left)[1]==nrow(tmpdata)) dominant_left = dominant_left[-length(dominant_left)]
      meta$ywrapline[[i]][[j]]$dominant_left_upper = intersect(dominant_left,boundary_upper)
      meta$ywrapline[[i]][[j]]$dominant_left_lower = setdiff(dominant_left,boundary_upper)

      dominant_right = boundary[c(1,which(diff(boundary)>1)+1)]
      if (dominant_right[1]==1) dominant_right = dominant_right[-1]
      meta$ywrapline[[i]][[j]]$dominant_right_upper = intersect(dominant_right,boundary_upper)
      meta$ywrapline[[i]][[j]]$dominant_right_lower = setdiff(dominant_right,boundary_upper)

      meta$ywrapline[[i]][[j]]$recessive_up = which(tmpdata$ywrapgroup[-nrow(tmpdata)] < j & tmpdata$ywrapgroup[-1] > j)
      meta$ywrapline[[i]][[j]]$recessive_dn = which(tmpdata$ywrapgroup[-nrow(tmpdata)] > j & tmpdata$ywrapgroup[-1] < j)

      if (length(dominant)) {
        meta$ywrapline[[i]][[j]]$data[-dominant,'ytmp'] = tmpdata$htvar[dominant][1] + tmpdata$htid[dominant][1]
      } else {
        meta$ywrapline[[i]][[j]]$data[,'ytmp'] = tmpdata$htvar[1] + tmpdata$htid[1]
      }
      if (length(boundary_upper)) meta$ywrapline[[i]][[j]]$data[boundary_upper,'ytmp'] = meta$ywrapline[[i]][[j]]$data[boundary_upper,'ytmp'] + meta$cutbound$diff[tmpvargroup]


      crosspoint_x = function(x1,y1,x2,y2,h){
        x1+(h-y1)/(y2-y1)*(x2-x1)
      }

      if (length(meta$ywrapline[[i]][[j]]$dominant_left_upper)){
        addpoints_left = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$dominant_left_upper,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_left$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_left_upper],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_left_upper],
                                           tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_left_upper+1],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_left_upper+1],
                                           meta$cutbound$orig[[tmpvargroup]][tmpdata$ywrapgroup[meta$ywrapline[[i]][[j]]$dominant_left_upper+1]+1])
        addpoints_right = data.frame()
        meta$ywrapline[[i]][[j]]$data = rbind(meta$ywrapline[[i]][[j]]$data, addpoints_left, addpoints_right)
      }

      if (length(meta$ywrapline[[i]][[j]]$dominant_left_lower)){
        addpoints_left = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$dominant_left_lower,c('xtmp','ytmp'),drop=FALSE]
        addpoints_left$id = meta$ywrapline[[i]][[j]]$data$id[meta$ywrapline[[i]][[j]]$dominant_left_lower+1]
        addpoints_left$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_left_lower],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_left_lower],
                                           tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_left_lower+1],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_left_lower+1],
                                           meta$cutbound$orig[[tmpvargroup]][tmpdata$ywrapgroup[meta$ywrapline[[i]][[j]]$dominant_left_lower+1]])
        addpoints_right = data.frame()
        meta$ywrapline[[i]][[j]]$data = rbind(meta$ywrapline[[i]][[j]]$data, addpoints_left, addpoints_right)
      }

      if (length(meta$ywrapline[[i]][[j]]$dominant_right_upper)){
        addpoints_right = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$dominant_right_upper,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_right$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_right_upper],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_right_upper],
                                            tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_right_upper-1],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_right_upper-1],
                                            meta$cutbound$orig[[tmpvargroup]][tmpdata$ywrapgroup[meta$ywrapline[[i]][[j]]$dominant_right_upper-1]+1])
        addpoints_left = data.frame()
        meta$ywrapline[[i]][[j]]$data = rbind(meta$ywrapline[[i]][[j]]$data, addpoints_left, addpoints_right)
      }

      if (length(meta$ywrapline[[i]][[j]]$dominant_right_lower)){
        addpoints_right = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$dominant_right_lower,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_right$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_right_lower],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_right_lower],
                                            tmpdata$xtmp[meta$ywrapline[[i]][[j]]$dominant_right_lower-1],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$dominant_right_lower-1],
                                            meta$cutbound$orig[[tmpvargroup]][tmpdata$ywrapgroup[meta$ywrapline[[i]][[j]]$dominant_right_lower-1]])
        addpoints_left = data.frame()
        meta$ywrapline[[i]][[j]]$data = rbind(meta$ywrapline[[i]][[j]]$data, addpoints_left, addpoints_right)
      }

      if (length(meta$ywrapline[[i]][[j]]$recessive_up)){
        addpoints_left = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$recessive_up,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_left$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_up],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_up],
                                           tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_up+1],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_up+1],
                                           meta$cutbound$orig[[tmpvargroup]][j])
        addpoints_right = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$recessive_up+1,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_right$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_up],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_up],
                                            tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_up+1],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_up+1],
                                            meta$cutbound$orig[[tmpvargroup]][j+1])
        meta$ywrapline[[i]][[j]]$data = rbind(meta$ywrapline[[i]][[j]]$data, addpoints_left, addpoints_right)
      }

      if (length(meta$ywrapline[[i]][[j]]$recessive_dn)){
        addpoints_left = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$recessive_dn,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_left$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_dn],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_dn],
                                           tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_dn+1],
                                           tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_dn+1],
                                           meta$cutbound$orig[[tmpvargroup]][j+1])
        addpoints_right = meta$ywrapline[[i]][[j]]$data[meta$ywrapline[[i]][[j]]$recessive_dn+1,c('xtmp','ytmp','id'),drop=FALSE]
        addpoints_right$xtmp = crosspoint_x(tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_dn],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_dn],
                                            tmpdata$xtmp[meta$ywrapline[[i]][[j]]$recessive_dn+1],
                                            tmpdata$yscaled[meta$ywrapline[[i]][[j]]$recessive_dn+1],
                                            meta$cutbound$orig[[tmpvargroup]][j])
        meta$ywrapline[[i]][[j]]$data = rbind(meta$ywrapline[[i]][[j]]$data, addpoints_left, addpoints_right)
      }

      meta$ywrapline[[i]][[j]]$data = meta$ywrapline[[i]][[j]]$data[order(meta$ywrapline[[i]][[j]]$data$xtmp),]
    }
  }

  # update the settings
  update_meta_group(meta)
  update_meta_xwrap_color(meta,data)
  meta$limits[3:4] = extend_ranges(range(c(meta$data$ytmp,if(meta$ngroup$y==1 & meta$ngroup$id==1){diff(range(ytmp))*meta$steplen$yzoom}),na.rm=TRUE))
  meta_yaxis(meta)
}

# key Up/Down for adjusting the point size / line width
size_up = function(meta){
  meta$radius = meta$radius + 1
}
size_down = function(meta){
  meta$radius = max(0.1, meta$radius - 1)
}

# aspect ratio
asp_ratio = function(x,y){
  if (length(x)!=length(y)) return(0.5)
  x = (x-min(x,na.rm=TRUE))/(max(x,na.rm=TRUE)-min(x,na.rm=TRUE))
  y = (y-min(y,na.rm=TRUE))/(max(y,na.rm=TRUE)-min(y,na.rm=TRUE))
  r = diff(y)/diff(x)
  f = function(a,r){mean(abs(atan(a*r)))-pi/3}
  a = try(uniroot(f,c(0.1,1),r)$root, silent = TRUE)
  if (class(a) == 'try-error') a = 0.5
  return(a)
}