https://github.com/cran/dtw
Raw File
Tip revision: f3fa0a2ccb9bde3782d3555dfc9ebd3381d1757f authored by Toni Giorgino on 30 November 2007, 00:00:00 UTC
version 0.4-2
Tip revision: f3fa0a2
globalCostNative.R
###############################################################
#                                                             #
#   (c) Toni Giorgino <toni.giorgino@gmail.com>               #
#       Laboratory for Biomedical Informatics                 #
#       University of Pavia - Italy                           #
#       www.labmedinfo.org                                    #
#                                                             #
#   $Id: globalCostMatrix.R 27 2007-12-06 14:18:41Z tonig $
#                                                             #
###############################################################


########################################
## Compute the cost matrix from a local distance matrix

## Wrapper to the native function





`globalCostNative` <-
function(lm,
         step.matrix=symmetric1,
         window.function=noWindow,
         ...) {


  ## sanity check - be extra cautions w/ binary
  if (!is.stepPattern(step.matrix))
    stop("step.matrix is no stepMatrix object");



  # i = 1 .. n in query sequence, on first index, ie rows
  # j = 1 .. m on template sequence, on second index, ie columns
  #   Note:  template is usually drawn vertically, up-wise

  n <- dim(lm)[1];
  m <- dim(lm)[2];


  # number of individual steps (counting all patterns)
  nsteps<-dim(step.matrix)[1];


  # clear the cost and step matrix
  # these will be the outputs of the binary
  cm <- matrix(NA,nrow=n,ncol=m);
  sm <- matrix(NA,nrow=n,ncol=m);


  ## precompute windowing
  wm <- matrix(FALSE,nrow=n,ncol=m);
  wm[window.function(row(wm),col(wm),
	query.size=n, template.size=m,
	...)]<-TRUE;
  
  
  # initializer
  cm[1,1] <- lm[1,1];

  
  tmp<-.C("computeCM",NAOK=TRUE,PACKAGE="dtw",
     as.integer(dim(cm)),               # s
     as.logical(wm),                    #
     as.double(lm),
     as.integer(nsteps),
     as.double(step.matrix),
     cmo=as.double(cm),                     # OUT
     smo=as.integer(sm));                   # OUT

  cm<-matrix(tmp$cmo,nrow=n,ncol=m);
  sm<-matrix(tmp$smo,nrow=n,ncol=m);


  out<-list();
  out$costMatrix<-cm;                   # to get distance
  out$directionMatrix<-sm;              # to backtrack
  out$stepPatterns<-step.matrix;        # to backtrack

  return(out);
}

back to top