.packageName <- "msbase"
## --------------------------------------------------------------------------
## msbase - R package for mass spectrometric peaklist manipulation
## --------------------------------------------------------------------------
##  Copyright (C) 2003 -- Witold E. Wolski
##
##  This library is free software; you can redistribute it and/or
##  modify it under the terms of the GNU Lesser General Public
##  License as published by the Free Software Foundation; either
##  version 2.1 of the License, or (at your option) any later version.
##
##  This library is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
##  Lesser General Public License for more details.
##
##  You should have received a copy of the GNU Lesser General Public
##  License along with this library; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
##
## --------------------------------------------------------------------------
## --------------------------------------------------------------------------
##
library(methods)

setClass("List"
         ,representation(
                         uniq="logical" #names have to be unique?
                         ,content="character"
                         ,names="character") 
         ,contains="list"
         ,prototype(uniq=FALSE)
         )

setAs("List","list"
      ,def=function(from)
      {
        to<-from@.Data
        names(to)<-from@names
        to
      }
      ,replace = function(from,value)
      {
        if(is.null(attributes(value)$names))
          attributes(value)$names <- character(0)
        from@.Data <- value
        from@names <- names(value)
        from	
      }
 )

setReplaceMethod("[[", "List"
                 , function(x, i, j,..., value)
                 {
                   cv <- class(value)
                   cont <- x@content
                   if( !extends(cv, cont) )
                     stop(paste("the container is class", cont,
                                "the object is class", cv, "cannot assign.",
                                sep=" "))
                   x@.Data[[i]]<-value
                   x
                 })

setMethod("[",
          "List",
          def = function(x, i, j, ..., drop = FALSE)
          {
            as(x,"list") <- as(x,"list")[i]
            return(x)
          }
          )

setReplaceMethod("[","List"
                 ,function(x,i,j,...,value)
                 {
                   x@.Data[i]<-value
                   x
                 }
                 )

## --------------------------------------------------------------------------
## msbase - R package for mass spectrometric peaklist manipulation
## --------------------------------------------------------------------------
##  Copyright (C) 2003 -- Witold E. Wolski
##
##  This library is free software; you can redistribute it and/or
##  modify it under the terms of the GNU Lesser General Public
##  License as published by the Free Software Foundation; either
##  version 2.1 of the License, or (at your option) any later version.
##
##  This library is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
##  Lesser General Public License for more details.
##
##  You should have received a copy of the GNU Lesser General Public
##  License along with this library; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
##
## --------------------------------------------------------------------------
## --------------------------------------------------------------------------
##

library(methods)


gelimage <- function(object,...)
  {
    tmp <- do.call("rbind",lapply(object,function(x){x@gelcoor}))
    print(dim(tmp))
    plot( tmp[,1] , tmp[,2] , ... )
  }



getCoorNames<-function(object)
  {

    ntmp <- do.call("rbind",lapply(object,function(x){names(x@tcoor)}))
    tmp <- do.call("rbind",lapply(object,function(x){x@tcoor}))
    res <- list(coorX= tmp[,1], coorY = tmp[,2])

    if(!is.null(ntmp))
      {
        names(res$coorX) <- ntmp[,1]
        names(res$coorY) <- ntmp[,2]
      }
    else
      {
        names(res$coorX) <- tmp[,1]
        names(res$coorY) <- tmp[,2]
      }
    res
  }


myimage2 <- function(x,what="",col = terrain.colors(100),digits=4,cex.axis=1,cex.main=1,...)
  {
    ##t Display a Color Image
    ##- Creates a grid of colored or gray-scale rectangles with colors
    ##- corresponding to the values in 'z'.  This can be used to display
    ##- three-dimensional or spatial data aka "images". This is a generic
    ##- function.
    ##+ x : object of class mlist. (e.g: caliblist or massvectorlist)
    ##+ what : what value to display on the image.
    ##+ col : a list of colors such as that generated by 'rainbow', 'heat.colors', 'topo.colors', 'terrain.colors' or similar functions.
    ##e data(mvl)
    ##e image(mvl,what="lengthmv")
    if(length(x)==0)
      {
        warning("List has length 0")
        return()
      }
    res <- as(x,"matrix")
    res <<- res
    if(! what %in% colnames(res))
      stop("Only following fields can be shown for ", class(x)[1]," : \n", paste(colnames(res),collapse = " "),"\n pass one to the what paramter.")
    nam <- getCoorNames(x)
    
    if(!is.null(names(nam$coorX)) & !is.null(names(nam$coorY)))
      {
        X <- nam$coorX[unique(names(nam$coorX))]
        Y <- nam$coorY[unique(names(nam$coorY))]
        XX <- 1:max(X)
        names(XX)<-rep("",max(X))
        names(XX)[X]<-names(X)
        X<-XX
        YY <- 1:max(Y)
        names(YY)<-rep("",max(Y))
        names(YY)[Y]<-names(Y)
        Y<-YY
      }
    else
      {
        X <- unique(nam$coorX)
        Y <- unique(nam$coorY)
      }
    hello <- matrix(NA,max(X),max(Y))
    for(z in 1:length(x))
      {
        ass <- res[z,what]
        hello[ nam$coorX[z] , nam$coorY[z] ] <- ass
      }

    if(!is.null(names(X)) & !is.null(names(Y)))
      {
        rownames(hello) <- names(X)
        colnames(hello) <- names(Y)
      }
    hello <<- hello
                                        #par(bg="gray")
    
    tmar<-par()$mar
    
    tres <- na.omit(c(hello))
    if(min(tres)!=max(tres))
      {
        scale<-seq(min(tres),max(tres),(max(tres)-min(tres))/(dim(hello)[1]-1))
      }
    else
      {
        scale<-rep(min(tres),(dim(hello)[1]-1))
      }
    
    hello <- cbind(hello,rep(NaN,dim(hello)[1]),scale)
    Y<-c(names(sort(Y)),"","S")
    scale <- matrix(scale,nrow=1)
    
                                        #define layout
                                        #nf <- layout(matrix(c(1,2),1,2),widths=c(5,1), TRUE)
    par(mar=c(2.5,3,3.5,1))
                                        #tmp<<-hello
    
    image(hello , xaxs="i",yaxs="i",axes=FALSE,col=col,...)
    mtext(what ,side=3,line=2,font=3,cex=cex.main)
    if((length(Y)-1)>0)
      {
        axis( 2 , at=seq(0,1,1/(length(Y)-1)) , labels=Y,cex.axis=cex.axis,las=1)
      }
    if((length(X)-1)>0)
      {
        axis( 1 , at=seq(0,1,1/(length(X)-1)) , labels=names(sort(X)),cex.axis=cex.axis)
      }
    else
      {
        axis(1,at=6,labels=names(X),cex.axis=cex.axis)
      }
                                        #par(mar=c(3,0,2,0.5))
                                        #lable<-""
                                        #image(1,1:10,scale,axes=FALSE,xlab="",ylab="",col=col,main=lable )
    scalet<-format(scale,digits=digits)
    if((length(X)-1)>0)
      {
        axis( 3 , at=seq(0,1,1/(length(X)-1)) , labels=scalet,cex.axis=cex.axis)
      }
    else
      {
        axis( 3 ,at=6,labels=scalet,cex.axis=cex.axis)
      }
            #par(mar=tmar)
    invisible(t(hello))
  }


#########################################################
#  Here goes the definition of class Mlist
#  Its the superclass of all list classes in the package.
#
#elements of mlist must contain an info field.
#########################################################


setClass("Mlist"
         ,representation(uniq="logical",content="character",names="character") #names have to be unique?
         ,contains="List"
         ,prototype(uniq=FALSE)
         )


#Each class inheriting from Mlist must implement methods
#as(obj,"data.frame"), as(obj,"matrix")...
#every object stored in the Mlist must have a field tcoor.

##
##
##

#setMethod("names",signature(x="Mlist")
#           ,function(x)
#           {
#             if(is.na(x@names))
#               {
#                 x@names<-sapply(x,function(y){y@info})
#               }
#             return(x@names)
#           )
#          )



setReplaceMethod("[[", "Mlist"
                 , function(x, i, j,..., value)
                 {
                   cv <- class(value)
                   cont <- x@content
                   if( !extends(cv, cont) )
                     stop(paste("the container is class", cont,
                                "the object is class", cv, "cannot assign.",
                                sep=" "))
                   x@.Data[[i]]<-value
                   if(class(i)=="numeric")
                     x@names[i]<-value@info
                   x
                 })

setMethod("subset",signature(x="Mlist")
          ,def=function(x,subset,...)
          {
            ##t Subset Mlist
            ##- Return subsets of list elements which meet conditions.
            ##+ x : object of class mlist
            ##+ subset : logical expression.
            ##e data(mvl)
            ##e mvl<-subset(mvl,lengthmv>30)
            u <- as(x,"data.frame")
            if (missing(subset))
              {
                r <- TRUE
                cat("For subsetting use comparison on : \n", join(names(u),sep=" ")  ,"\n")
                return()
              }
            else {
              e <- substitute(subset)
              r <- eval(e, u, parent.frame())
              r <- r & !is.na(r)
            }
            vars <- TRUE
            u <- u[r, vars, drop = FALSE]
            x[as.character(u$info)]
          })


setMethod("image"
          ,signature(x="Mlist")
          ,definition=myimage2
          )

#upnames<-function(x)
#  {
#    tmp <- sapply(x,function(x){x@info})
#  }



peaks<-function(object,...)
  UseMethod("peaks")


peaks.default<-function(object, max=TRUE,na.rm=FALSE,...){
  ##t Find peaks
  ##- Finds peaks - neighborpeaks smaller than central.
  ##+ object : numeric array.
  ##+ max : TRUE find maxima, FALSE find minima
  ##+ na.rm : handling of na.rm values.
  ##v index : index of the peaks   
  x<-object
  if (na.rm)
   omit<-is.na(x)
  else
   omit<-FALSE
  if (max){
   rval<-1+which(diff(sign(diff(x[!omit])))<0)
  }else{
   rval<-1+which(diff(sign(diff(x[!omit])))>0)
  }
  if (na.rm)
  {
   rval<-rval+cumsum(omit)[rval]
  }
  rval
}
## --------------------------------------------------------------------------
## msbase - R package for mass spectrometric peaklist manipulation
## --------------------------------------------------------------------------
##  Copyright (C) 2003-2004 -- Witold E. Wolski
##
##  This library is free software; you can redistribute it and/or
##  modify it under the terms of the GNU Lesser General Public
##  License as published by the Free Software Foundation; either
##  version 2.1 of the License, or (at your option) any later version.
##
##  This library is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
##  Lesser General Public License for more details.
##
##  You should have received a copy of the GNU Lesser General Public
##  License along with this library; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
##
## --------------------------------------------------------------------------
## --------------------------------------------------------------------------
##

library(methods)


##
##t Class Massvector
##- Stores peak-lists
setClass("Massvector"
         ,representation(
                         info="character" #info
                         ,tcoor="numeric" #tcoor
                         ,gelcoor="numeric" #gelcoor
                         ,access="character" #access
                         ,pionm="numeric"
                         ) #parent ion mass
         ,contains="matrix"
         ,prototype( tcoor=numeric(2) , gelcoor=c(X=0,Y=0) , info="",pionm=0 , access="")
         )

setAs("matrix","Massvector"
      ,def= function(from)
      {
        return(new("Massvector",from))
      }
      )


setAs("Massvector","numeric"
      ,function(from)
      {
        res <- c(from@tcoor,from@gelcoor,length(from@.Data[,1]))
        if(is.null(names(from@tcoor)))
          {
            tt <- c("tcoorX","tcoorY")
          }
        else
          {
            tt <- names(from@tcoor)
          }
        if(is.null(names(from@gelcoor)))
          {
            gt <- c("gelcoorX","gelcoorY")
          }
        else
          {
            gt <- names(from@gelcoor)
          }
        names(res) <- c( tt , gt , "lengthmv" )
        if(length(from) > 0)
          {
            res <- c(length(from), summary(from[,1,drop=TRUE]) , summary(from[,2,drop=TRUE]) )
            names(res)<- c("lengthmv",paste(names(summary(from[,1,drop=TRUE])),"mass",sep=""),paste(names(summary(from[,1,drop=TRUE])),"int",sep=""))
          }
        else
          {
            res <- c(0, rep(0,6),rep(0,6))
            names(res)<- c("lenghtmv",paste(names(summary(1:4)),"mass",sep=""),paste(names(summary(1:4)),"int",sep=""))
          }
        res
      })

setAs("Massvector","list"
      ,function(from)
      {
        tmp<-list(info=from@info
             ,access=from@access
             ,tcoorXN=names(from@tcoor)[1]
             ,tcoorX=from@tcoor[1]
             ,tcoorYN=names(from@tcoor)[2]     
             ,tcoorY=from@tcoor[2]
             ,gelcoorX=from@gelcoor[1]
             ,gelcoorY=from@gelcoor[2]
             ,lengthmv=length(from)
         )
        if(length(from) > 0)
          {
            res <- c( summary(from[,1,drop=TRUE]) , summary(from[,2,drop=TRUE]) )
            names(res)<- c(paste(names(summary(from[,1,drop=TRUE])),"mass",sep=""),paste(names(summary(from[,2,drop=TRUE])),"int",sep=""))
          }
        else
          {
            res <- c( rep(0,6),rep(0,6))
            names(res)<- c(paste(names(summary(1:4)),"mass",sep=""),paste(names(summary(1:4)),"int",sep=""))
          }
        tmp<-c(tmp,as.list(res))
        tmp
      }
      )

setAs("Massvector","data.frame"
      ,function(from)
      {
        return(as.data.frame(as(from,"list")))
      }
      )

c.Massvectorlist<-function(x,...)
  {
    ##t Combine Massvectors into one Massvector.
    ##- Combines Massvectors into one Massvector.
    ##+ x : Massvectorlist
    ##+ ... : Massvectors to be concatenated.
    ##sa rbind
    ##v massvector : massvector
    ##e data(mv1)
    ##e data(mv2)
    ##e par(mfrow=c(2,1))
    ##e plot(mv1)
    ##e plot(mv2,add=TRUE)
    ##e plot(c(mv1,mv2))
    tmp<-list(...)
    for(ll in tmp)
      {
        if(inherits(ll,"Massvectorlist"))
          {
            tt<-length(x)
            x[(tt+1):(tt+length(ll))]<-ll
            names(x)[(tt+1):(tt+length(ll))]<-names(ll)
          }
      }
    return(x)
  }

c.Massvector<-function(x,...)
{
    ##t Combine Massvectors into one Massvector.
    ##- Combines Massvectors into one Massvector.
    ##+ x : Massvectorlist
    ##+ ... : Massvectors to be concatenated.
  aa <- as(x,"matrix")
  tmp<-list(...)
  for(ll in tmp)
    {
      if(inherits(ll,"Massvector"))
        {
          aa <- rbind(aa,as(ll,"matrix"))
        }
    }
  as(x,"matrix") <- aa
  return(x)
}
  
setMethod("initialize"
          ,signature(.Object="Massvector")
          ,function(.Object,data,info,tcoor,gelcoor,access,pionm)
          {
            if(missing(data))
              {
                data <- matrix(,0,2)
                colnames(data) <- c("mass","C1")
                .Object@.Data<-data
              }
            else
              {
                tmp <- colnames(data)
                if(dim(data)[1]>0)
                  {
                    tt<-order(data[,1])
                    data <- data[tt,,drop=FALSE] #sort the matrix
                    #tt<-diff(data[,1])
                    #if(length(which(tt==0))>0)
                    #data <-data[-which(tt==0),] #eliminate identical entries.
                  }
                if(length(tmp)>0)
                  tmp[1]<-"mass"
                else
                  {
                    tmp<-paste("C",1:(dim(data)[2]),sep="")
                    tmp[1]<-"mass"
                  }
                colnames(data)<-tmp
                .Object@.Data<-data
              }
            if(!missing(info))
              .Object@info<-info
            if(!missing(tcoor))
              {
                if(length(tcoor)<2)stop("At least 2 Target coordinates are needed.");
                .Object@tcoor<-tcoor
              }
            if(!missing(gelcoor))
              {
                if(length(tcoor)<2)stop("At least 1 Gel coordinates are needed.");
                .Object@gelcoor<-gelcoor
              }
            if(!missing(access))
              .Object@access <- access
            if(!missing(pionm))
              .Object@pionm <- pionm
            .Object
          })


setMethod("show"
          ,signature(object="Massvector")
          ,function(object)
          {
            cat("info    : ",object@info,"\n")
            cat("tcoor   : ",object@tcoor,"\n")
            cat("gelcoor : ",object@gelcoor,"\n")
            cat("access  : ",object@access,"\n")
            print(object@.Data)
          }
          )


rbind.Massvector<-function(...,deparse.level=1)
  {
    ##t Combine Massvectors into one Massvector.
    ##- Combines Massvectors into one Massvector.
    ##+ x : massvector
    ##+ ... : massvectors to be concatenated.
    ##sa rbind
    ##v massvector : massvector
    ##e data(mv1)
    ##e data(mv2)
    ##e par(mfrow=c(2,1))
    ##e plot(mv1)
    ##e plot(mv2,add=TRUE)
    ##e plot(c(mv1,mv2))
    tmp<-list(...)
    mychecker<- function(x)
      {
        if(class(x)!="Massvector")
          stop("rbind.Massvectors expects Massvectors only!")
        as(x,"matrix")
      }
      x <- new("Massvectorlist"
               ,do.call(rbind,lapply(tmp,mychecker))
               ,info=x@info
               ,tcoor=x@tcoor
               ,gelcoor=x@gelcoor
               ,access=x@access
               )
    x
  }

setMethod("summary",signature(object="Massvector")
          ,function(object,...)
          {
                tmp <- dim(object)[2]
                res <- list( lengthmv=length(object) )
                for(i in 1:tmp)
                  {
                    xx<-object[,i]
                    res <- c(res,list(summary(ifelse(length(xx)>0,xx,0))))
                    names(res)[i+1]<-colnames(object)[i]
                  }
                res
          })


setMethod("[",signature(x="Massvector")
          ,def = function(x, i, j, ..., drop = FALSE)
          {
            if(!missing(i)&missing(j))
              {
                y<-as(x,"matrix")
                as(x,"matrix")<-y[i,,drop=drop]
                return(x)
              }
            else if(missing(i) & !missing(j))
              {
                y<-as(x,"matrix")
                return(y[,j,drop=drop])
              }
            else if(!missing(i) & !missing(j))
              {
                y<-as(x,"matrix")
                return(y[i,j,drop=drop])
              }
          })

setMethod("length",signature(x="Massvector")
          ,function(x)
          {
            return(length((as(x,"matrix")[,1])))
          }
          )

setMethod("plot",signature(x="Massvector",y="Massvector")
          ,function(x,y,error=300,ppm=TRUE,...)
          {
            tmp <- fmatchall(x,y,error = error,ppm = ppm)
            xrang<-range(c(x[,1],y[,1]))
            if(length(tmp$plind)>0)
              {
                if(ppm)
                  ressid<-(y[tmp$calind,1] - x[tmp$plind,1])*1e6/y[tmp$calind,1]
                else
                  ressid<-y[tmp$calind,1] - x[tmp$plind,1]
                ressavg<-(y[tmp$calind,1] + x[tmp$plind,1] )/2
                yrang<-range( ressid )
                plot(ressavg
                     ,ressid
                     ,col=2
                     ,pch=7
                     ,cex=2
                     ,ylim=yrang
                     ,xlim=xrang
                     ,xlab="[m/z]"
                     ,ylab= ""
                     ,...)
                
                if(ppm)
                  {
                    mtext(expression(paste(((y-x)*10^6)/y," [ppm]")),side=2,line=2)
                  }
                else
                  {
                    mtext(expression(paste( y-x ," [m/z]")),side=2,line=2)
                  }
                
              }
            else
              plot(0,0,col=0,xlim=xrang)
            abline(v=x[tmp$nplind,1],col=3,lty=3)
            abline(v=y[tmp$ncalind,1],col=4,lty=2)
          })

setMethod("plot",signature(x="Massvector",y="missing")
          ,function(x,xlab="m/z",ylab="area",...)
          {
            plot(x[,1],x[,2],type="h",xlab=xlab,ylab=ylab,...)
            abline(h=0)
          }
          )


##t Display a Color Image
##- Creates a grid of colored or gray-scale rectangles with colors
##- corresponding to the mass differences within the peaklist
##- or within two peaklists.
##+ x : massvector
##+ mv2 : massvector
##+ error : up to which mass difference display the differences.
##+ col : a list of colors such as that generated by `rainbow',`heat.colors', `topo.colors', `terrain.colors' or similar functions.
##... : graphical parameters for `plot' may also be passed as arguments to this function.
##sa plot.massvector, hist.massvector
##e data(mv2)
##e data(mv1)
##e image(mv1,mv2)
##e image(mv1,mv2,error=500)



setMethod("image"
          ,signature(x="Massvector")
          ,function(x
                    ,mv2
                    ,error=NULL
                    ,ppm=FALSE
                    ,col=topo.colors(100)
                    ,...)
  {
      if(!missing(mv2))
      {
        if(!inherits(mv2,"Massvector"))
          stop("Second arg should be a massvector too!\n")
      }
    else
      {
        mv2 <- x
      }
    res <- NULL
    for(u in 1:length(x[,1]))
      {
        if(ppm)
          tmp<-abs(mv2[,1,drop=TRUE]-x[u,1])/mv2[,1,drop=TRUE]*10e6
        else
          tmp<-abs(mv2[,1,drop=TRUE]-x[u,1])
        tmp[tmp>error]<-NA
        res<-rbind(res,tmp)
      }
    par(bg="gray")
    nf <- layout(matrix(c(1,2),1,2),widths=c(4,1), TRUE)
    tmar<-par()$mar
    par(mar=c(5,5,1,1))
    image(1:length(x[,1]),1:length(mv2[,1]),res,col=col,xlab=x@info,ylab=mv2@info)
    tres<-na.omit(c(res))
    if(min(tres)!=max(tres))
      {
        scale<-seq(min(tres),max(tres),(max(tres)-min(tres))/9)
      }
    else
      {
        scale<-rep(min(tres),10)
      }
    scale<-matrix(scale,nrow=1)
    par(mar=c(5,1,1,1))
    image(1,1:10,scale,axes=FALSE,xlab="",ylab="",col=col)
    scalet<-format(scale,digits=1)
    for(u in 1:length(scalet))
      {
        text(25,u,scalet[u])
      }
    layout(matrix(1))
    par(mar=tmar)
    invisible(res)
  })

if (!isGeneric("readMV"))
    setGeneric("readMV",
               function(object,src,...)
               standardGeneric("readMV"))

setMethod("readMV"
          ,signature(object="Massvector",src="character")
          ,function(object,src,file=object@info,...)
          {
            print(src)
            filep <- file.path(src, file , fsep = .Platform$file.sep)
            print(filep)
            con<-file(filep,"r")
            res <- readLines(con=filep,n=-1)
            close(con)
                                        #return(res)
            res1 <- unlist(strsplit(res[1],":"))
            object@info=sub(">","",res1[1])
            object@tcoor = unlist(strsplit(res1[2],","))
            intern<-function(x){as.numeric(unlist(strsplit(x,"\t")))}
            res <- t(sapply(res[2:length(res)],intern))
            res<-res[order(res[,1]),]
            rownames(res)<-1:length(res[,1])
            colnames(res)<-c("mass","int")
            object@.Data=res
            return(object)
          }
          )


#if(!isGeneric("writeMV"))
    setGeneric("writeMV",
               function(object,path,...)
               standardGeneric("writeMV"))

setMethod("writeMV"
          ,signature(object="Massvector",path="character")
          ,function(object,path,file=object@info,...)
          {
            if(missing(path))
              {
                path<-"."
              }
            
            filep <- file.path(path,paste(file,".",ext,sep=""),fsep = .Platform$file.sep)
            con <- file(filep, "w")  # open an output file connection
            firstline<-paste(">",file,":",paste(object@tcoor,collapse=","),sep="")
            writeLines(firstline,con=con)
            close(con)
            write.table(object,file = filep, append = TRUE, quote = FALSE, sep = "\t",
                        eol = "\n", na = "NA", dec = ".", row.names = FALSE,
                        col.names = FALSE, qmethod = c("escape", "double"))
          }
          )

##===================================================================================================
## basic peaklist operations
##===================================================================================================



##===================================================================================================
## setequal -  checks if the sets are identical
##===================================================================================================


if (!isGeneric("fsetequal"))
    setGeneric("fsetequal",
               function(obx,oby,...)
               standardGeneric("fsetequal"))

setMethod(
          "fsetequal"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            obx<-sort(as.numeric(levels(as.factor(obx))))
            oby<-sort(as.numeric(levels(as.factor(oby))))
            res<-.Call("fullMatchSexp"
                       ,obx
                       ,oby
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            return((length(res$nplind)==0) & (length(res$ncalind)==0))
          }
)

setMethod("fsetequal"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            res<-.Call("fullMatchSexp"
                       ,obx[,1]
                       ,oby[,1]
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            return((length(res$nplind)==0) & (length(res$ncalind)==0))
          }
)

##===================================================================================================
## is.element - returns true for each element of x if it is contained in y.
##===================================================================================================

if (!isGeneric("fis.element"))
    setGeneric("fis.element",
               function(obx,oby,...)
               standardGeneric("fis.element"))

setMethod("fis.element"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,uniq=TRUE)
          {
            obx<-sort(as.numeric(levels(as.factor(obx))))
            oby<-sort(as.numeric(levels(as.factor(oby))))
            res<-.Call("fullMatchSexp"
                       ,obx
                       ,oby
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            res2<-rep(TRUE,length(obx))
            res2[res$nplind]<-FALSE
            return(res2)
          }
)

setMethod("fis.element"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            res<-.Call("fullMatchSexp"
                       ,obx[,1]
                       ,oby[,1]
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            res2<-rep(TRUE,length(obx[,1]))
            res2[res$nplind]<-FALSE
            return(res2)
          }
          )



##===================================================================================================
## returns the overlapping part of x and y.
##===================================================================================================
##
## Intersect version which returns the average of the matching peaks.
##
if (!isGeneric("fintersect"))
    setGeneric("fintersect",
               function(obx,oby,...)
               standardGeneric("fintersect"))


setMethod("fintersect"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            obx<-sort(as.numeric(levels(as.factor(obx))))
            oby<-sort(as.numeric(levels(as.factor(oby))))
            return(.Call("intersectMV"
                         ,obx
                         ,oby
                         ,error=error
                         ,ppm=ppm
                         ,uniq=uniq
                         ,PACKAGE="msbase"
                         ))
          }
          )

setMethod("fintersect"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {

             tmp <- .Call("intersectMV"
                         ,obx[,1]
                         ,oby[,1]
                         ,error=error
                         ,ppm=ppm
                         ,uniq=uniq
                         ,PACKAGE="msbase"
                         )
             colnames(tmp) <- c("mass","freq")
             as(obx,"matrix")<-tmp
            obx
          }
          )



##==============================================
## finterS
##===============================================
if (!isGeneric("finterS"))
    setGeneric("finterS",
               function(obx,oby,...)
               standardGeneric("finterS"))

setMethod("finterS"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=FALSE)
          {
            obx <- sort(as.numeric(levels(as.factor(obx))))
            oby <- sort(as.numeric(levels(as.factor(oby))))
            res <- .Call(
                         "fullMatchSexp"
                         ,obx
                         ,oby
                         ,error = error
                         ,ppm = ppm
                         ,uniq = uniq
                         ,PACKAGE = "msbase"
                       )
            if(length(res$plind)>0)
              return( obx[res$plind] )
            else
              return( obx[NULL] )
          }
)

setMethod("finterS"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=FALSE)
          {
            res<-.Call("fullMatchSexp"
                       ,obx[,1]
                       ,oby[,1]
                       ,error = error
                       ,ppm = ppm
                       ,uniq = uniq
                       ,PACKAGE = "msbase"
                       )
            if( length(res$plind) > 0 )
              return(obx[res$plind,])
            else
              return(obx[NULL,])
          }
)


##===================================================================================================
## returns the part of x not in y.
##===================================================================================================


if (!isGeneric("fsetdiff"))
    setGeneric("fsetdiff",
               function(obx,oby,...)
               standardGeneric("fsetdiff"))

setMethod("fsetdiff"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,uniq=FALSE
                    )
          {
            if(length(oby)==0)
              return(obx)
            obx <- sort(as.numeric(levels(as.factor(obx))))
            oby <- sort(as.numeric(levels(as.factor(oby))))
            res <- .Call(
                         "fullMatchSexp"
                         ,obx
                         ,oby
                         ,error = error
                         ,ppm = ppm
                         ,uniq = uniq
                         ,PACKAGE = "msbase"
                       )
            if(length(res$nplind)>0)
              return( obx[res$nplind] )
            else
              return(obx[NULL])
          }
)

setMethod("fsetdiff"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=FALSE)
          {
            if(length(oby)==0)
              return(obx)
            res<-.Call("fullMatchSexp"
                       ,obx[,1]
                       ,oby[,1]
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            if(length(res$nplind)>0)
              return(obx[sort(res$nplind),])
            else
              return(obx[NULL,])
          }
)


##===================================================================================================
## returns the union of x and y
##===================================================================================================

if (!isGeneric("funion"))
    setGeneric("funion"
               ,function(obx,oby,...)
               standardGeneric("funion"))


setMethod("funion"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,uniq=TRUE)
          {
            res <- .Call("munionSEXP"
                       ,obx[,1]
                       ,oby[,1]
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            colnames(res) <- c("mass","freq")
            res <- new("Massvector",res)
            res@info <- obx@info
            res@tcoor <- obx@tcoor
            res@gelcoor <- obx@gelcoor
            res@pionm <- obx@pionm
          }
          )

setMethod("funion"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            obx<-sort(as.numeric(levels(as.factor(obx))))
            oby<-sort(as.numeric(levels(as.factor(oby))))
            res<-.Call("munionSEXP"
                       ,obx
                       ,oby
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            colnames(res)<-c("mass","freq")
            res
          }
          )

##===================================================================================================
## Returns the matching indices plind, calind, the nonmatching indices nplind, ncalind
##===================================================================================================

##t Matching masses
##- Returns the indices of the matching peaks and the complement.

if (!isGeneric("fmatchall"))
  setGeneric("fmatchall",
             function(obx,oby,...)
             standardGeneric("fmatchall"))

setMethod("fmatchall"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=T)
          {
            res<-.Call("fullMatchSexp"
                       ,obx
                       ,oby
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            res
          })

setMethod("fmatchall"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=T)
          {
            res<-.Call("fullMatchSexp"
                       ,obx[,1]
                       ,oby[,1]
                       ,error=error
                       ,ppm=ppm
                       ,uniq=uniq
                       ,PACKAGE="msbase"
                       )
            res
          })



##===================================================================================================
## Returns the matching indices plind, calind
##===================================================================================================

if (!isGeneric("fmatch"))
  setGeneric("fmatch",
             function(obx,oby,...)
             standardGeneric("fmatch"))

##t Matching of masses
##- Returns the indices of matching masses
##+ obx :  numeric vecotor or Massvector

setMethod("fmatch"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            return(.Call("matindSEXP"
                         ,obx
                         ,oby
                         ,error=error
                         ,ppm=ppm
                         ,uniq=uniq
                         ,PACKAGE="msbase"
                         ))
          })


setMethod("fmatch"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,uniq=TRUE
                    )
          {
            return(.Call("matindSEXP"
                         ,obx[,1]
                         ,oby[,1]
                         ,error=error
                         ,ppm=ppm
                         ,uniq=uniq
                         ,PACKAGE="msbase"))
          })

print("test1")
##===================================================================================================
##Defining the massvectorlist
##===================================================================================================
##===================================================================================================
##Class : Massvectorlist
##===================================================================================================






###############################################
##  Define Massvectorlist
###############################################

setClass("Massvectorlist"
         ,representation(
                         info="character"
                         ,project="character"
                         ,experiment="character"
                         ,content="character"
                         )
         ,contains="Mlist"
         ,prototype(info="",project="",experiment="",uniq=FALSE,content="Massvector")
         )

setMethod("unlist",signature(x="Massvectorlist")
          ,function(x,recursive = TRUE, use.names = TRUE)
          {
            as(x,"list") <- x[which(sapply(x,length)>0)]
            res <- do.call("rbind", lapply(x,as,"matrix"))
            res <- new("Massvector",res,info=x@info)
            res
          }
          )

setMethod("initialize"
          ,signature(.Object="Massvectorlist")
          ,function(.Object,data,info,project,experiment)
          {
            if(!missing(data))
              {
                .Object@.Data <- data
              }
            else
              .Object@.Data <- vector("list",0)
            if(!missing(info))
              .Object@info <- info
            if(!missing(project))
              .Object@project <- project
            if(!missing(experiment))
              .Object@experiment <- experiment
            return(.Object)
          }
          )


setMethod("readMV"
          ,signature(object="Massvectorlist",src="character")
          ,function(object,src,file=object@info,...)
          {
            if(missing(src))
              {
                path<-"."
              }
            filep <- file.path(src,file, fsep = .Platform$file.sep)
            con<-file(filep,"r")
            mm <- readLines(con=filep,n=-1)
            starts <- grep(">",mm)
            starts <- c(starts,length(mm))
            res<-object
            intern<-function(xx)
              {
                object<-new("Massvector")
                res1 <- unlist(strsplit(xx[1],":"))
                object@info <- sub(">","",res1[1])
                tmp <- as.numeric(unlist(strsplit(res1[2],",")))
                if(length(tmp)==1)
                  tmp<-c(0,0)
                object@tcoor <- tmp
                intern2<-function(x){as.numeric(unlist(strsplit(x,"\t")))}
                tt<-xx[2:length(xx)]
                rxx <- t(sapply(tt,intern2))
                rxx<-matrix(rxx)

                rxx<-matrix(rxx[order(rxx[,1]),])
                rownames(rxx)<-1:length(rxx[,1])

                as(object,"matrix") <- rxx
                return(object)
              }
            tmpr<-vector("list",(length(starts)-1))
            for(x in 1:(length(starts)-1))
              {

                tmpr[[x]]<-intern(mm[starts[x]:(starts[x+1]-1)])
              }
            close(con)
            as(res,"list") <- tmpr
            return(res)
  }
)



setMethod("hist",signature(x="Massvectorlist")
          ,function(x,accur = 0.1, main=x@info ,xlab="m/z",add=FALSE,col=1,...)
          {
                dat <- unlist(x)
                hist(dat,accur=accur,main=main,xlab=xlab,add=add,col=col,...)
          }
          )

setMethod("hist",signature(x="Massvector")
          ,def=function(x,accur = 0.1, main=x@info ,xlab="m/z",add=FALSE,col=1,...)
          {
                dat <- x[,1]
                xlim <- range(dat)
                                        #attributes(dat)<-NULL
                mhist<-list(NULL)
                                        #assign indices of bins with high peak abundance
                mhist[[1]] <- hist(dat,breaks=seq(min(dat)-accur/2,max(dat) + 1.5*accur,accur),plot=TRUE,main=main,xlab=xlab,xlim=xlim,add=add,col=col,border=col,...)
                mhist[[2]] <- hist(dat,breaks=seq(min(dat)-accur,max(dat) + accur,accur),add=TRUE,col=col,border=col)
          }
          )


#color code the peak intensities.
if (!isGeneric("col.plot"))
    setGeneric("col.plot",
               function(x,...)
               standardGeneric("col.plot"))

setMethod("col.plot",signature(x="Massvectorlist")
          ,function( x , main=x@info,xlab="m/z",xlim=range(unlist(x)[,1]),add=FALSE,cex=0.5,col=1,...)
          {
            par(bg="white")
            allm  <- unlist(x)
            colrange<-range(allm[,2])
            mincolr<-colrange[1]
            colrange<-colrange[2]-colrange[1]
            tt <- col2rgb(col)
            mycol <- function(tt,intx,mincolr,colrange)
              {
                ta <- log(intx +1 - mincolr)/log(colrange) * 255
                if(sum(ta<0)>0)
                  {
                    print(ta)
                  }
                tmp <- rgb(pmin(tt[1]+ ta,255),pmin(tt[2]+ta,255),pmin(tt[3]+ta,255),max=255)
                tmp
              }
            
            if(add)
              {
                for( i in 1:length(x))
                  {
                    if(length(x[[i]])==0)
                      warning("Peaklist ", i , " " ,x[[i]]@info," is empty\n" )
                    else
                      {
                    
                        points(x[[i]][,1]
                               ,rep(i,length(x[[i]]))
                               ,pch = 15
                               ,cex = cex
                               ,col = mycol(tt,x[[i]][,2],mincolr,colrange)
                               )
                      }
                  }
              }
            else
              {
                plot.default(x[[1]][,1]
                             ,rep(1,length(x[[1]][,1]))
                             ,xlim = xlim
                             ,ylim = c(1,length(x))
                             ,pch=15
                             ,cex=cex
                             ,xlab=xlab
                             ,ylab="sample"
                             ,main=main
                             ,col=mycol(tt,x[[1]][,2],mincolr,colrange)
                             ,...)
                for(i in 2:length(x))
                  {
                    if(length(x[[i]])==0)
                      warning("Peaklist ", i , " " ,x[[i]]@info," is empty\n" )
                    else
                      {
                        points(x[[i]][,1]
                               , rep(i,length(x[[i]][,1]))
                               ,pch=15
                               ,cex=cex
                               ,col=mycol(tt,x[[i]][,2],mincolr,colrange)
                           )
                      }
                  }
                abline( h = seq(0,length(x),10) , lty=3)
              }
          }
          )


setMethod("plot",signature(x="Massvectorlist",y="missing")
          ,function(x
                    , main = x@info
                    ,xlab = "m/z"
                    ,ylab = "sample"
                    ,xlim = NULL
                    ,add = FALSE
                    ,col = 1
                    ,cex = 0.5
                    ,pch = 15
                    ,...)
          {
            allm  <- unlist(x)
            yaxis <- numeric(length(allm))
            xaxis <- numeric(length(allm))
                                        #par(bg=gray(0.9))
            sta <- 1
            end <- 0
            for(i in 1:length(x))
              {
                dd<-length(x[[i]])
                if(dd!=0)
                  {
                    end<-end + dd
                    yaxis[sta:end] <- rep(i,dd)
                    xaxis[sta:end] <- x[[i]][,1]
                    sta <- end + 1
                  }
              }
            if(add)
              {
                points(xaxis,yaxis,pch=pch,cex=cex,col=col)
              }
            else
              {
                mmin  <- min(allm)[1]
                mmax <- max(allm)[1]
                if(is.null(xlim))
                  {
                    plot.default(xaxis,yaxis,cex=cex,xlab=xlab,ylab=ylab,main=main,col=col,pch=pch,type="n",...)
                    abline( h = seq(0,length(x),25) , lty=1,col="gray")
                    points(xaxis,yaxis,pch=pch,cex=cex,col=col)
                  }
                else
                  {
                    plot.default(xaxis,yaxis ,xlim = xlim ,ylim = c(1,length(x)) ,pch=pch ,cex=cex ,xlab=xlab ,ylab=ylab ,main=main, col=col, type="n",...)
                    abline( h = seq(0,length(x),25) , lty=1,col="gray")
                    points(xaxis,yaxis,  pch=pch, cex=cex ,col=col)
                  }
              }
          })

##plots the mass role.
setGeneric("pep.plot"
           ,function(x,y,...)
           standardGeneric("pep.plot")
           )



setMethod("pep.plot",signature(x="Massvectorlist",y="missing")
          ,function(x
                    , main=x@info
                    , xlab="m/z"
                    , ylab=expression(p[i]-mod(p[i]))
                    , xlim=range(unlist(x)[,1])
                    , add=FALSE
                    , freq=1.000495
                    , auto=FALSE
                    , ... )
          {
            require(MASS)
            xx<-unlist(x)
            pep.plot(xx,main=main
                     ,xlab=xlab
                     ,ylab=ylab
                     ,xlim=xlim
                     ,add=add
                     ,freq=1.000495
                     ,auto=auto
                     ,...)
          }
          )

setMethod("pep.plot",signature(x="Massvector",y="missing")
          ,function(x
                    , main=x@info
                    ,xlab="m/z"
                    ,ylab="mod([m/z],1)"
                    ,xlim=range(unlist(x)[,1])
                    ,add=FALSE
                    ,freq=1.000495
                    ,auto=FALSE
                    ,...)
          {
            peprole <- freq-1
            y <- x[,1]%%1
            if(add==FALSE)
              plot(x[,1],y,xlim=xlim,xlab=xlab,ylab=ylab,main=main,...)
            else
              points(x[,1],y,...)
            xt <- x[,1]
            curve(0+(peprole*x)%%1,add=TRUE,col=3,lwd=3,lty=3)
            if(auto)
              {
                mlm <- lqs( y~xt )
                abline(mlm,lty = 2 , col = 5 , lwd = 3)
                curve(0 + (coef(mlm)[2]*x)%%1,add=TRUE,col=2)
                legend(3000,0.2,legend=c(paste("Intercept="
                                  ,signif(coef(mlm)[1],digits=2))
                                  ,paste("Slope="
                                         ,signif(coef(mlm)[2],digits=2)))
                       ,col="white")
                legend(1000,0.2,legend=c("theo","lqs","coef(lqs)[2]%%1")
                       ,col=c(3,5,2)
                       ,lty=c(3,2,1)
                       ,lwd=c(3,3,1)
                       )
                invisible(mlm)
              }
            else
              {
                #abline(c(0,peprole),lty = 2 , col = 5 , lwd = 3)
                curve(0 + (peprole*x)%%1,add=TRUE,col=2)
                text(2800,1,paste("slope =",prettyNum(peprole)))#,digits=2)))
                #legend(2500
                #       ,1
                #       ,legend =c(paste("intercept=",0)
                #          ,paste("slope=",signif(peprole,digits=2)))
                #       ,col="white")
              }
          }
          )
########################################################
#
#


setGeneric("mvscale",
             function(object,...)
             standardGeneric("mvscale"))

setMethod("mvscale",signature(object="Massvectorlist")
          ,function (object, center = TRUE, scale = TRUE,error=200,ppm=TRUE,full=FALSE)
          {
            n<-length(object)
            allm<-unlist(object)
            as(object,"list") <- lapply(object,mvscale,allm,n,center=center,scale=scale,error=error,ppm=ppm,full=full)
            object
          }
          )

mvscaletmp <- function( massint , allm, n, error=200 , ppm=TRUE , center=TRUE , scale=TRUE,full=TRUE)
  {
    mass <- massint[1]
    int <- massint[2]
    if(ppm)
      {
        ir <- allm[ (mass-(error*mass/1e6)) < allm[,1] & (mass+error*mass/1e6) > allm[,1] , 2 ]
      }
    else
      {
        ir <- allm[ (mass-error) < allm[,1] & (mass+error) > allm[,1] , 2 ]
      }
    if(full)
      if(length(ir)<n)
        ir <- c(ir,rep(0,n-min(n,length(ir))))
    if(center)
      {
        int <- int-mean(ir)
      }
    if(scale)
      {
        if(length(ir)>1) 
          int <- int/sqrt(var(ir))
        else
          int <- 1
      }
    return(int)
  }

setMethod("mvscale",signature(object="Massvector")
          ,function (object
                     ,allm
                     ,n
                     ,center = FALSE
                     ,scale = TRUE
                     ,error = 200
                     ,ppm = TRUE
                     ,full = TRUE
                     )
          {
            if(length(object)>0)
              {
                tmp <- cbind(object[,1],apply(object,1,mvscaletmp,allm,n,error=error,ppm=ppm,scale=scale,center=center,full=full))
                #print(object@info)
                colnames(tmp)<-colnames(object)
                as(object,"matrix")<-tmp
              }
            return(object)
          }
          )



setMethod("show"
          ,"Massvectorlist"
          ,def=function(object)
          {
            cat("info    : ",object@info,"\n")
            cat("project : ",object@project,"\n")
            cat("length  : ",length(as(object,"list")),"\n")
          }
          )


#########################################################################
### SIMILARITY MEASURES
##########################################################################

##===================================================================================================
## Euklid distance and manhattan distance
##===================================================================================================

if(!isGeneric("fdist"))
  setGeneric("fdist"
             ,function(obx,oby,...)
             standardGeneric("fdist")
             )
##+ norm : how to normalize the massvector (by mean? by max? or not)
##+ dist : which distance to use , euclidean? manhattan?
#norm can be a function like mean, min, max, var

setMethod("fdist"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,weight=FALSE
                    ,full=TRUE
                    ,method="euclidean"
                    ,scale = "no"
                    ,uniq = TRUE
                    ,theta = 1
                    ,N=0
                    ,range = 0 # range adjustment, specify minimal overlapping range.
                    )
          {
            #compute subsets within the same range.
            if(as.logical(range))
              {
                mmax <- min(max(obx[,1]),max(oby[,1]))
                mmin <- max(min(obx[,1]),max(oby[,1]))
                if((mmax-mmin)>range)
                  {
                    as(obx,"matrix") <- obx[obx[,1]>mmin  & obx[,1]<mmax,]
                    as(oby,"matrix") <- oby[oby[,1]>mmin & oby[,1]<mmax,]
                  }
              }
            tmp <- .Call("distMVSEXP"
                         ,obx
                         ,oby
                         ,error
                         ,ppm
                         ,weight
                         ,full
                         ,method
                         ,scale
                         ,uniq
                         ,theta
                         ,N
                         ,PACKAGE="msbase"
                         )
            return(tmp)
          }
          )

setMethod("fdist"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error = 200
                    ,ppm = TRUE
                    ,weight = FALSE
                    ,full = TRUE
                    ,method = "euclidean"
                    ,scale = "no"
                    ,uniq = TRUE
                    ,theta = 1
                    ,N=0
                    ,range = 0
                    )
          {
            res <- unlist(lapply(obx,fdist,oby
                                 ,error=error
                                 ,ppm=ppm
                                 ,weight=weight
                                 ,full=full
                                 ,method=method
                                 ,scale=scale
                                 ,uniq=uniq
                                 ,theta=theta
                                 ,N=N
                                 ,range=range # adjust the ranges of the peaklists
                                 )
                          )
            return(res)
          }
          )


setMethod("fdist"
          ,signature(obx="Massvectorlist",oby="NULL")
          ,function(obx
                    ,oby
                    ,error = 200
                    ,ppm = TRUE
                    ,weight = FALSE
                    ,full = TRUE
                    ,method = "euclidean"
                    ,scale = "no"
                    ,diag = FALSE
                    ,uniq=TRUE
                    ,theta=1
                    ,N=0
                    ,range=0 # adjust the ranges of the peaklists 
                    )
          {
            res<-listdist(obx
                          ,fdist
                          ,diag=diag
                          ,error=error
                          ,ppm=ppm
                          ,weight=weight
                          ,full=full
                          ,method=method
                          ,scale=scale
                          ,uniq=uniq
                          ,theta=theta
                          ,N=N
                          ,range=range
                          )
            if(!full)
              {
                res[res==Inf]<-max(res[res!=Inf])
              }
            if(sum(is.na(res))>0)
              {
                print(paste("#NA = "
                           ,sum(is.na(res))
                           ,"; found in function fdist\n"
                           ,"call :",match.call(),"\n",sep=""))
                return(obx)
              }
            return(res)
          }
          )


##===================================================================================================
## nr matches
##===================================================================================================

if(!isGeneric("nrmatch"))
  setGeneric("nrmatch",
             function(obx,oby,...)
             standardGeneric("nrmatch"))


##e x<-1:10; y<-(1:20)+0.00001
##e nrmatch(x,y)

setMethod("nrmatch"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    )
          {
            return(.Call("nrmatchSEXP"
                         ,obx
                         ,oby
                         ,error=error
                         ,ppm=ppm
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )


setMethod("nrmatch"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    )
          {
            return(.Call("nrmatchSEXP"
                         ,obx[,1]
                         ,oby[,1]
                         ,error=error
                         ,ppm=ppm
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

setMethod("nrmatch"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    )
          {
            res <- sapply(obx,nrmatch,oby,error=error,ppm=ppm)
            return(res)
          }
          )


setMethod("nrmatch"
          ,signature(obx="Massvectorlist",oby="NULL")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    )
          {
            res<-listdist(obx
                          ,nrmatch
                          ,diag=FALSE
                          ,error=error
                          ,ppm=ppm
                          )
                                        #   res<-as.matrix(res)
            if(sum(is.na(res))>0)
              {

                print(paste("#NA = "
                           ,sum(is.na(res))
                           ,"; found in function nrmatch\n"
                           ,"call :",match.call(),"\n",sep=""))
                return(obx)
              }
            return(res)
          }
          )

###########################################################################
##Counts not only the number of matches but also the distance of the peaks.
############################################################################

#####################################################=====================
#similarity for calibration - returns the range of matching scores
#=========================================================================

if (!isGeneric("cals"))
  setGeneric("cals",
             function(obx,oby,...)
             standardGeneric("cals"))


#its not optimal because many close pairs may give a high similarity.
calssim <- function(x,p)
  {
    cals <- 0
    x.length <- length(x)
    if(x.length < 2)
      return(0)
    res <- 0
    x <- x/10
    for(i in 1:(x.length))
      {
        res <- res + sum(abs(diff(x,lag=i))^p)
      }
    return( 10*(res)^(1/p) )
  }


# normalized version.
#calsdistN <- function(x,lshort,rangebig)
#  {
#     cals <- 0
#    x.length <- length(x)
#    if(x.length<2)
#      return(0)
#    res <- 0
#    for(i in 1:(x.length-1))
#      {
#        res <- res + sum(diff(x,lag=i))
#      }
#    res
#  }

#a different
calsrange <- function(x,p)
  {
    res<-range(x)
    res<-diff(res)
    res
  }

setMethod("cals"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,msim=calssim #distance function
                    ,p=p
                    ,uniq=TRUE
                    )
          {
            tt <- .Call("matindSEXP"
                         ,obx
                         ,oby
                         ,error=error
                         ,ppm=ppm
                         ,uniq=uniq
                         ,PACKAGE="msbase"
                         )
            if(length(tt$plind)==0)
              {
                cals <- 0 
              }
            else
              {
                cals <- msim(sort(obx[tt$plind]),p=p)
              }
            cals
          }
          )

setMethod("cals"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,msim=calssim #distance function
                    ,p=2
                    ,uniq=TRUE
                    )
          {
            tt<-.Call("matindSEXP"
                      ,obx[,1]
                      ,oby[,1]
                      ,error=error
                      ,ppm=ppm
                      ,uniq=uniq
                      ,PACKAGE="msbase"
                      )
            if(length(tt$plind)==0)
              {
                cals <- 0 
              }
            else
              {
                #maybee you should think about
                #changing the distance taking the number of pairs into account.
                cals <- msim(obx[tt$plind,1,drop=TRUE],p=p)
              }
            cals
          }
          )


setMethod("cals"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm = TRUE
                    ,msim=calssim # distance function
                    ,p=2
                    ,uniq=TRUE
                    )
          {
            res <- sapply(obx,cals,oby,error=error,ppm=ppm,msim=msim,p=p,uniq=uniq)
            return(res)
          }
          )

setMethod("cals"
          ,signature(obx="Massvectorlist",oby="NULL")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,msim=calssim
                    ,p=2
                    ,uniq=TRUE
                    )
          {
            res<-listdist(obx
                          ,cals
                          ,diag=FALSE
                          ,error=error
                          ,ppm=ppm
                          ,msim=msim
                          ,uniq=uniq
                          ,p=p
                          )
            if(sum(is.na(res))>0)
              {
                print(paste("#NA = "
                           ,sum(is.na(res))
                           ,"; found in function cals\n"
                           ,"call :",match.call(),"\n",sep=""))
                return(obx)
              }
            print("test")
            res <- max(res)-res #cast it into distance.
            return(res) 
          }
          )

##===================================================================================================
##Fowlkes Mallows statistik
##===================================================================================================

if (!isGeneric("fbinary"))
    setGeneric("fbinary",
               function(obx,oby,...)
               standardGeneric("fbinary"))

setMethod("fbinary"
          ,signature(obx="numeric",oby="numeric")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,theta=1
                    ,weight=FALSE
                    ,uniq=TRUE
                    ,method="rmi" #hg,fm
                    ,N=0 #total length of vector.
                    ,range=0 # adjust the range of the peaklists.
                    )
          {
                                        #compute subsets within the same range.
            if(as.logical(range))
              {
                mmax <- min(max(obx),max(oby))
                mmin <- max(min(obx),max(oby))
                if((mmax-mmin)>0)
                  {
                    obx <- obx[obx > mmin  & obx < mmax,]
                    oby <- oby[oby > mmin & oby < mmax,]
                  }
              }
            return(.Call("binaryMVSEXP"
                         ,obx
                         ,oby
                         ,error
                         ,ppm
                         ,theta
                         ,weight
                         ,uniq
                         ,method
                         ,N
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

setMethod("fbinary"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,theta=1
                    ,weight=FALSE
                    ,uniq=TRUE
                    ,method="rmi"
                    ,N=0 #total length of vector
                    ,range=0
                    )
          {
            if(as.logical(range))
              {
                mmax <- min(max(obx[,1]),max(oby[,1]))
                mmin <- max(min(obx[,1]),max(oby[,1]))
                if((mmax-mmin)>range)
                  {
                    as(obx,"matrix") <- obx[obx[,1]>mmin  & obx[,1]<mmax,]
                    as(oby,"matrix") <- oby[oby[,1]>mmin & oby[,1]<mmax,]
                  }
              }
            return(.Call("binaryMVSEXP"
                         ,obx[,1]
                         ,oby[,1]
                         ,error
                         ,ppm
                         ,theta
                         ,weight
                         ,uniq
                         ,method
                         ,N
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

setMethod(
          "fbinary"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm = TRUE
                    ,theta=1
                    ,weight = FALSE
                    ,uniq=TRUE
                    ,method="rmi"
                    ,N=0
                    ,range=0
                    )
          {
            res <- sapply(obx
                          ,fbinary
                          ,oby
                          ,error=error
                          ,ppm=ppm
                          ,theta=theta
                          ,weight=weight
                          ,uniq=uniq
                          ,method=method
                          ,N=N
                          ,range=range
                          )
            return(res)
          }
          )

setMethod("fbinary"
          ,signature(obx="list",oby="NULL")
          ,function(obx
                    ,oby
                    ,error = 200
                    ,ppm = TRUE
                    ,theta = 1
                    ,weight = FALSE
                    ,uniq=TRUE
                    ,method = "rmi"
                    ,diag=FALSE
                    ,N=0
                    ,range=0
                    )
          {
            res<-listdist(obx
                          ,fbinary
                          ,diag = diag
                          ,error = error
                          ,ppm   = ppm
                          ,theta = theta
                          ,weight= weight
                          ,uniq  = uniq
                          ,method=method
                          ,N=N
                          ,range=range
                          )
            res[1:length(res)] <- 1-as.numeric(res) #cast it into distance.
            if(sum(is.na(res))>0)
              {

                print(paste("#NA = "
                           ,sum(is.na(res))
                           ,"; found in function fbinary\n"
                           ,"call :",match.call(),"\n",sep=""))
                return(obx)
              }
            return(res)
          }
          )


setMethod("fbinary"
          ,signature(obx="Massvectorlist",oby="NULL")
          ,function(obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,theta=1
                    ,weight=FALSE
                    ,uniq=TRUE
                    ,method="rmi"
                    ,diag=FALSE
                    ,N=0
                    ,range=0
                    )
          {
            res<-listdist(obx
                          ,fbinary
                          ,diag=diag
                          ,error=error
                          ,ppm=ppm
                          ,theta=theta
                          ,weight=weight
                          ,uniq=uniq
                          ,method=method
                          ,N=N
                          ,range=range
                          )
            res[1:length(res)] <- (1 - as.numeric(res)) #cast it into distance.
            if(sum(is.na(res))>0)
              {
                print(paste("#NA = "
                           ,sum(is.na(res))
                           ,"; found in function fbinary\n"
                           ,"call :",match.call(),"\n",sep=""))
                return(obx)
              }
            return(res)
          }
          )



##===================================================================================================
## computes assymetric binary measures (jacard) from marginals.
##===================================================================================================

if (!isGeneric("assym"))
    setGeneric("assym",
               function(object,...)
               standardGeneric("assym"))

setMethod("assym"
          ,signature(object="numeric")#,lpl="numeric",lcal="numeric",theta="numeric")
          ,function(object
                    ,lpl
                    ,lcal
                    ,theta=1)
          {
            return(.Call("assymSEXP"
                         ,object
                         ,lpl
                         ,lcal
                         ,theta=theta
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

#===================================================================================================
# computes relative mutual information from mv length 1, mv length 2 and number of matching peptides
#===================================================================================================

if (!isGeneric("rmi"))
    setGeneric("rmi",
               function(object,...)
               standardGeneric("rmi"))

setMethod("rmi"
          ,signature(object="numeric")
          ,function(object # number matches
                    ,lpl  #length v1
                    ,lcal #length v2
                    ,N=0 #length of vectors
                    )
          {
            return(.Call("rmiSEXP"
                         ,object
                         ,lpl
                         ,lcal
                         ,N
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

## fowlkes mallows from marginals.
if (!isGeneric("fm"))
  setGeneric("fm",
             function(object,...)
             standardGeneric("fm"))

##object - number matches
##lpl - peaklist length
##lcal - calibrant length
setMethod("fm"
          ,signature(object="numeric")
          ,function(object,
                    lpl,
                    lcal)
          {
            return(.Call("FMSEXP"
                         ,object
                         ,lpl
                         ,lcal
                         ,PACKAGE="msbase"
                         ))
          }
          )

if (!isGeneric("hg"))
  setGeneric("hg",
             function(object,...)
             standardGeneric("hg"))

##object - number matches
##lpl - peaklist length
##lcal - calibrant length
setMethod("hg"
          ,signature(object="numeric")
          ,function(
                    object
                    ,lpl
                    ,lcal
                    ,N
                    )
          {
            return(.Call("HGSEXP"
                         ,object
                         ,lpl
                         ,lcal
                         ,N
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

##===================================================================================================
## correlation
##===================================================================================================
if (!isGeneric("fcor"))
    setGeneric("fcor",
               function(obx,oby,...)
               standardGeneric("fcor"))

##method can be pearson or spearman
setMethod("fcor"
          ,signature(obx="Massvector",oby="Massvector")
          ,function(
                    obx
                    ,oby
                    ,error=200
                    ,ppm=TRUE
                    ,weight=FALSE
                    ,full=TRUE
                    ,method="dotprod"
                    ,scale="no"
                    ,uniq=TRUE  
                    ,theta=1
                    ,N=0
                    ,range=0
                    )
          {
            if(as.logical(range))
              {
                mmax <- min(max(obx[,1]),max(oby[,1]))
                mmin <- max(min(obx[,1]),max(oby[,1]))
                if((mmax-mmin)>range)
                  {
                    as(obx,"matrix") <- obx[obx[,1]>mmin  & obx[,1]<mmax,]
                    as(oby,"matrix") <- oby[oby[,1]>mmin & oby[,1]<mmax,]
                  }
              }
            return(.Call("corMVSEXP"
                         ,obx
                         ,oby
                         ,error
                         ,ppm
                         ,weight
                         ,full
                         ,method
                         ,scale
                         ,uniq
                         ,theta
                         ,N
                         ,PACKAGE="msbase"
                         )
                   )
          }
          )

setMethod("fcor"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx
                    ,oby
                    ,error = 200
                    ,ppm = TRUE
                    ,weight = FALSE
                    ,full = TRUE
                    ,method = "dotprod"
                    ,scale="no"
                    ,uniq = TRUE
                    ,theta=1
                    ,N=0
                    ,range=0
                    )
          {
            res <- sapply(obx,fcor,oby
                          ,error = error
                          ,ppm = ppm
                          ,weight = weight
                          ,full = full
                          ,method = method
                          ,scale=scale
                          ,uniq = uniq
                          ,theta=theta
                          ,N=N
                          ,range=range
                          )
            return(res)
          }
          )


setMethod("fcor"
          ,signature(obx="Massvectorlist",oby="NULL")
          ,function(obx
                    ,oby
                    ,error = 200
                    ,ppm = TRUE
                    ,weight = FALSE
                    ,full = TRUE
                    ,method = "dotprod"
                    ,scale = "no"
                    ,diag = FALSE
                    ,uniq=TRUE
                    ,theta=1
                    ,N=0
                    ,range=0 # adjust the ranges of the peaklists 
                    )
          {
            res<-listdist(obx
                          ,fcor
                          ,diag=diag
                          ,error=error
                          ,ppm=ppm
                          ,weight=weight
                          ,full=full
                          ,method=method
                          ,scale=scale
                          ,uniq=uniq
                          ,theta=theta
                          ,N=N
                          ,range=range
                          )
            res[1:length(res)] <- (max(1,max(res)) - as.numeric(res)) #cast it into distance.
            if(sum(is.na(res))>0)
              {

                print(paste("#NA = "
                           ,sum(is.na(res))
                           ,"; found in function fbinary\n"
                           ,"call :",match.call(),"\n",sep=""))
                return(obx)
              }
            return(res)
          }
          )

#================================================================
#returns a matrix of pairwise distances for a list of massvectors.
#================================================================

#if (!isGeneric("listdist"))
    setGeneric("listdist",
               function(object,...)
               standardGeneric("listdist"))

setMethod("listdist"
          ,signature(object="list")
          ,function(object,FUN,diag=FALSE,...)
          {
            lo<-length(object)
            if(length(object)==1)
              return(dist(1))
            res<-numeric(lo*(lo-1)/2)
            aa <- 1
            for(rr in 1:lo)
              {
                tt<-(rr+1)
                if(tt <= lo)
                  {
                    SL <- object[tt:lo] #sublist
                    ee <- (aa-1) + length(SL)
                    tmp <- object[[rr]]
                    res[aa:ee] <- sapply(SL,FUN,tmp,...)
                  }
                aa <- ee + 1
              }
            ans <- res
            attributes(ans) <- NULL
	    attr(ans,"Labels") <- names(object)
            attr(ans,"Size") <- length(object)
            attr(ans, "call") <- match.call()
            class(ans) <- "dist"
            attr(ans,"Diag") <- diag
            attr(ans,"Upper") <- FALSE
            return(ans)
          }
          )

#c.mdist <- function(x,...)
#  {
#    tmp <- c(list(x) , list(...) )
#    print(length(tmp))
#    get.bounds<-function(x)
#      {
#        return(c(attributes(x)$start,attributes(x)$end))
#      }
#    bounds <- do.call("rbind",lapply(tmp,get.bounds))
#    tmp <- tmp[order(bounds[,1])]
#    ans <- unlist(tmp)
#    attr( ans , "Labels") <- attr(x,"Labels") # use the labels of the first object.
#    attr( ans , "Size") <- attr(x,"Size")
#    attr( ans , "call") <- match.call()
#    attr(ans , "Diag") <- attr(x,"Diag")
#    attr(ans , "Upper") <- attr(x,"Upper")
#    class(ans) <- "dist"
#    ans
#  }

setAs("Massvectorlist","matrix"
      ,function(from)
      {
        tmp <- do.call("rbind",lapply(from, as ,"numeric"))
        invisible(tmp)
      }
      )

setAs("Massvectorlist","data.frame"
      ,function(from)
      {
        tmp <- lapply(from,as,"list")
        tmp <- do.call("rbind",lapply(tmp,as.data.frame))
        tmp
      }
      )
                                       
################################################
# gamasses
## private

if (!isGeneric("gamasses"))
    setGeneric("gamasses",
               function(object,...)
               standardGeneric("gamasses"))

dumm <- function(mass,samplesize,abund=20,accur=0.1,sd=2)
  {
    return(abund)
  }

##
##  Method from paper - automated method for improved protein identification
##  by peptide mass fingerprinting.
##  by Levander et.al.
##

flFilter <- function(mass,samplesize,abund=20,accur=1,sd=2)
{
  a <- 7.4998407
  b <- -0.0006757
  Nrpep <- 1430009
  mi <- exp(a) * exp(b*mass) * accur / Nrpep
  thre<-mi*samplesize + sd*sqrt(mi*(1-mi)*samplesize)
  thre[thre < abund] <- abund
  return(thre)
}

setMethod("gamasses"
          ,signature(object="Massvector")
          ,def = function(object,accur = 0.1,abund = 50,func=dumm,...)
          {
            #print(match.call())
            ##t Abundant masses
            ##- Determines abundant masses in a massvector.
            ##sa gamasses.massvectorlist
            ##+ object : massvector
            ##+ accur : measurment accuracy in m/z
            ##+ abund : how many times a mass have to occur in a mass bin to be considered as an abundant mass.
            ##+ ... : further parameters.
            ##v massvector : massvector with abundant masses.
            ##r Wolski
            dat <- object[,1]
            attributes(dat) <- NULL
            mhist <- list(NULL)
            mhist[[1]] <- hist(dat,breaks=seq(min(dat)-accur/2,max(dat)+1.5*accur,accur),plot=FALSE)#,main=main,xlab=xlab,xlim=xlim)
            mhist[[2]] <- hist(dat,breaks=seq(min(dat)-accur,max(dat)+accur,accur),plot=FALSE)
            wh1 <- which(mhist[[1]]$counts >= func(mhist[[1]]$mids,length(dat),abund=abund,accur=accur))
            wh2 <- which(mhist[[2]]$counts >= func(mhist[[1]]$mids,length(dat),abund=abund,accur=accur))
            if(length(wh1)==0 & length(wh2)==0)
              {
                res<-matrix(ncol=3)
                colnames(res)<-c("mass","number","wm")
                return(new("Massvector",info=paste(object@info,"abundant",sep="_"),res))
              }
                                        #    cat("wh1 : ", wh1 ," \nwh2 : ",wh2,"\n")
                                        #bestimme die maxima.
            z1<- rep(0,length(mhist[[1]]$mids))
            z2<- rep(0,length(mhist[[2]]$mids))
                                        #    cat("z1 " , z1 , " z2 " , z2 , "\n" )
                                        #bernehme nur die die hufig sind.
            z1[wh1]<- mhist[[1]]$counts[wh1]
            z2[wh2]<- mhist[[2]]$counts[wh2]
                                        #find the peaks.returns the indexes    
            p1 <- peaks(z1,max=TRUE)
            p2 <- peaks(z2,max=TRUE)
            names(p1)<-rep(1,length(p1))        #name the indexes
            names(p2)<-rep(2,length(p2))        #name the indexes
                                        #Determin which indexes are close to each other.
            p12 <- sort(c(p1,p2))
                                        #if difference between peaks are 0 or 1 than they are close to each other.
            dp <- diff(p12)
                                        #find the indexes of this cases
            ipl <- which(dp==1|dp==0)
            ipu <- ipl+1
                                        #now i have the indices of the peaks in array p12.
                                        #Array p12 by themselves gives me the indices of the peaks.
            p12close <- cbind(p12[ipl],p12[ipu])
            p12closeN <- cbind(as.numeric(names(p12)[ipl]),as.numeric(names(p12)[ipu]))
                                        #now in each row are the indices of the peaks that are close to each other.
                                        #using this indices i can retrieve the mids and the counts
                                        #for this bins out of the histogram and calculate a weighted
                                        #average.
            wm <- NULL
            if(length(p12close)>0)
              {
                for(x in 1:length(p12close[,1]))
                  {
                    w1 <- mhist[[ p12closeN[x,1] ]]$counts[p12close[x,1]]
                    m1 <- mhist[[ p12closeN[x,1] ]]$mids[p12close[x,1]]
                    w2 <- mhist[[ p12closeN[x,2] ]]$counts[p12close[x,2]]
                    m2 <- mhist[[ p12closeN[x,2] ]]$mids[p12close[x,2]]
                    wm <- c( wm , (w1*m1+w2*m2)/(w1+w2) )
                  }
              }
            if(length(c(ipl,ipu)>0))
              {
                uniquepeaks <- p12[-c(ipl,ipu)]
              }
            else
              {
                uniquepeaks <- p12
              }
            uN <- as.numeric(names(uniquepeaks))
            if(length(uniquepeaks)>0)
              {
                for(x in 1:length(uniquepeaks))
                  {
                    wm<-c(wm,mhist[[ uN[x] ]]$mids[uniquepeaks[x]]) 
                  }
              }
            rm(mhist)
            res <- NULL
            num<-NULL
                                        #calculating exact mass
            for(x in wm)
              {
                                        #print(x)
                res <- c(res, mean( dat[(x+accur*0.8) > dat & (x-accur*0.8) < dat ]))
                num<-c(num,length(dat[(x+accur*0.8) > dat & (x-accur*0.8) < dat ]))
              }
                                        #    print(paste(info(object),"abundant",sep="_"))
            res<-cbind(res,num,wm)
            colnames(res)<-c("mass","number","wm")
            return(new("Massvector",res,info=paste(object@info,"abundant",sep="_")))
          }
          )

setMethod("gamasses"
          ,signature(object="Massvectorlist")
          ,def=function(object,accur=0.1,abund=50,func=dumm,...)
          {
            tmp <- unlist(object)
            res <- gamasses(tmp,accur=accur,abund=abund,func=func,...)
            res
          }
          )

setMethod("fsetdiff"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,def=function(obx
             ,oby
             ,error=200
             ,ppm=TRUE
             ,uniq=FALSE)
          {
            if(length(oby)==0)
              return(obx)
            as(obx,"list")<-lapply(obx,fsetdiff,oby,error=error,ppm=ppm,uniq=uniq)
            obx
          })

setMethod("fintersect"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=TRUE)
          {
            as(obx,"list") <- lapply(obx,fintersect,oby,error=error,ppm=ppm,uniq=uniq)
            obx
          }
          )

setMethod("finterS"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,function(obx,oby,error=200,ppm=TRUE,uniq=FALSE)
          {
            as(obx,"list") <- lapply(obx,finterS,oby,error=error,ppm=ppm,uniq=uniq)
            obx
          }
          )

setMethod("writeMV"
          ,signature(object="Massvectorlist",path="character")
          ,def=function(object,path,file=object@info,...)
          {
            ##t Write massvectorlist
            ##- Write massvectorlist to File
            ##d The read and write functions for all the different peak-list formats are not provided by the package. This is because
            ##d there are oodles of different formats. I will try to collect read-write functions for as many as possible peak-list format's in an add on package
            ##d which you can find at \url{http://www.molgen.mpg.de/~wolski/mscalib/IO/}.
            ##+ object : massvectorlist.
            ##+ path : path to directory.
            ##+ file : file name. default experiment(object)
            ##sa readF.massvectorlist, readF.massvector
            filep <- file.path(path,file,fsep = .Platform$file.sep)
            con <- file(filep, "w")  # open an output file connection
            intern <-function(lobject,con)
              {
                firstline<-paste(">",lobject@info,":",paste(lobject@tcoor,collapse=","),sep="")
                writeLines(firstline,con=con)
                write.table(as(lobject,"matrix"),file = con, append = TRUE, quote = FALSE, sep = "\t",
                            eol = "\n", na = "NA", dec = ".", row.names = FALSE,
                            col.names = FALSE, qmethod = c("escape", "double"))
              }
            res<-lapply(object,intern,con)
            close(con)
          }
          )
## --------------------------------------------------------------------------
## msbase - R package for mass spectrometric peaklist manipulation
## --------------------------------------------------------------------------
##  Copyright (C) 2003 -- Witold E. Wolski
##
##  This library is free software; you can redistribute it and/or
##  modify it under the terms of the GNU Lesser General Public
##  License as published by the Free Software Foundation; either
##  version 2.1 of the License, or (at your option) any later version.
##
##  This library is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
##  Lesser General Public License for more details.
##
##  You should have received a copy of the GNU Lesser General Public
##  License along with this library; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
##
## --------------------------------------------------------------------------
## --------------------------------------------------------------------------
##

if(!isGeneric("readBruker"))
setGeneric("readBruker"
           ,function(object,...)
           standardGeneric("readBruker"))


setMethod("readBruker"
          ,signature(object="Massvectorlist")
          ,def=function(object
             ,folder
             ,expname
             ,project
             ,filename="peaklist.xml"
             ,
             ...)
          {
            ##t Read Bruker XML File
            ##- Read Bruker XML peaklist.xml file format.
            ##+ object : object of class massvectorlist
            ##+ folder : path to folder with Bruker file structure.
            ##+ expname : name of the experiment. If missing the name are extracted from the folder path.
            ##+ project : name of the project.
            ##+ filename : default = "peaklist.xml"
            ##+ ... : further parameters
            if(missing(expname))
              {
                expname <- strsplit(folder,"/")
                expname <- expname[[1]]
                expname <- expname[length(expname)]
                object@info <- expname
                object@experiment <- expname
              }else{
                object@info <- expname
                object@experiment <- expname
              }
            if(!missing(project))
              {
                object@project<-project
              }
            require(XML)
            name <- character(0)
            #stop()
            temp <- list.files(folder,pattern="peaklist.xml",recursive=TRUE)
            name <- file.path(folder,temp)
            res <- vector("list",length(name))
            for(x in 1:length(name))
              {
                res[[x]] <- readBruker(new("Massvector"),name[x])
                names(res)[x] <- res[[x]]@info
              }
            ##            cat("\nlength massvectorlist",length(object),"\n")
            res<<-res
            as(object,"list") <- res
            return(object)
          }
)

getcoorBruker <- function(infop)
  {
    ##t Coordinates on Sample support.
    ##- Gets the coordinates on sample support from the default infor parameter (e.g. \code{0_A1_1SRef}).
    ##+ infop : path to folder.
    X <- 1:16
    names(X) <- c("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P")
    nam<-infop
    nam <- sub("[0-9]_","",nam)
    nam <- sub("_1.+$","",nam)
    y <-as.numeric(sub("[A-Z]+","",nam))
    x <-sub("[0-9]+","",nam)
    tcoor <- c( X[ x ] , y )
    names(tcoor)<-c(x,y)
    tcoor
  }


setMethod("readBruker"
          ,signature(object="Massvector")
          ,def=function(object 
             ,filep #path to file 
             ,infop #infoparameter
             ,...)
          {
            ##t Read peaklist.xml
            ##- Read Bruker Daltonic peaklist.xml file format.
            ##+ object : object of class massvector.
            ##+ filep : path and filename of file to load.
            ##+ infop : info field. If missing the info field is extracted out of the file path.
            require(XML)
            mass <- NULL
            area <- NULL
            test<-function() { 
              massf<-function(x,attrs)
                {
                  mass <<- c(mass, xmlValue(x[[1]])); 
                  NULL
                }
              areaf<-function(x,attr)
                {
                  area<<-c(area,xmlValue(x[[1]]));
                  NULL
                }
              list(mass = massf,area=areaf)
            }
##################################################
            tt  <-  strsplit(filep,"/")[[1]]
            pkname <- tt [grep("[0-3]_[A-Z][1-9]+",tt)]
           
            if(file.exists(filep))
              {
                                        # retrieve the names of the file
                                        #cat("before the trap",fileName,"\n")
                xmlTreeParse(filep,handler=test())
                if(length( mass )!=0)
                  {
                    mass<-as.double(mass)
                    area<-as.double(area)
                    mass<-cbind(mass,area)
                    colnames(mass) <- c("mass","area")
                    or<-order(mass[,1])
                    mass[,1]<-mass[,1][or]
                    mass[,2]<-mass[,2][or]
                    rownames(mass)<-1:length(mass[,1])
                    as(object,"matrix") <- mass
                    if(!missing(infop))
                      {
                        print(infop)
                        object@info <-infop
                      }
                    else
                      {
                        object@info <- pkname
                      }
                    mcor <- getcoorBruker(pkname)
                    object@tcoor=mcor
                  }
                else
                  {
                    mcor <- getcoorBruker(pkname)
                    object@tcoor <- mcor
                    object@info <- pkname
                  }
                return(object)
              }
            else
              {
                warning(paste("file : ",filep,"not fount!\n" ))
                mcor <- getcoorBruker(pkname)
                object@tcoor <- mcor
                return(object@info <- pkname)
              }
          }
          )
## --------------------------------------------------------------------------
## msbase - R package for mass spectrometric peaklist manipulation
## --------------------------------------------------------------------------
##  Copyright (C) 2003 -- Witold E. Wolski
##
##  This library is free software; you can redistribute it and/or
##  modify it under the terms of the GNU Lesser General Public
##  License as published by the Free Software Foundation; either
##  version 2.1 of the License, or (at your option) any later version.
##
##  This library is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
##  Lesser General Public License for more details.
##
##  You should have received a copy of the GNU Lesser General Public
##  License along with this library; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
##
## --------------------------------------------------------------------------
## --------------------------------------------------------------------------
##

.First.lib <- function(lib, pkg) library.dynam("msbase",pkg,lib)
.Last.lib <- function(libpath) library.dynam.unload("msbase", libpath)

