############################################################### # # # (c) Toni Giorgino # # 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); }