.packageName <- "mscalib"
## --------------------------------------------------------------------------
## mscalib - R package for mass spectrometric peaklist calibration and filtering
## --------------------------------------------------------------------------
##  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
##
## --------------------------------------------------------------------------
## --------------------------------------------------------------------------
##
#extension to package spatial needed here.

library(methods)
library(msbase)
library(fields)
library(spatial)


setClass("Surf")
setOldClass("trls")
setOldClass("trgls")


predict.trgls <-function(object ,x ,y ,...)
{
  predval <- function(obj, xp, yp)
    {
        npt <- length(xp)
        .C("VR_krpred",
           z = double(npt),
           as.double(xp),
           as.double(yp),
           as.double(obj$x),
           as.double(obj$y),
           as.integer(npt),
           as.integer(length(obj$x)),
           as.double(obj$yy),
           PACKAGE = "spatial"
           )$z
    }
  if(!inherits(obj, "trgls")) stop("object not from kriging")
  .C("VR_frset",
     as.double(obj$rx[1]),
     as.double(obj$rx[2]),
     as.double(obj$ry[1]),
     as.double(obj$ry[2]),
     PACKAGE = "spatial"
     )
  alph <- obj$alph
  if(length(alph) <= 1) {
    mm <- 1.5*sqrt((obj$rx[2]-obj$rx[1])^2 + (obj$ry[2]-obj$ry[1])^2)
    alph <- c(alph[1], obj$covmod(seq(0, mm, alph[1])))
  }
  .C("VR_alset",
     as.double(alph),
     as.integer(length(alph)),
     PACKAGE = "spatial"
     )
  z <- spatial:::.trval(obj, x, y ) +
    predval(obj, x, y)
  invisible(z)
}



## residue of tow Massvectors
if(!isGeneric("residuals"))
  setGeneric("residuals",
             function(object,...)
             standardGeneric("residuals"))

setMethod("residuals"
          ,signature(object="Massvector")
          ,def=function(object
             ,oby
             ,error=250
             ,ppm=TRUE
             ,uniq=FALSE
             ,add=0
             ,...)
          {
            if( class(oby) != "Massvector")
              stop("second arg must be Massvector is :", class(oby),"\n")
            oby[,1]<-oby[,1] + add
            mmatch<-fmatch(object,oby,error=error,ppm=ppm,uniq=uniq)
            if(length(mmatch$plind) > 0)
              {
                ttmp <- object[mmatch$plind,1]-oby[mmatch$calind,1]
                res<-cbind((oby[mmatch$calind,1]+object[mmatch$plind,1])/2, ttmp)
                as(object,"matrix") <- res
                return(object)
              }
            else
              {
                return(object[NULL,])
              }
          }
          )

#computes the residuals for all elements in two lists.

setMethod("residuals"
          ,signature(object="Massvectorlist")
          ,def=function(object,oby,error=250,ppm=TRUE,uniq=FALSE,add=0,...)
          {
            if( class(oby) != "Massvectorlist")
              stop("second arg must be Massvectorlist is :", class(oby),"\n")
            res <- vector("list",length(object))
            count<-0
            for(i in 1:length(object))
              {
                tmp<-oby[[object[[i]]@info]]
                if(!is.null(tmp))
                  {
                    count<-count+1
                    tmp2<-residuals(object[[i]],tmp,error=error,ppm=ppm,uniq=uniq,add = add)
                    res[[count]]<-tmp2
                    names(res)[count]<-object[[i]]@info
                    print(count)
                  }
                else
                  {
                    print(object[[i]]@info)
                  }
              }
            as(object,"list") <- res[1:count]
            object@info <- paste(object@info,"resid",sep=".")
            object
          }
          )

setClass("Calibstat"
         ,representation(
                         info = "character"
                         ,tcoor = "numeric"
                         ,Coeff.Intercept = "numeric"
                         ,Coeff.Slope = "numeric"
                         ,lengthmv = "numeric"
                         ,quality = "numeric"
                         )
         ,prototype(
                    info=""
                    , tcoor=c(NaN,NaN)
                    , Coeff.Intercept=NaN
                    , Coeff.Slope = NaN
                    , lengthmv = NaN
                    , quality = NaN
                    )
         )

setMethod("show","Calibstat"
          ,def=function(object)
          {
             cat("info            :",object@info,"\n")
             cat("lengthmv        :",object@lengthmv,"\n")
             cat("Coeff.Intercept :",object@Coeff.Intercept,"\n")
             cat("Coeff.Slope     :",object@Coeff.Slope,"\n")
             cat("tcoor           :",object@tcoor,"\n")
             cat("quality         :",object@quality,"\n")
          }
          )

setAs("Calibstat","numeric"
      ,def=function(from)
      {
        tmp<-c(
               from@lengthmv
               ,from@Coeff.Intercept
               ,from@Coeff.Slope
               ,from@tcoor
               ,from@quality
               )
        
        names(tmp)<-c(
                      "lengthmv"
                      ,"Coeff.Intercept"
                      ,"Coeff.Slope"
                      ,"tcoorX"
                      ,"tcoorY"
                      ,names(from@quality)
                      )
        tmp
      }
      )

setAs("Calibstat","list"
      ,def=function(from)
      {
        tmp<-list(
                  ,info=from@info
                  ,lengthmv=from@lengthmv
                  ,Coeff.Intercept=from@Coeff.Intercept
                  ,Coeff.Slope=from@Coeff.Slope
                  ,Xtcoor=from@tcoor[1]
                  ,Ytcoor=from@tcoor[2]
                  )
        tmp
      }
      )

setAs("Calibstat","data.frame"
      ,def=function(from)
      {
        data.frame(as(from,"list"))
      }
      )

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


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

setMethod("summary"
          ,signature(object="Calibstat")
          ,function(object,...)
          {
            ##t Calibstat summary
            ##- Generates Summary.
            ##+ object : object of class calibstat.
            ##e data(mv1)
            ##e data(cal)
            ##e test<-getintcalib(mv1,cal)
            ##e summary(test)
            cat("info :", object@info ,"\n")
            tmp<-as(object,"vector")
            print(t(t(tmp)))
            invisible(c(object@info,tmp))
          }
          )
 

setClass("Caliblist"
         ,representation(
                         info="character"
                         ,experiment="character"
                         ,project="character"
                         )
         ,contains="Mlist"
         )


setMethod("show",signature(object="Caliblist")
          ,function(object)
          {
            cat("Class  :", class(object) ,"\n")
            cat("Experiment :", object@experiment ,"\n")
            cat("Project    :", object@project ,"\n")
            cat("Calibstat List lenght : ",length(object) ,"\n")
            if(length(object) > 0)
              {
                cmv <- object@.Data[[1]]
                cat("Class Calibstat object: ", class(cmv) ,"\n")
                cat("Fields in Calibstat objects: \n")
                cat(paste(paste("\t",slotNames(cmv)),collapse="\n"))
                cat("\n")
                rm(cmv)
              }
            else
              {
                cmv <- NULL
                allow <- NULL
              }
          }
          )

setReplaceMethod("[[", "Caliblist"
                 , function(x, i, j,..., value)
                 {
                   if( !extends(class(value),ifelse(length(x)>0,class(x[[1]]),"Calibstat") ))
                     {
                       stop(paste("This is an:"
                                  ,ifelse(length(x)>0,class(x[[1]]),"Calibstat")
                                  ,"so dont try to assing a object of class:"
                                  ,class(value)
                                  ,"\n"
                                  ,sep=" ")
                            )
                     }
                   as(x,"list")[[i]]<-value
                   names(x)[i]<-value@info
                   x
                 })
setMethod("[",
          "Caliblist",
          def = function(x, i, j, ..., drop = F)
          {
            y<-as(x,"list")
            names(y)<-names(x)#do not know if because of bug
            as(x,"list")=y[i]
            return(x)
          }
          )

setAs("Caliblist","matrix"
      ,function(from)
      {
        tmp<-do.call("rbind",lapply(from,as,"numeric"))
        colnames(tmp)<- names(as(from[[1]],"numeric"))
        rownames(tmp)<- names(from)
        tmp
      })

setAs("Caliblist","data.frame"
      ,function(from)
      {
        tmp <- do.call("rbind",lapply(from,as,"data.frame"))
      }
      )

setMethod("summary"
          ,signature(object="Caliblist")
          ,function(object,...)
          {
            cat("experiment : ", object@experiment,"\n")
            cat("project    : ", object@project,"\n")
            tmp <- as(object,"matrix")
            print(summary(tmp))
          }
          )

getXY <- function(x,what="")
  {
    if(length(x)==0)
      {
        warning("List has length 0")
        return()
      }
    res <- as(x , "matrix")
    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)
    X <- cbind(nam$coorX,nam$coorY)
    Y <- res[z,what]
    return(list(X=X,Y=Y))
  }

setClassUnion("mtrls",c("trls","trgls"))

setClass("CSsurf",contains="Surf"
         ,representation(
                         slope="mtrls"
                         ,intercept="mtrls"
                         ,caliblist="character" # type of calibration list
                         ,ppm="logical" #need to be stored if Calibintlist
                         )
         )

setMethod("image",signature(x="CSsurf")
          ,def=function(x,...)
          {
            mfrowtmp <- par()$mfrow
            par(mfrow=c(1,2))
            xx <- range(x@slope$x)+c(-1,1)
            yy <- range(x@slope$y) + c(-1,1)
            if(class(x@slope)[1]=="trgls")
              {
                trsurf <- prmat(x@slope, xx[1], xx[2], yy[1], yy[2], 50)
              }
            else
              {
                trsurf <- trmat(x@slope, xx[1], xx[2], yy[1], yy[2], 50)
              }
            image(trsurf,col=topo.colors(100))
            contour(trsurf, add = TRUE)
            xx <- range(x@intercept$x)+c(-1,1)
            yy <- range(x@intercept$y) + c(-1,1)
            if(class(x@slope)[1]=="trgls")
              {
                trsurf <- prmat(x@intercept, xx[1], xx[2], yy[1], yy[2], 50)
              }
            else
              {
                trsurf <- trmat(x@intercept, xx[1], xx[2], yy[1], yy[2], 50)
              }
            image(trsurf,col=topo.colors(100))
            contour(trsurf, add = TRUE)
            par(mfrow=mfrowtmp)
          }
          )

setMethod("plot",signature(x="CSsurf",y="missing")
          ,def=function(x,...)
          {
            tmpfrow <- par()$mfrow
            par(mfrow=c(2,2))
            dz <- predict(x@slope,x@slope$x,x@slope$y)
            plot(dz,dz-x@slope$z,xlab="predicted values",ylab="residuals")
            abline(h=0,col="gray")
            hist(dz-x@slope$z,xlab="residuals",main="")
            dd <- dz-x@slope$z
            abline(v=c(mean(dd),sd(dd),-sd(dd),2*sd(dd),-2*sd(dd)),col=c(3,2,2,2,2),lty=c(1,2,2,3,3))
            dz <- predict(x@intercept,x@intercept$x,x@intercept$y)
            plot(dz,dz-x@intercept$z,xlab="predicted values",ylab="residuals")
            abline(h=0,col="grey")
            hist(dz-x@intercept$z,xlab="residuals",main="")
            dd <- dz-x@intercept$z
            abline(v=c(mean(dd),sd(dd),-sd(dd),2*sd(dd),-2*sd(dd)),col=c(3,2,2,2,2),lty=c(1,2,2,3,3))
            par(mfrow=tmpfrow)
          }
          )

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


setMethod("CSsurf.gls",signature(object="Caliblist")
          ,def=function(object
             ,np=2
             ,covmod=expcov #see surf.gls
             ,d=1
             , ... )
          {
            print("test")
            require(spatial)
            tt <- as(object,"data.frame")
            fit<-new("CSsurf")
            fit@caliblist <-class(object)
            if(class(object)[1]=="Calibintlist")
              {
                fit@ppm=object@ppm
              }
            ttt <- tt[,c("Xtcoor","Ytcoor","Coeff.Intercept")]
            colnames(ttt)<-c("x","y","z")
            ttt<-na.omit(ttt)
            #ttt<<-ttt
            tmp <- surf.gls(np=np,covmod=covmod,ttt,d=d)
            print("test")
            fit@intercept <- tmp
            ttt <- tt[,c("Xtcoor","Ytcoor","Coeff.Slope")]
            colnames(ttt)<-c("x","y","z")
            tmp <- surf.gls(np=np,covmod=covmod,ttt,d=d)
            print("test2")
            fit@slope <- tmp
            return(fit)
          }
          )

setGeneric("CSsurf.ls"
           ,function(object,...)
           standardGeneric("CSsurf.ls")
           )

setMethod("CSsurf.ls",signature(object="Caliblist")
          ,def=function(object
             ,np=2
             , ... )
          {
            require(spatial)
            tt <- as(object,"data.frame")
            fit<-new("CSsurf")
            fit@caliblist <-class(object)
            if(class(object)[1]=="Calibintlist")
              {
                fit@ppm=object@ppm
              }
            tt<-na.omit(tt)
            ttt <- tt[,c("Xtcoor","Ytcoor","Coeff.Intercept")]
            colnames(ttt)<-c("x","y","z")
            tmp <- surf.ls(np=np,ttt,...)
            slot(fit,"intercept") <- tmp
            ttt <- tt[,c("Xtcoor","Ytcoor","Coeff.Slope")]
            colnames(ttt)<-c("x","y","z")
            tmp <- surf.ls(np=np,ttt,...)
            fit@slope <- tmp
            fit
          }
          )

setOldClass("Krig")
setClassUnion("NULLKrig",c("NULL","Krig"))
setClass("CSKrig",contains="Surf"
         ,representation(
                         slope="NULLKrig"
                         ,intercept="NULLKrig"
                         ,caliblist="character" # type of calibration list
                         ,ppm="logical" #need to be stored if Calibintlist
                         )
         )

setMethod("plot",signature(x="CSKrig",y="missing")
          ,def=function(x,...)
          {
            tmpfrow <- par()$mfrow
            par(mfrow=c(2,3))
            plot(x@slope$fitted.values,x@slope$yM,xlab="fitted values",ylab="orginal",main="")
            plot(x@slope$yM,x@slope$residuals,xlab="values",ylab="residuals",main="slope")
            abline(h=0,col="grey")
            hist(x@slope$residuals,xlab="residuals",main="")
            dd<-x@slope$residuals
            abline(v=c(mean(dd),sd(dd),-sd(dd),2*sd(dd),-2*sd(dd)),col=c(3,2,2,2,2),lty=c(1,2,2,3,3))
            plot(x@intercept$fitted.values,x@intercept$yM,xlab="fitted values",ylab="orginal",main="slope")
            plot(x@intercept$yM,x@intercept$residuals,xlab="predicted values",ylab="residuals")
            abline(h=0,col="grey")
            hist(x@intercept$residuals,xlab="residuals",main="")
            dd <- x@intercept$residuals
            abline(v=c(mean(dd),sd(dd),-sd(dd),2*sd(dd),-2*sd(dd)),col=c(3,2,2,2,2),lty=c(1,2,2,3,3))
            par(mfrow=tmpfrow)
          }
          )

setMethod("image",signature(x="CSKrig")
          ,def=function(x,...)
          {
            mfrowtmp<-par()$mfrow
            par(mfrow=c(1,2))
            out.p <- predict.surface(x@slope)
            image(out.p,main="slope",col=terrain.colors(100))
            contour(out.p, add = TRUE)
            out.p2 <- predict.surface(x@intercept)
            image(out.p2,main="intercept",col=terrain.colors(100))
            contour(out.p2, add = TRUE)
            par(mfrow=mfrowtmp)
          }
          )

if(!isGeneric("CSTps")) #Returns a thin surface spline.
  setGeneric("CSTps"
             ,function(object,...)
             standardGeneric("CSTps")
             )

setMethod("CSTps",signature(object="Caliblist")
          ,def=function(object
             ,... #other parameters which can be passed to the function Tps.
             )
          {
            tt <- as(object,"data.frame")
            #tt <- na.omit(tt)
            fit <- new("CSKrig")
            fit@caliblist <- class(object)
            
            if(class(object)[1]=="Calibintlist")
              {
                fit@ppm=object@ppm
              }
            
            tt <- na.omit(tt)
            tmp <- Tps(tt[,c("Xtcoor","Ytcoor")] , tt[,"Coeff.Intercept"],...)
            fit@intercept <- tmp
            ix <- attr(tt, "na.action")
            if(length(ix)>0)
              {
                res <- fit@intercept$residuals
                newres <- c(res,rep(NaN,length(ix))) # just to get size and mode right
                newres[ix] <- NaN
                newres[-ix] <- res
                fit@intercept$residuals <-newres
              }

            
            tmp <- Tps(tt[,c("Xtcoor","Ytcoor")] , tt[,"Coeff.Slope"],...)
            fit@slope <- tmp
            

            ix <- attr(tt, "na.action")
            if(length(ix)>0)
              {
                res <- fit@slope$residuals
                newres <- c(res,rep(NaN,length(ix))) # just to get size and mode right
                newres[ix] <- NaN
                newres[-ix] <- res
                fit@slope$residuals <- newres
              }
            fit
          }
          )

refinecalibTps <- function(object
                           , sdS = 0.0005
                           , sdI = 0.3
                           , full = FALSE
                           , lambda = 0.05
                           , lambdaF = 0.001
                           , zero = TRUE
                           )
  {
    obx <- CSTps(object,lambda=lambda)
    print("test")
    resS <- obx@slope$residuals
    resS <- which((-sdS > resS )  | (resS > sdS))
    resI <- obx@intercept$residuals
    resI <- which((-sdI > resI )  | (resI > sdI))

    dd <- union(resS,resI)
    cat("removed   ",length(dd),"\n")
    object2 <- object[-dd]
    cat("remaining ",length(object2),"\n")
    obx <- CSTps(object2,lambda=lambdaF)
    print("test2")
    intercept<-as(object2,"matrix")[,"Coeff.Intercept"]
    
    c0 <- mean(intercept,trim=0.05,na.rm=TRUE)
    tmpobj <- as(object,"list")
    if(!full)
      {
        for(i in 1:length(object))
          {
            if(!zero)
              {
                c0 <- predict(obx@intercept,matrix(object[[i]]@tcoor,ncol=2))
              }
            
            if(is.na(tmpobj[[i]]@Coeff.Intercept))
              {
                tmpobj[[i]]@Coeff.Intercept <- c0 # c0
              }
            else if(abs(c0 - tmpobj[[i]]@Coeff.Intercept) > sdI)
              {
                tmpobj[[i]]@Coeff.Intercept <- c0# c0
              }
            c1 <- predict(obx@slope,matrix(object[[i]]@tcoor,ncol=2))
            if(is.na(tmpobj[[i]]@Coeff.Slope))
              {
                tmpobj[[i]]@Coeff.Slope<-c1
              }
            else if(abs(c1 - tmpobj[[i]]@Coeff.Slope) > sdS)
              {
                tmpobj[[i]]@Coeff.Slope <- c1
                #print(tmpobj[[i]]@info)
              }
          }
      }
    else
      {
        for(i in 1:length(object))
          {
            tmpobj[[i]]@Coeff.Slope <- predict(obx@slope,matrix(object[[i]]@tcoor,ncol=2))
            tmpobj[[i]]@Coeff.Intercept <- c0 # predict(obx@intercept,matrix(object[[i]]@tcoor,ncol=2))
          }
      }
    as(object,"list")<-tmpobj
    object
  }



applycalibCS <-function( obx # object of class Krig
                        , oby # object of class Massvector
                        , calibstat # object of class Caliblist
                        , intvar=Inf
                        , slopvar=Inf
                        , ppmoff = TRUE #its set always to use intercept and slope. if FALSE it uses either intercept or slope depending if relative or absolute error was used.
                        , fix = FALSE # if true set the high variance coefficient to 0
                        , one = FALSE # if one FALSE check for both correcte intercept and slope; if true for one of them.
                        
                        , ...)
  {
    if(class(obx)[1]=="CSsurf")
      {
        Coeff.Slope <- predict(obx@slope,x=oby@tcoor[1] , y=oby@tcoor[2]) #all functions which implement predict.
        Coeff.Intercept <- predict(obx@intercept,x=oby@tcoor[1] , y=oby@tcoor[2])
      }
    else if(class(obx)[1]=="CSKrig")
      {
        Coeff.Slope <- predict(obx@slope,matrix(oby@tcoor,nrow=1)) #all functions which implement predict.
        Coeff.Intercept <- predict(obx@intercept, matrix(oby@tcoor,nrow=1))
      }
                                        # ) 
    ## in case of abs error the observed intercept seems to be purely random
    ## in case of ppm the slope seems to be purely random.
    ## therefore we will use the exact values.
    if(!missing(calibstat))
      {
        tt <- calibstat[[oby@info]]
        if(!is.null(tt))
          {
            tmpI <- abs(Coeff.Intercept - tt@Coeff.Intercept)
            tmpS <- abs(Coeff.Slope-tt@Coeff.Slope)
            if(!calibstat@ppm || ppmoff ) #on TRUE switches of conditioning on PPM.
              {
                if( tmpI <= intvar & (tmpS <= slopvar | one ))
                  {
                    Coeff.Intercept <-  tt@Coeff.Intercept
                  }
              }
            if(calibstat@ppm || ppmoff ) #apply calibration only if it is reasonable.
              {
                
                if( tmpS <= slopvar &  (tmpI <= intvar | one ))
                  {
                    Coeff.Slope <- tt@Coeff.Slope
                  }
              }
          }
      }
    #do this to override the more random component.
    if(fix)
      {
        if(obx@ppm)
          {
            Coeff.Slope <- 0
          }
        else
          {
            Coeff.Intercept <- 0
          }
      }
    if(obx@caliblist == "Calibintlist")
      {
        err <- Coeff.Intercept + Coeff.Slope * oby[,1,drop=TRUE]
        if(obx@ppm)
          {
            oby[,1] <- oby[,1]/(1 - (err * 1e-6))
          }
        else
          {
            oby[,1] <- oby[,1] + err
          }
      }
    else if(obx@caliblist == "Calibprelist")
      {
        oby[,1] <- ( oby[,1] - Coeff.Intercept ) * ( Coeff.Slope + 1 )
      }
    oby
  }



setMethod("applycalib"
          ,signature( obx = "Surf" , oby = "Massvector" )
          ,def =applycalibCS
          )

setMethod("applycalib"
          ,signature(obx = "Massvector", oby="Surf")
          ,def=function(obx,oby,caliblist,intvar=Inf,slopvar=Inf,ppmoff=TRUE,one=FALSE,...)
          {
            applycalibCS(oby,obx,caliblist,intvar=intvar,slopvar=slopvar,ppmoff=ppmoff,one=one,...)
          }
          )

setMethod("applycalib"
          ,signature(obx="Surf",oby="Massvectorlist")
          ,def=function(obx , oby , caliblist ,intvar=Inf,slopvar=Inf,ppmoff=TRUE,one=FALSE,...)
          {
            if(!missing(caliblist))
              {
                as(oby,"list") <- lapply(oby,applycalib,obx,caliblist,slopvar=slopvar,intvar=intvar,ppmoff=ppmoff,one=one,...)
              }
            else
              {
                as(oby,"list") <- lapply( oby , applycalib , obx,slopvar=slopvar,intvar=intvar,ppmon=ppmon,one=one,...)
              }
            oby
          }
          )

setMethod("applycalib"      
          ,signature(obx = "Massvectorlist" , oby = "Surf")
          ,def = function(obx,oby, caliblist ,intvar=Inf,slopvar=Inf,ppmoff=TRUE,one=FALSE, ... )
          {
            if(!missing(caliblist))
              {
                as(obx,"list") <- lapply(obx , applycalib , oby , caliblist,intvar=intvar,slopvar=slopvar,ppmoff=ppmoff,one=one,...)
              }
            else
              as(obx,"list") <- lapply(obx , applycalib , oby,intvar=intvar,slopvar=slopvar,ppmoff=ppmoff,one=one,... )
            obx
          }
          )

#setMethod("predict"
#          ,signature(object="Calibstat")
#          ,function(object,...)
#          {
#            XY <- getXY(object)
#          }
#          )

## --------------------------------------------------------------------------
## mscalib - R package for mass spectrometric peaklist calibration and filtering
## --------------------------------------------------------------------------
##  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)
library(msbase)
library(MASS)
library(fields)

setOldClass("lm")
setClassUnion("lmNULL",c("NULL","lm"))

setClass("Calibintstat"
         ,representation(
                         nrmatch="numeric"
                         ,ppm="logical"
                         ,error="numeric"
                         ,lmmod="lmNULL"
                         )
         ,contains="Calibstat"
         ,prototype(
                    info=""
                    ,tcoor=c(tcoorX=NaN,tcoorY=NaN)
                    ,Coeff.Intercept=NaN
                    ,Coeff.Slope=NaN
                    ,quality=c(Fint=NaN,Fab=NaN)
                    ,lengthmv=NaN
                    ,nrmatch=NaN
                    ,ppm=TRUE
                    ,error=NaN
                    ,lmmod=NULL
                    )
         )

setMethod(
          "show","Calibintstat"
          ,def=function(object)
          {
            show(as(object,"Calibstat"))
            cat("nrmatch         :",object@nrmatch,"\n")
            cat("ppm             :",object@ppm,"\n")
            cat("errorwindow     :",object@error,"\n")
            cat("Fint            :",object@quality[1],"\n")
            cat("Fab             :",object@quality[2],"\n")
          }
          )

setMethod("plot"
          ,signature(x="Calibintstat",y="missing")
          ,def=function(x,y,...)
          {
            tmp<-x
            ylab <- ifelse(tmp@ppm,"error ppm","error abs")
            curve(tmp@Coeff.Intercept + tmp@Coeff.Slope *x ,xlim=c(800,4000),xlab="m/z",ylab=ylab,main="mass dependent error functon",...)
          }
          )

setAs("Calibintstat","numeric"
      ,def=function(from)
      {
        tmp <- c(as(as(from,"Calibstat"),"numeric")
                 ,nrmatch = from@nrmatch
                 ,ppm = as.numeric(from@ppm)
                 ,error = from@error
                 )
        tmp
      }
      )

setAs("Calibintstat","list"
      ,def = function(from)
      {
        tmp<-c(as(as(from,"Calibstat"),"list")
               ,nrmatch = from@nrmatch
               ,ppm = (from@ppm)
               ,error = from@error
               ,(from@quality[1])
               ,(from@quality[2])
               )
        tmp
      }
      ,replace=function(from,value)
      {
        #print("in as list")
        tmp <- new("Calibintstat")
        tmp@info <- as.character(value$info)
        tmp@lengthmv <- value$lengthmv
        tmp@tcoor <- c(Xtcoor=value$Xtcoor,Ytcoor=value$Ytcoor)
        tmp@Coeff.Intercept <- value$Coeff.Intercept
        tmp@Coeff.Slope <- value$Coeff.Slope
        tmp@nrmatch <- value$nrmatch
        tmp@ppm <- value$ppm
        tmp@error <- value$error
        tmp@quality <- c(Fint=value$Fint,Fab=value$Fab)
        return(tmp)
      }
      )

getintcalibInt <- function(
                           object
                           ,calib
                           ,error=200
                           ,uniq=FALSE
                           ,ppm=TRUE
                           ,weight=FALSE # weighted regression 
                           ,interfix = FALSE #fixes the intercept (absolute error) or the slope (PPM) at zero
                           ,...)
  {
    ##t Internal Calbiration.
    ##- Obtains error model by alingning masses in massvector to known masses (calibration list).
    ##d \bold{Internal calibration} aligns masses of
    ##d peaks to known masses and determines by linear regression a affine
    ##d function that describing the relative error. The internal
    ##d correction fails when no calibration peaks can be found.
    ##d 
    ##+ object : massvector
    ##+ calib : massvector with calibration masses
    ##+ error : assumed measurment error.
    ##+ uniq : \code{TRUE}- use only mass closest to calibration mass. \code{FALSE}- use all masses closer to the calibration mass then given error.
    ##+ ppm : \code{TRUE}- describe the error as relative error. \code{FALSE}- describe the error as absolute error.
    coraf <- new(
                 "Calibintstat"
                 ,info =object@info
                 ,Coeff.Intercept = NaN
                 ,Coeff.Slope = NaN
                 ,lengthmv = length(object)
                 ,nrmatch = NaN
                 ,ppm = ppm
                 ,error = error
                 ,tcoor = object@tcoor
                 ,quality = c(Fint=NaN,Fab=NaN)
                 )
    
    if(length(object)==0)
      {
        return(coraf)
      }
    match <- fmatch(object, calib, error=error, ppm=ppm, uniq=uniq )
    if(length(match$plind)>1)
      {
        ##calculate mass dependent error function.
        ##get peaklist matching
        smallerrpl <- object[match$plind,1,drop=TRUE]
        ##get calibrants matching
        masstheo <- calib[match$calind,1,drop=TRUE]
        err <- match$resid
        
        ##finally calculate error
        ##distinguishing 2 cases. if peaks quite close to each other only correct for offset.
        if(abs(diff(range(masstheo))) < 100)
          {
            errx <- err
            err <- mean(err)
            err <- rep(err,length(errx))
            if(!ppm)
                mymod <- lm( err ~ masstheo - 1 ) #determine slope only
            else(ppm)
                mymod <- lm(err ~ 1) #want to know the intercept only.
          }
        else
          {
            if(weight)
              {
                ww <- error - match$resid 
              }
            else
              {
                ww <- rep(1,length(masstheo))
              }
            
            if(interfix & !ppm)
              {
                mymod <- lm(err ~ masstheo - 1, weights = ww)
              }
            else if(interfix & ppm)
              {
                mymod <- lm(err ~ 1, weights = ww)
              }
            else
              mymod <- lm(err ~ masstheo, weights = ww)
          }
        dt <- ifelse(!is.na(coef(mymod)["(Intercept)"]),coef(mymod)["(Intercept)"],NaN)
        cS <- ifelse(!is.na(coef(mymod)["masstheo"]),coef(mymod)["masstheo"],NaN)
        names(dt) <- "(Intercept)"
        coraf@Coeff.Intercept <- dt
        coraf@Coeff.Slope <- cS
        coraf@nrmatch <- length(match$plind)
        coraf@lmmod <- mymod
        ##compute quality measure.
        t1 <- mean(abs(match$resid))
        t2 <- sd(match$resid)
        quality <- (error - t1)/error * (error-t2)/error
        ##my quality
        sl<-min(length(object),length(calib))
        SAB <- cals(object,calib,error=error,ppm=ppm , msim=calssim , p=3)
        uAB <- c(object[,1],calib[,1])
        FAB <- SAB/(sl*(sl-1)/2*(max(uAB)-min(uAB)))
        coraf@quality <- c(Fint = quality , Fab = FAB)
      }
    return(coraf)
  }

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

setMethod("getintcalib"
          ,signature(object="Massvector",calib="Massvector")
          ,def=getintcalibInt
          )


setClass("Calibintlist"
         ,representation(
                         ppm = "logical"
                         )
         ,contains="Caliblist"
         )

setAs("Calibintlist","data.frame"
      ,def=function(from)
      {
        tmp <- do.call("rbind",lapply(from,as,"data.frame"))
        tmp
      }
      ,replace = function(from,value)
      {
        res<-new("Calibintlist")
        tres<-vector("list",dim(value)[1])
        res@ppm <- value$ppm[1]
        for(i in 1:dim(value)[1])
          {
            tmp<-new("Calibintstat")
            as(tmp,"list") <- as.list(value[i,])
            tres[[i]]<-tmp
          }
        names(tres)<-value$info
        as(res,"list")<-tres
        res
      }
      )


##
## getintcalib without calib - list compiles his own calibration list.
##

setMethod("getintcalib"
          ,signature(object="Massvectorlist",calib="Massvector")
          ,def=function(
             object       # object to calibrate
             ,calib       # calibration list
             ,error=500   # error
             ,uniq=FALSE  # compute optimal alignemnt?
             ,ppm=TRUE    # model measurement by relative or absolute error.
             ,weight=FALSE # use weighted resgression (peaks far apart from others are weighted higher.
             ,interfix=FALSE #always use intercept and slope. If ppm=TRUE constant slope if ppm=FALSE fixes the intercept.
             ,...)
          {
            res <- lapply(object
                          ,getintcalib
                          ,calib
                          ,error=error
                          ,uniq=uniq
                          ,ppm=ppm
                          ,weight=weight
                          ,interfix=interfix
                          )
            names(res) <- names(object)
            res <- res[!unlist(lapply(res,is.null))]
            res <- new("Calibintlist"
                       ,res
                       ,info=object@info
                       ,experiment=object@experiment
                       ,project=object@project
                       ,ppm=ppm
                       )
            res
          }
          )

applyintcalib <- function(obx
                          ,oby
                          ,fast=TRUE
                          ,...)
  {
    ##t Internal Calibration
    ##- Corrects the massvector for the error model stored in calibintstat object.
    ##d \bold{Internal calibration} aligns masses of
    ##d peaks to known masses and determines by linear regression a affine
    ##d function that describing the relative error. The internal
    ##d correction fails when no calibration peaks can be found.
    ##+ object : massvector
    ##+ cal : object of class calibintstat
    ##+ ... : further parameters.
    object <- obx
    cal <- oby
    if(length(object)==0)
      {
        return(object)
      }
    ttt <- object[,1,drop=TRUE]
    errp <- numeric(0)
    intercept <- ifelse(is.na(cal@Coeff.Intercept),0,cal@Coeff.Intercept)
    slope <- ifelse(is.na(cal@Coeff.Slope),0,cal@Coeff.Slope)

    if(fast)
      {
        errp <- intercept + slope * ttt
      }
    else
      {
        errp <- predict(cal@lmmod , data.frame(masstheo=object[,1,drop=TRUE] ) )
      }

    if(cal@ppm)
      {
        object[,1] <- object[,1]/(1 - errp*1e-6)
      }
    else
      {
        object[,1] <- object[,1] + errp
      }
    object
}

setMethod("applycalib"
          ,signature(obx="Calibintstat",oby="Massvector")
          ,def=function(obx,oby,fast=TRUE,...)
          {
            tmp<-applyintcalib(oby,obx,fast=fast,...)
            tmp
          }
          )



setMethod("applycalib"
          ,signature(obx="Massvector",oby="Calibintstat")
          ,def=applyintcalib
          )

setMethod("applycalib"
          ,signature(obx="Massvectorlist",oby="Calibintstat")
          ,def=function(obx,oby,fast=TRUE,...)
          {
            as(obx,"list") <- lapply(obx,applycalib,oby,fast=fast)
            obx
          }
          )

setMethod("applycalib"
          ,signature(obx="Massvectorlist",oby="Calibintlist")
          ,def = function(obx,oby,fast=TRUE,...)
          {
            res <- as.list(rep(0,length(obx)))
            names(res)<-obx@names
            for(i in 1:length(obx))
              {
                nami <- names(obx)[i]
                tmp <- oby[[nami]]
                if(!is.null(tmp))
                  {
                    res[[i]] <- applycalib(obx[[i]] , tmp,fast=fast)
                  }
                else
                  {
                    res[[i]] <- obx[[i]]
                  }
              }
            as(obx,"list") <- res
            obx
          }
          )

setMethod("applycalib"
          ,signature(obx="Calibintstat",oby="Massvectorlist")
          ,def = function(obx,oby)
          {
            as(oby,"list") <- lapply(oby,applycalib,obx)
          }
          )

##################################################
#Global calibration
#if(!isGeneric("getglobalcalib"))

setGeneric("getglobalcalib"
           ,function(object,calib,...)
           standardGeneric("getglobalcalib"))


intglobcalib <- function(object
                         ,calib
                         ,error = 500
                         ,ppm = TRUE
                         ,labund = 12
                         ,abund = length(object)/5
                         ,accur = 2*ifelse(ppm,error/2000,error)
                         ,weight = TRUE
                         ,interfix = FALSE
                         ,...)
  {
    ##t Set Based Internal Calbiration
    ##- Obtains error model using massvector with known masses.
    ##+ object : massvectorlist
    ##+ calib : massvector with calibration masses
    ##+ error : assumed measurment error.
    ##+ uniq : \code{TRUE}- use only mass closest to calibration mass. \code{FALSE}- use all masses closer to the calibration mass then given error.
    ##+ ppm : logical; \code{TRUE}- describe the error as relative error. \code{FALSE}- describe the error as absolute error.
    ##+ labund : how many abundant masses to use for calibration. default=12.
    ##+ abund : default =  length(object)/5
    ##+ accur : default =  ifelse(ppm,error,error/2000)
    ##+ ... : further parameters.
    if(accur < 0.01) stop("error to small")
    mabund <- gamasses(object , accur = accur , abund = abund ,ppm=ppm, ...)
    while(length(mabund) < labund)
      {
        abund <- abund - 5
        mabund <- gamasses(object , accur=accur , abund=abund , ... )
      }
    if(length(mabund) >= labund)
      {
        ord<-order(mabund[,2],decreasing=TRUE)
        mabund <- mabund[ord,]
        mabund<- mabund[1:labund,] # take the most frequent
        ord<-order(mabund[,1])
        mabund <- mabund[ord,]
      }
    else
      {
        print("something wrong")
      }
    if(!is.null(calib))
      {
        mabund <- correctinternal( mabund , calib , error=error,ppm=ppm,weight=weight,interfix=interfix) # correct the abundant masses.
      }
    res <- getintcalib(object
                       ,mabund
                       ,error=error
                       ,ppm=ppm
                       ,weight=weight
                       ,interfix=interfix
                       )
    res
  }

setMethod("getglobalcalib"
          ,signature(object="Massvectorlist",calib="NULL")
          ,def=intglobcalib
          )

setMethod("getglobalcalib"
          ,signature(object="Massvectorlist",calib="Massvector")
          ,def=intglobcalib
          )

setGeneric("globalcalib"
           ,function(object,calib,...)
           standardGeneric("globalcalib"))

setMethod("globalcalib"
          ,signature(object="Massvectorlist",calib="Massvector")
          ,function(object
                    ,calib
                    ,error=500
                    ,labund = 12
                    ,ppm=TRUE
                    ,abund=length(object)/5
                    ,accur = ifelse(ppm,error/2000,error)
                    ,...)
          {
            ##t Set Based Internal Calibration
            ##- Determines the error and corrects for it.
            ##d Set based Calibration copes with the problem of missing calibration
            ##d masses. It first extracts about 15 most abundant masses of the
            ##d massvectorlist, then they are internally calibrated and used
            ##d as new calibration masses. In this fashion more massvectors
            ##d can be internally calibrated.
            ##d Internal calibration aligns masses of
            ##d peaks to known masses and determines by linear regression a affine
            ##d function that describing the relative error. The internal
            ##d correction fails when no calibration peaks can be found.
            ##+ object : massvectorlist
            ##+ calib : massvector with calibration masses
            ##+ error : assumed measurment error.
            ##+ labund : how many abundant masses use for calibration. (8-12 masses are sufficient).
            ##+ accur : default := ifelse(ppm,error/2000,error), used to determine abundant masses.
            ##+ abund : default  := length(object)/5
            ##+ ppm : \code{TRUE}- describe the error as relative error. \code{FALSE}- describe the error as absolute error.
            ##+ ... : further parameters.
            mabund <- gamasses(object , accur=accur , abund=abund , ...)
            while(length(mabund)<10)
              {
                abund <- abund - 10
                mabund <- gamasses(object , accur=accur , abund=abund , ... )
              }
            if(length(mabund)>labund)
              {
                ord<-order(mabund[,2])
                mabund <- mabund[ord,]
                mabund<- mabund[c((length(mabund)- (labund-1)):length(mabund)),]
              }
            abund <- correctinternal(mabund,calib,error=error)
            object <- correctinternal(object,mabund,error=error)
            object
          }
          )


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

setMethod("correctinternal"
           ,signature(object="Massvector",calib="Massvector")
           ,function(
                     object
                     , calib
                     , error = 500
                     , uniq = FALSE
                     , ppm = TRUE
                     , weight = TRUE
                     , interfix = FALSE
                     , ...
                     )
           {
             ##t Internal Calibration
             ##- Corrects the masses of the massvector. It first obtains the model of the
             ##- measrument error by calling \code{getintcalib.massvector}. It than corrects the masses
             ##- by a call to \code{applyintcalib.massvector}.
             ##d \bold{Internal calibration} aligns masses of
             ##d peaks to known masses and determines by linear regression a affine
             ##d function that describing the relative error. The internal
             ##d correction fails when no calibration peaks can be found.
             ##+ object : massvector
             ##+ calib : massvector with calibration masses

             tmp <- getintcalib(
                                object
                                , calib
                                , error=error
                                , uniq=uniq
                                , ppm=ppm
                                , weight=weight
                                , interfix=interfix
                                )

             tmp <- applycalib(object,tmp)
             tmp
           }
         )

setMethod("correctinternal"
          ,signature(object = "Massvectorlist",calib = "Massvector")
          ,function(object
                    ,calib
                    ,error = 500
                    ,ppm = TRUE
                    ,uniq = FALSE
                    ,weight = FALSE
                    ,interfix = FALSE
                    ,...)
          {
            ##t Internal Calibration
            ##- Determines the measurment error of the masses using \code{getintcalib.massvectorlist}.
            ##- It refines the error model and applies it to the massvector by \code{applyintcalib.massvectorlist}.
            ##d \bold{Internal calibration} aligns masses of
            ##d peaks to known masses and determines by linear regression a affine
            ##d function that describing the relative error. The internal
            ##d correction fails when no calibration peaks can be found.
            ##+ object : massvectorlist
            ##+ calib : massvector with calibration masses
            ##+ error : assumed measurment error.
            ##+ uniq : logical;\code{TRUE}- use only mass closest to calibration mass. \code{FALSE}- use all masses closer to the calibration mass then given error.
            ##+ ppm : logical;\code{TRUE}- describe the error as relative error. \code{FALSE}- describe the error as absolute error.
            tmp <- getintcalib(object
                               ,calib
                               ,error = error
                               ,ppm = ppm
                               ,uniq = uniq
                               ,weight = weight
                               ,interfix = interfix
                               )
            object <- applycalib(object,tmp)
            object
          }
          )

# does not work because converges to slowly.
# hence introduce different update role.
# use the peaklists with the highest number of conections.
# INTERNAL

maxSTCalib <- function(
                       object #object
                       ,dmat #dissimilarity matrix !
                       ,mstart
                       ,error=0.4 #measurment error
                       ,ppm=FALSE #ppm error
                       ,weight=FALSE
                       )
  {
    dmat <- as.matrix(dmat)
    dmat <- dmat - diag((max(dmat)+1),dim(dmat)[1])
                                        #max.dmat <- max(dmat) #maximal distance
                                        #    dmat<-dmat + diag(x=max.dmat,dim(dmat)[1])
    L1 <- NULL #lists already in the spannign tre
    U1 <- NULL #lists outside
    Fm1 <- NULL
    object.length <- length(object)
    calibstat1 <- vector("list",(object.length))
    W <- numeric(object.length)
    if(missing(mstart))
      {
        L1 <- which(max(dmat) == dmat , arr.ind = TRUE)[1,2]
      }
    else
      {
        L1 <- mstart
      }
    Fm1 <- rbind(Fm1,c(L1 ,-1,Inf))   # "the starting edge"
    calibstat1[[ L1 ]] <- new("Calibintstat"
                              ,info=object[[L1]]@info
                              ,tcoor=object[[L1]]@tcoor
                              ,Coeff.Intercept=0
                              ,Coeff.Slope=0
                              ,quality=c(Fint=1,Fab=1)
                              , error=error
                              , ppm=ppm)
                              
    calibstat1[[ L1 ]]@quality <-  c(calibstat1[[ L1 ]]@quality,W = max(dmat))
    object.indices <- 1:object.length
    j <- 2

    for(i in 2:(object.length))
      {
        U1 <- setdiff(object.indices,L1)
        tmpmat <- dmat[ U1 , L1 , drop=FALSE]
        tmp <- which( max( tmpmat) == tmpmat , arr.ind = TRUE )[1,] #maximum spanning tree.
        dmat[U1[tmp[1] ],L1[tmp[2] ]] <- 0
        dmat[L1[tmp[2] ],U1[tmp[1] ]] <- 0
        j <- j+1
        rtmp <- getintcalib( object[[ U1[tmp[1]] ]]
                            , object[[ L1[tmp[2]] ]]
                            , error=error
                            , ppm=ppm
                            , weight=weight
                            )
        
        W <- min(max(tmpmat),calibstat1[[ L1[ tmp[2] ] ]]@quality[3])
        #cat(max.dmat,"-",min(tmpmat)," ",W,"\n")
        Fm1 <- rbind(Fm1,c(U1[tmp[1]],L1[tmp[2]],W))
        rtmp@quality <- c(rtmp@quality, W=W)
        #merge coefficients.
        ctmp <- calibstat1[[ L1[tmp[2]] ]]
        rtmp@Coeff.Intercept = rtmp@Coeff.Intercept + ctmp@Coeff.Intercept + rtmp@Coeff.Slope* ctmp@Coeff.Intercept
        rtmp@Coeff.Slope = rtmp@Coeff.Slope + ctmp@Coeff.Slope + rtmp@Coeff.Slope* ctmp@Coeff.Slope
        if(is.null(rtmp))
          {
            print("IsNULL")
          }
        calibstat1[[ U1[tmp[1]] ]] <- rtmp
        names(calibstat1)[U1[tmp[1]]] <- object[[ U1[tmp[1]] ]]@info
        L1 <- c(L1,U1[tmp[1]])
      }
    return(list(F=Fm1 , C = new("Calibintlist" , calibstat1) , dmat=dmat, start = L1[1] ))
  }

##
## computes the minimum spanning tree mmax times.
##

setClass("mstCalib"
         ,contains="list"
         ,representation(
                         info="character"
                         ,error="numeric"
                         ,ppm="logical"
                         ,weight="logical"
                         ,mmax="numeric"
                         )
         )

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


setMethod("getmstCalib"
          ,signature(object="Massvectorlist")
          ,definition = function(
             object
             ,dmat
             ,mmax
             ,error=0.3
             ,ppm = FALSE
             ,weight = FALSE
             , ...                           #,thresh=600
             )
          {
            if(missing(dmat))
              dmat <- cals(object,NULL,error=error,ppm=ppm)
            dmat <- as.matrix(dmat)
            dmat <- max(dmat) - dmat
            dmat <- dmat - diag(max(dmat),dim(dmat)[1],dim(dmat)[2])
            res  <- NULL
            if(missing(mmax))
              mmax<-max(3,floor(log(length(object))))
            res<-vector("list",mmax)
            res[[1]] <- maxSTCalib(object,dmat,error=error,ppm=ppm)
            if(mmax > 1)
              {
                for(i in 2:mmax)
                  {
                    res[[i]] <- maxSTCalib( object,res[[i-1]]$dmat,mstart=res[[i-1]]$start,error=error,ppm=ppm ,weight=weight)
                  }
              }
            res <- new("mstCalib"
                       ,res
                       ,info=object@info
                       ,ppm=ppm
                       ,error=error
                       ,weight=weight
                       ,mmax=mmax
                       )
            return(res)
          }
          )

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


setMethod("thebigcalib"
          ,signature(object="mstCalib")
          ,def=function(
             object
             ,qualzero = TRUE
             ,...)
          {
            tt <- as(object[[1]]$C,"list")
            for(i in 2:length(object))
              {
                ttt<-as(object[[i]]$C,"list")
                for(j in 1:length(tt))
                  {
                    
                    sumq <-  tt[[j]]@quality[3] + ttt[[j]]@quality[3]
                    if(ttt[[j]]@quality[3] != 0)
                      {
                        tt[[j]]@Coeff.Intercept <- (tt[[j]]@Coeff.Intercept * tt[[j]]@quality[3] + ttt[[j]]@Coeff.Intercept * ttt[[j]]@quality[3])/sumq
                        tt[[j]]@Coeff.Slope <- (tt[[j]]@Coeff.Slope * tt[[j]]@quality[3] + ttt[[j]]@Coeff.Slope * ttt[[j]]@quality[3])/sumq
                      }
                    tt[[j]]@quality[3] <- sumq
                  }
              }
            res<-object[[1]]$C
            as(res,"list") <- tt
            return(res)
          }
          )


## --------------------------------------------------------------------------
## mscalib - R package for mass spectrometric peaklist calibration and filtering
## --------------------------------------------------------------------------
##  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)
library(msbase)

setOldClass("smooth.spline")
setClass("Calibextstat"
         ,representation(
                         nrmatch="numeric"
                         ,ppm="logical"
                         ,error="numeric"
                         ,spl="smooth.spline"
                         ,merror="numeric"
                         ,theo="numeric"
                         )
         ,contains="Calibstat"
         ,prototype(
                    info = ""
                    ,tcoor = c(NaN,NaN)
                    ,lengthmv = NaN
                    ,nrmatch = NaN
                    )
         )

setMethod(
          "show","Calibextstat"
          ,def = function(object)
          {
            show(as(object,"Calibstat"))
            cat("nrmatch         :",object@nrmatch,"\n")
            cat("ppm             :",object@ppm,"\n")
            cat("errorwindow     :",object@error,"\n")
          }
          )




setMethod("plot" , signature(x="Calibextstat",y="missing")
          ,def = function(x
             ,y
             ,pch="*"
             ,xlab="theoretical mass [m/z]"
             ,ylab=ifelse(x@ppm,"error [ppm]","error [m/z]")
             ,main=x@info
             ,...)
          {
            plot(x@theo
                 ,x@merror
                 ,pch=pch
                 ,xlab=xlab
                 ,ylab=ylab
                 ,main=main
                 , ... )
            lines( predict( x@spl , x@spl$x ) , col=2 )
          }
          )


getextcalibInt <- function(object
                           ,calib
                           ,error=300
                           ,ppm=TRUE
                           ,uniq=FALSE
                           ,...)
{
  ##t External Error Model
  ##- Returns the error model obtained from the calibration sample.
  ##d In case of \bold{external calibration} some sample spots are only dedicated
  ##d to calibration. Calibration samples which produces equidistant
  ##d peaks, which exact masses are known, can be used to precisely
  ##d estimate the mass dependent error function.
  ##+ object : massvector
  ##+ calib : massvector with calibration masses
  ##+ error : relative measurment error in ppm.
  ##v calibspline : can be used to calibrate peaklists
  ##sa calibspline, applyextcalib.massvector
  ##r Gobom J, Mueller M, Egelhofer V, Theiss D, Lehrach H, Nordhoff E, 2002. A calibration method that simplifies and improves accurate determination of peptide molecular masses by MALDI-TOF MS. \emph{Anal Chem.} 74(15):3915-23.
  ##r Wolski \url{http://www.molgen.mpg.de/~wolski/mscalib}
  if(missing(calib))
    {
      calib<-getPPGmasses()
    }
  object <- correctinternal( object , calib , error = error,ppm = ppm)
  
  exp <- object
  match <- fmatch(object,calib,error=error,ppm=ppm,uniq=uniq)
  expd <- object[match$plind,1]
  theo <- calib[match$calind,1]
  mord <- order(theo)
  expd <- expd[mord]
  theo <- theo[mord]
  require(stats)
                                        #calculate mass dependent error
  if(ppm)
    {
      merror <- (expd - theo) * 1e6/theo
    }
  else
    {
      print("test")
      merror <- (expd - theo)
    }
  ispl <- smooth.spline(theo,merror)
  ispl <- new("Calibextstat"
              ,ppm=ppm
              ,error=error
              ,spl=ispl
              ,merror=merror
              ,theo=theo
              )
  return(ispl)
}


getextcalibMV <- function(
                          object #list with ppg spectra.
                          ,calib #calibration list.
                          ,error=500
                          ,uniq=FALSE
                          ,ppm=TRUE
                          ,...)
  {
    if(missing(calib))
      {
        calib <- getPPGmasses()
      }
    ppg <- calib
    theo <- NULL
    expd <- NULL
    for(x in 1:length(object))
      {
        exp <- object[[x]]      
        exp <- correctinternal(exp,calib,error=error,uniq=TRUE,ppm=ppm)
        match <- fmatch(exp,calib,error=error,uniq=TRUE,ppm=ppm)
        expd <- c(expd,exp[match$plind,1])
        theo <- c(theo,ppg[match$calind,1])
      }
    mord <- order(theo)
    expd <- expd[mord]
    theo <- theo[mord]
    require(stats)
                                        #calculate mass dependent error
    if(ppm)
      {
        merror <- (theo-expd)*1e6/theo
      }
    else
      {
        print("test")
        merror <- theo-expd
      }
    
    ispl <- smooth.spline(theo,merror)
    ispl <- new("Calibextstat"
                ,ppm=ppm
                ,error=error
                ,spl=ispl
                ,theo=theo
                ,merror=merror
                )
    return(ispl)
  }

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

setMethod("getextcalib"
          ,signature(object="Massvectorlist",calib="missing")
          ,def=getextcalibMV
          )

##returns a calibration spline by comparing masses in the Massvectorlist object and calib.
##The object[[1]]@info field is used as key to access the correspoinding Massvector in calib.

#setMethod("getextcalib"
#          ,signature(object="Massvectorlist",calib="Massvector")
#          ,def=function(object,calib,spar=0.9,...)
#          {
#            tcalib <- calib
#                                        #           tt <- as( calib , "data.frame" )
#                                        #           tcalib <- calib[which(calib@minscore < tt$score)] #select the hits
                                        #           tcalib <- as(tcalib,"Massvectorlist")

#            ppm <- ifelse(calib@searchpar$TOLU == "Da",FALSE,TRUE)
#            tt <- residuals(object , tcalib , add=1,error=calib@searchpar$TOL , ppm=ppm)
 #           tt <- unlist(tt)
 #           theo<-tt[,1,drop=TRUE]
 #           merror <- tt[,2,drop=TRUE]*1e6/tt[,1,drop=TRUE]
 #           ispl <- smooth.spline(theo , merror,spar=spar)
 #           ispl <- new("Calibextstat"
 #                       ,ppm=ppm
#                        ,error=error
#                        ,spl=ispl
#                        ,theo=theo
#                        ,merror=merror
#                        )
#            return(ispl)
#          }
#          )



#external calibration of an massvector.
setMethod("getextcalib"
          ,signature(object="Massvectorlist",calib="Massvector")
          ,def=getextcalibMV
          )

setMethod("getextcalib"
          ,signature(object="Massvector",calib="Massvector")
          ,def = getextcalibInt
          )

applyextcalib <- function( obx , oby , ... )
  {
    ##t External Calbiration
    ##- Applys object of class calibspline to massvector or massvectorlist to correct for measurment errors.
    ##d In case of \bold{external calibration} some sample spots are only dedicated
    ##d to calibration. Calibration samples which produces equidistant
    ##d peaks, which exact masses are known, can be used to precisely
    ##d estimate the mass dependent error function.
    ##+ object : massvector
    ##+ cS : calibspline
    ##v massvector : calibrated massvector
    ##sa applyextcalib.massvectorlist, getextcalib.massvector, getextcalib.massvectorlist
    ##r Gobom J, Mueller M, Egelhofer V, Theiss D, Lehrach H, Nordhoff E, 2002. A calibration method that simplifies and improves accurate determination of peptide molecular masses by MALDI-TOF MS. Anal Chem. 74(15):3915-23.
    ##r Wolski http://www.molgen.mpg.de/~wolski/mscalib
    ##e data(mv1)
    ##e data(ppg)
    ##e res<- getextcalib(ppg,getPPGmasses(),error=150)
    ##e plot(res)
    ##e mv2<-applycalib(res,mv1)
    ##e compare(mv1,mv2,error=300)
    ##e rm(mv1,mv2)
    ##e data(mvl)
    ##e mvl<-mvl[1:100]
    ##e res<-applycalib(res,mvl)
    error <- predict(obx@spl,oby[,1])
    error <- error$y
    if(obx@ppm)
      oby[,1] <- oby[,1]/(1 - error/1e6) #
    else 
      oby[,1] <- oby[,1] + error #
    return(oby)
  }

setMethod("applycalib"
          ,signature(obx="Massvector",oby="Calibextstat")
          ,def=function(obx,oby)
          {
            return(applyextcalib(oby,obx))
          }
          )

setMethod("applycalib"
          ,signature(obx="Calibextstat",oby="Massvector")
          ,def=applyextcalib
          )

setMethod("applycalib"
          ,signature(obx="Massvectorlist",oby="Calibextstat")
          ,def=function(obx,oby,...)
          {
            as(obx,"list") <- lapply( obx , applycalib , oby,... )
            obx
          }
          )

getPPGmasses <- function(start=10,end=100)
{
  ##t PPG masses
  ##- Computes poly-(propylene glycol) masses.
  ##+ start : length of shortest polymer.
  ##+ end : length of longest polymer.
  ##v massvector : massvector of ppg masses
  ##e plot(getPPGmasses(start=12,end=100))
  mC  <-  12
  mH <- 1.007825
  mO <- 15.994915
  mNa <- 22.98977
  me <- 0.00054858
  massPPG <- mC*3 + mH*6 + mO
  massOH <- mO+mH
  n <- start:end
  n <- massPPG * n + massOH + mH + mNa - me
  names(n) <- start:end
  tt <-cbind(n,start:end)
  colnames(tt)<-c("mass","n")
  tmp <- new("Massvector",tt,"theoretical ppg masses")
  tmp
}

## --------------------------------------------------------------------------
## mscalib - R package for mass spectrometric peaklist calibration and filtering
## --------------------------------------------------------------------------
##  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)
library(msbase)

setClass("Calibprelist",contains="Caliblist")

setClass("Calibprestat"
         ,representation(
                         freq="numeric"
                         ,ppm="logical"
                         )
         ,contains = "Calibstat"
         ,prototype(info=""
                    ,tcoor=c(NaN,NaN)
                    ,Coeff.Intercept=NaN
                    ,Coeff.Slope=NaN
                    ,lengthmv=NaN
                    ,PQM=NaN
                    ,ppm=TRUE
                    ,freq=1.000495
                    )
         )



setMethod("show","Calibprestat"
          ,def=function(object)
          {
            show(as(object,"Calibstat"))
            cat("class___________:",class(object),"\n")
          })

setMethod("plot",signature(x="Calibprestat",y="missing")
          ,def=function(x,y)
          {
            plot(1,1,xlim=c(500,4000),ylim=c(-2,2),type="n")
            print(c(x@Coeff.Intercept,(x@Coeff.Slope)/1e6))
            abline(c(x@Coeff.Intercept,(x@Coeff.Slope)/1e6))
          })

#whats better 
setAs("Calibprestat"
      ,"numeric"
      ,function(from)
      {
        res<-c(
               if(is.null(from@lengthmv)){c("lengthmv"=NaN)}else{c("lengthmv"=from@lengthmv)}
               ,if(is.null(from@Coeff.Intercept)){c("Coeff.Intercept"=NaN)}else{c("Coeff.Intercept"=from@Coeff.Intercept)}
               ,if(is.null(from@Coeff.Slope)){c("Coeff.Slope"=NaN)}else{c("Coeff.Slope"=from@Coeff.Slope)}
               ,from@quality
               ,if(is.null(from@tcoor)){c(tcoorX=NaN,tcoorY=NaN)}else{c(tcoorX=from@tcoor[1],tcoorY=from@tcoor[2])}
               )
        names(res)<-c("lengthmv","Coeff.Intercept","Coeff.Slope",names(from@quality),"tcoorX","tcoorY")
        res
      }
      )

setAs("Calibprestat"
      ,"list"
      ,function(from)
      {
        tmp<-as.list(from@quality)
        names(tmp)<-names(from@quality)
        res <- list(
                    ,info=from@info
                    ,lengthmv=from@lengthmv
                    ,Coeff.Intercept=as.numeric(from@Coeff.Intercept)
                    ,Coeff.Slope=as.numeric(from@Coeff.Slope)
                    ,Xtcoor=from@tcoor[1]
                    ,Ytcoor=from@tcoor[2]
                    )
        res<-c(res,tmp)
        res
      }
      )




#########################################################################
## Computes calibration coefficients for an aligned set of peak-lists  ##
#########################################################################


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


setMethod("getLpepcalib"
          ,signature(object="Massvectorlist")
          ,function(object
                    , freq = 1.000495
                    , lengthmv=20  # minimal length of peak-list to be used for calibration.
                    , mrange = c(0,max(unlist(object)[,1]))
                    , ...
                    )
          {
            objs <- object[sapply(object,length)>=lengthmv]
            rest <- getpepcalib( objs , freq=freq , mrange = mrange , ...)
            rest <- as(rest,"data.frame")
            slope.mean <- mean(rest$Coeff.Slope)
            slope.sd <- sd( rest$Coeff.Slope )
            intercept.mean <- mean(rest$Coeff.Intercept)
            intercept.sd <- sd(rest$Coeff.Intercept)
            res <- new("Calibprestat")
            res@info <- object@info
            res@Coeff.Intercept <- intercept.mean
            res@Coeff.Slope <- slope.mean
            res@lengthmv <- mean(rest$lengthmv)
            res@quality <- c("slope.sd" = slope.sd ,"intercept.sd" = intercept.sd)
            return(res)
          }
          )


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

setMethod("getpepcalib"
          ,signature(object="numeric")
          ,def = function(
             object
             , freq=1.000495
             , mrange=c(0,max(object))
             , ... )
          {
            m <- wsdist2(object, freq = freq , mrange=mrange)
            y <- m$ret 
            x <- m$ret2
            #cat(length(y),"y",length(x),"x\n")
            if(length(y)>2)
              {
                mylm <- rlm(y ~ x-1)
                slope <- coef(mylm)[1]
                slope.sd <- sd(residuals(mylm))
                xx <- object*(1-slope) #correct masses
                dst <- distance2(xx,0,freq=freq)
                dst.sd <-sd(dst)
                dst.mean <- mean(dst,trim=0.2)
                dd <- distance(xx-dst.mean,0,freq=freq)
                Dpr<-mean(dd)
                #compute quality measures.
                cham <- (0.5-mean(dd))/0.5 * (0.5-sd(dd))/0.5
              }
            else
              {
                slope <- NaN
                slope.sd <- NaN
                dst.mean <- NaN
                dst.sd <- NaN
                Dpr <- NaN
                cham <- NaN
              }
            res<-c(-slope,dst.mean)
            return(c("slope" = res[1] # MME model slope
                     ,"intercept" = res[2] #MME model intercept
                     ,"Dpr" = Dpr #average distance to cluster centers.
                     ,"slope.sd" = slope.sd # standard deviation of the slope residuals.
                     ,"intercept.sd" = dst.sd # standard deviation of the intercept.
                     ,"Fpre"=cham
                     ))
          }
          )

setMethod("getpepcalib"
          ,signature(object="Massvector")
          ,def=function(object
             , freq = 1.000495
             , mrange=c(0,max(object[,1]))
             ,...)
          {
            if(!length(object)>2)
              {
                res <- new("Calibprestat")
                res@info <- object@info
                res@Coeff.Intercept <- NaN
                res@Coeff.Slope <- NaN
                res@lengthmv <- length(object)
                res@tcoor <- object@tcoor
                res@quality <- c("Fpre"=NaN,"Dpr"=NaN,"Intercept.sd"=NaN,"Slope.sd"=NaN)
                res@freq <- freq
                return(res)
              }
            coef <- getpepcalib(object[,1,drop=TRUE],freq=freq, mrange=mrange,error=error,...)
            res<-new("Calibprestat")
            res@info=object@info
            res@Coeff.Intercept= coef[2]
            res@Coeff.Slope= coef[1]
            res@lengthmv = length(object)
            res@tcoor= object@tcoor
            res@quality = c("Fpre"=as.numeric(coef[6]) ,"Dpr"=as.numeric(coef[3]),"Intercept.sd"=as.numeric(coef[5]),"Slope.sd"=as.numeric(coef[4])) #
            return(res)
          }
          )

setMethod("getpepcalib"
          ,signature(object="Massvectorlist")
          ,function(
                    object
                    ,freq=1.000495
                    ,...
                    )
          {
            res <- lapply(object,getpepcalib,freq=freq,...)
            res <- new("Calibprelist"
                       ,res
                       ,info=object@info
                       ,project=object@project
                       ,experiment=object@experiment
                       )
            res
          }
          )



########################################
## Higher order calibration function. ##
########################################

setClass("CalibPRstat"
         ,contains="Calibextstat"
         ,representation(
                         freq="numeric"
                         )
         )



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

setMethod("getPRcalib"
          ,signature(object="Massvector")
          ,function(
                    object
                    ,freq = 1.000495
                    ,ppm = FALSE
                    ,df=6
                    ,cv=TRUE
                    )
          {
            mass <- object[,1,drop=TRUE]
            mv2 <- distance2(mass,0,freq=freq)
            tt <- cbind(mass,mv2)
            if(ppm)
              tt[,2] <- (tt[,2]/tt[,1])*1e6
            ispl <- smooth.spline(tt,df=df,cv=cv)#,spar=spar)
            ispl <- new(
                        "CalibPRstat"
                        ,ppm=ppm
                        ,freq=freq
                        ,spl=ispl
                        ,theo = mass
                        ,merror = tt[,2]
                        )
            return(ispl)
          }
          )

setMethod("getPRcalib"
          ,signature(object="Massvectorlist")
          ,function(
                    object
                    ,freq = 1.000495
                    ,ppm = FALSE
                    ,df = 5
                    ,cv=TRUE
                    )
          {
            object <- unlist(object)
            return(getPRcalib(object
                              ,ppm=ppm
                              ,freq=freq
                              ,df=df
                              ,cv=cv
                              ))
          }
          )

###################
## WS algorithm ###
###################


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


setMethod("getprecalib"
          ,signature(object="numeric")
          ,function( object
                    ,freq=1.000495
                    ,plot= FALSE
                    ,PQM = TRUE #if you like to speed up the execution set to F.
                    )
          {
            PQMval <- NaN
            mv <- object
            if(sum(is.na(object))>0)
              stop("NA's in the data\n")
            if(length(object) < 3)
              return(c(Intercept = NULL,Slope = NULL))
            lambda <- seq(freq-0.01 , freq+0.01 , 0.00001)
            omega <- 2*pi/lambda
            test <- mv%*%t(omega)
            testsin <- sin(test)
            testcos <- cos(test)
            colsumsin <- apply(testsin,2,sum)
            colsumcos <- apply(testcos,2,sum)
            sumcol <- sqrt(colsumsin^2 + colsumcos^2)
            sumcol <- cbind(lambda,sumcol)
                                        #determine the maximum and get its index
            mmax <- max(sumcol[,2])
            index<-sumcol[,2] == mmax
            if(FALSE)
              {
                return(sumcol)
              }
                                        #temporary only for testing purposes.
            if(plot){
              len<-length(mv)
              main <- paste("Massvector length : ", len, sep="")
              plot(sumcol,type="l",ylab="Amplitude",xlab="Wavelength",xlim=c(0.9995,1.0015),las=2, main = main)
              points(sumcol[,1][index],sumcol[,2][index],col=2,pch="*")
              stat<-FullWidthatHalfMaximum(sumcol)
              abline(h=stat$hm)
              abline(v=stat$width)
            }
            if(PQM)
                {
                  stat <- FullWidthatHalfMaximum(sumcol)
                  PQMval <- stat$PQM
                }
                                        #by which wavelength the maximum occure
            lambdamax<-sumcol[,1][index]
                                        #calculate the phase shift.
            phimax<-atan(colsumsin[index]/colsumcos[index])
                                        #we now see that the peak centers lie on the line
                                        # M= lambdamax*N + bmaxx
            bmax<-lambdamax*phimax/(2*pi)
                                        #to coorect the peaklist apply
                                        #peak<-(peaklist-bzero)/alpha
            alpha <- 1.000495/lambdamax
            tmp<-c(bmax,alpha)
            return(c(Intercept= -(tmp[1]*tmp[2]) , Slope=(tmp[2]-1),"PQM"=PQMval ))
          }
          )

          
setMethod("getprecalib"
          ,signature(object="Massvector")
          ,function(
                    object
                    ,freq=1.000495
                    ,plot=FALSE
                    ,PQM = TRUE #if you like to speed up the execution set to F.
                    )
          {
            mv<-as(object,"matrix")[,1]
            if(sum(is.na(mv))>0)
              stop("NA's in the data\n")
                                        #returns calibration constants obtained by the wools smilanski method.
            if(length(object)<3)
              {
                res <- new("Calibprestat")
                res@info = object@info
                res@Coeff.Intercept = NaN
                res@Coeff.Slope = NaN
                res@lengthmv = length(object)
                res@tcoor = object@tcoor
                res@quality=c("Fpre" = NaN , "pqm" = NaN , "Dpr" = NaN )
                return(res)
              }
            tmp<-getprecalib(
                             mv
                             ,freq=freq
                             ,plot= plot
                             ,PQM = PQM #if you like to speed up the execution set to F.
                             )
            res<-new("Calibprestat")
            res@info=object@info
            names(tmp)<- c("Intercept","Slope")
            res@Coeff.Intercept = tmp[1]
            res@Coeff.Slope = tmp[2]
            res@lengthmv = length(object)
            res@tcoor= object@tcoor
            #chamrad qual
            dpr <- distance(0, mv*(tmp[2])-(tmp[1]*tmp[2]), freq = freq)
            t1 <- (0.5-mean(dpr))/0.5
            t2 <- (0.5-sd(dpr))/0.5
            chamQ <- t1 * t2
            res@quality = c("Fpre"=chamQ , "pqm" =as.numeric( tmp[3] ) , "Dpr" = mean(dpr) )
            return(res)
          }
)



setMethod("getprecalib"
          ,signature(object="Massvectorlist")
          ,function(
                    object
                    ,freq=1.000945
                    ,plot=FALSE
                    ,PQM=TRUE
                    )
          {
            res <- lapply(object
                          ,getprecalib
                          ,freq=freq
                          ,plot=plot
                          ,PQM=PQM
                          )
            res <- new("Calibprelist",res,info=object@info,project=object@project,experiment=object@experiment)
            res
          }
          )


FullWidthatHalfMaximum<-function(sumcol)
{
   minmax<-range(sumcol[,2])
                                        #   compute the half maximum
   abl1<-diff(sumcol[,2])
   ta1a<-c(abl1,1)
   ta1b<-c(1,abl1)
   minima <- which(ta1a>0 & ta1b<0)
   mmax <- which(sumcol[,2]==max(sumcol[,2]))
   if(mmax==1 | mmax==length(sumcol[,2]))
     {
          return(list(PQM = 0,hm=c(0,0,0),width=c(0,0)))
     }
   else
     {
       ll <- which(minima<mmax)
       rr <- which(minima>mmax)
       if(length(ll)>0){
           lmin<- max(minima[ll])
         }
       else{
           lmin<-1
         }
       if(length(rr)>0){
           rmin<- min(minima[rr])
         }
       else{
           rmin<-length(ta1a)
         }
       
       int<-sumcol[,2]
                                        #peak hight.
       pmax <- int[mmax] # peak maximum
       pmin <- max(c(int[lmin],int[rmin])) #peak minimum
       ph <- pmax - pmin
       if(FALSE)
         {
           plot(sumcol[,2],type="l")
           
           abline(h=pmax)
           abline(h=pmin)
           abline(v=mmax,col=2)
           abline(v=rmin,col=3)
                                        #   maxima <- which(tt<0 & tt2>0)
           abline(v=lmin,col=4)
         }
                                        # peak width
                                        # halfmax
       hm<-ph/2
       sumcc<-sumcol[lmin:rmin,]
                                        # hm <- (minmax[1] + minmax[2])/2
       dumm<-0.05
       while(TRUE){
         hi<-(pmin + hm + hm*dumm)
         lo<-(pmin + hm - hm*dumm)
         
         width <-sumcc[,1][sumcc[,2]<hi &sumcc[,2]>lo]
         if(length(width)>2) break;
         dumm<-dumm+0.05
       }
       if(FALSE)
         {
           plot(sumcc,type="l")
           abline(h=hi)
           abline(h=lo)
         }
       ind <- which(diff(width)==max(diff(width)))
       width <- c(mean(width[1:ind]),mean(width[(ind+1):length(width)]))
       hm<-c(pmin + hm,pmax,pmin)
       names(hm)<-c("HalfMaximum","max","min")
       width<-c(width[2]-width[1],width)
     }
   return(list(PQM=-log(as.numeric(width[1]/ph)),hm=hm,width=width))
}

recalib <- function(object,mv,...)
  {
    ##t Precalibration
    ##d \bold{Precalibration} method utilizes the knowledge that masses
    ##d of peptides are in equidistant spaced clusters. The wavelength of
    ##d the \emph{massesvector} can be determined as described by
    ##d Wool. The comparision of the experimental wavelength with
    ##d the theoretical one, makes possible to find an affine function
    ##d that corrects the masses. Chemical noise in the spectra may hamper
    ##d the determination of mass list frequency. The package provides a
    ##d function to filter chemical noise.
    ##- Uses the error model obtained by the method \code{getprecalib} to correct masses in the massvector.
    ##+ object : calibrestat
    ##+ mv : massvector
    ##+ ...: further arguments
    ##w massvector : recalibrated massvector.
    ##sa applycalib.calibintstat, getprecalib.massvector, getprecalib.massvectorlist, recalibrate.massvector, recalibrate.massvectorlist, calibrestat, calibrelist
    ##r Wool A, Smilansky Z 2002. Precalibration of matrix-assisted laser desorption/ionization-time of flight spectra for peptide mass fingerprinting. \bold{Proteomics.} 2(10):1365-73.
    ##r Wolski \url{http://www.molgen.mpg.de/~wolski/mscalib}
    ##e data(mv1)
    ##e res <- getprecalib(mv1)
    ##e plot(res)
    ##e mv2<-applycalib(res,mv1)
    ##e plot(mv1[,1],mv2[,1]-mv1[,1])
    intercept <- ifelse(is.na(object@Coeff.Intercept),0,object@Coeff.Intercept)
    slope <- ifelse(is.na(object@Coeff.Slope),0,object@Coeff.Slope)
    peak <- ( mv[,1]* ( slope + 1) - intercept )
    mv[,1] <- peak
    return(mv)
  }

setMethod("applycalib"
          ,signature(obx="Calibprestat",oby="Massvector")
          ,function(obx,oby,...)
          {
            recalib(obx,oby,...)
          }
          )

setMethod("applycalib"
          ,signature(obx="Massvector",oby="Calibprestat")
          ,function(obx,oby,...)
          {
            recalib(oby,obx)
          }
          )

setMethod("applycalib"
          ,signature(obx="Massvectorlist",oby="Calibprestat")
          ,function(obx,oby)
          {
            as(obx,"list") <- lapply(obx,applycalib,oby,...)
            obx
          }
          )

setMethod("applycalib"
          ,signature(obx="Massvectorlist",oby="Calibprelist")
          ,function(obx,oby)
          {
            res <- vector("list",length(obx))
            names(res) <- obx@names
            for(i in 1:length(obx))
              {
                nami<-names(obx)[i]
                if(!is.null(oby[[nami]]))
                   {
                     res[[i]] <- applycalib(obx[[i]],oby[[nami]])
                     #names(res)[i] <- obx[[i]]@info
                   }
                else
                  {
                    res[[i]]<-obx[[i]]
                    #names(res)[i]<-obx[[i]]@info
                  }
              }
            as(obx,"list") <- res
            obx
          }
          )


wsdist2 <- function(object
                    , freq = 1.000495
                    , mrange = c(0,max(object))
                    , ...
                    )
  {
    ##t Wool Smilanski Distance Matrix
    ##- This function computes and returns the distance matrix
    ##- using the intra massvecotor distance  measure.
    ##+ object : matrix
    ##v dist : an object of class distance.
    ##sa wsFilter.massvector, wsiFilter.massvector,
    ##r Wool A, Smilansky Z 2002. Precalibration of matrix-assisted laser desorption/ionization-time of flight spectra for peptide mass fingerprinting. \emph{Proteomics.} 2(10):1365-73.
    ##r Wolski \url{http://www.molgen.mpg.de/~wolski/mscalib}
    ##e data(mv1)
    ##e plot(hclust(wsdist(mv1),method="single"))
    if(class(object)=="Massvector")
      {
        pl<-c(object[,1,drop=TRUE])
      }
    else
      {
        pl<-as.numeric(object)
      }
  
    pl.length<-length(pl)
    if(!(pl.length>1))
      return(list(ret=NULL,ret2=NULL))
    ret <- rep(0,pl.length*(pl.length-1)/2)
    ret2 <- rep(0,pl.length*(pl.length-1)/2)
    mstart <- 0 
    mend <- 0
    for(i in 2:pl.length)
    {
      t1 <- distance2(pl[i]
                      , pl[1:(i-1)]
                      , freq=freq)

      t2 <- abs(pl[1:(i-1)]-pl[i])
      t1 <- t1[t2>mrange[1] & t2<mrange[2]]
      t2 <- t2[t2>mrange[1] & t2<mrange[2]]

      if(length(t2)>0)
        { 
          mstart<-mend+1
          mend<-mend+length(t2)
          ret[mstart:mend] <- t1
          ret2[mstart:mend] <- t2
        }
    }
    return(list(ret=ret[1:mend],ret2=ret2[1:mend]))
  }


distance2 <- function(p1,p2,freq=1.000495)
  {
    p1<-as.numeric(p1)
    p2<-as.numeric(p2)
    ##t Intra massvector mass distance
    ##- Distance between two peaks o a massvector defined as deviation from the peptide rule.
    ##+ p1 : mass
    ##+ p2 : mass
    ##v distance : distance of the two masses, as deviation from the peptide rule.
    ##r Wool A, Smilansky Z 2002. Precalibration of matrix-assisted laser desorption/ionization-time of flight spectra for peptide mass fingerprinting. {\em Proteomics.} 2(10):1365-73.
    ##r Wolski http://www.molgen.mpg.de/~wolski/mscalib
    x<-abs(p1-p2)
    mn <- x%%freq
    mnt <- mn
    mns <- mnt[mnt > 0.5]
    mn[mnt > 0.5] <- -(1 - mns)
    return(mn)
  }




## --------------------------------------------------------------------------
## mscalib - R package for mass spectrometric peaklist calibration and filtering
## --------------------------------------------------------------------------
##  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)
library(msbase)


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

#p1 -have to be a double
#p2 -can be a vector
distance <- function(p1,p2,freq=1.000495)
  {
    ##t Intra massvector mass distance
    ##- Distance between two peaks o a massvector defined as deviation from the peptide rule.
    ##+ p1 : mass
    ##+ p2 : mass
    ##v distance : distance of the two masses, as deviation from the peptide rule.
    ##r Wool A, Smilansky Z 2002. Precalibration of matrix-assisted laser desorption/ionization-time of flight spectra for peptide mass fingerprinting. {\em Proteomics.} 2(10):1365-73.
    ##r Wolski http://www.molgen.mpg.de/~wolski/mscalib
    x<-abs(p1-p2)
    mn <- x%%freq
    mnt <- mn
    mns <- mnt[mnt > 0.5]
    mn[mnt > 0.5] <- (1 - mns)
    return(mn)
  }


wsdist <- function(object,freq=1.000495,...)
  {
    ##t Wool Smilanski Distance Matrix
    ##- This function computes and returns the distance matrix
    ##- using the intra massvecotor distance  measure.
    ##+ object : matrix
    ##v dist : an object of class distance.
    ##sa wsFilter.massvector, wsiFilter.massvector,
    ##r Wool A, Smilansky Z 2002. Precalibration of matrix-assisted laser desorption/ionization-time of flight spectra for peptide mass fingerprinting. \emph{Proteomics.} 2(10):1365-73.
    ##r Wolski \url{http://www.molgen.mpg.de/~wolski/mscalib}
    ##e data(mv1)
    ##e plot(hclust(wsdist(mv1),method="single"))
    ret<-NULL
    pl<-object[,1,drop=TRUE]
    for(x in pl)
    {
      ret<-rbind(ret,distance(x,pl,freq=freq))
    }
    rownames(ret) <- formatC(pl,digits=2,format="f")
    colnames(ret) <- format(pl,digits=2,format="f")
    ret <- as.dist(ret)
    return(ret)
  }

wsiFilter <- function(object , mdist=0.25 , fraction = 0.2 , freq = 1.000495, ... )
  {
    ##t Smilanski Filtering
    ##- he function returns the inidces of masses identified as chemical noise.
    ##d Chemical noise can be removed from the peptide mass lists
    ##d due to the strong clustering of mono-isotopic peptide
    ##d peaks. Following the distance measure and filtering
    ##d method proposed by Wool Smilanski we developed an algorithm to
    ##d classify masses as peptide and non-peptide. The algorithm is based
    ##d on a modified distance measure and hierarchical clustering of all
    ##d intra massvector distances.
    ##+ object : massvector.
    ##+ mdist : minimal distance to branch to be prune. The unit of this distance are Daltons.
    ##+ fraction : maximal fraction (nr masses in branch)/(length of massvector) of branche  to be prune.
    ##+ ... : further arguments.
    ##v indices :  Indices of masses which are identified as being nonpeptide.
    ##r Wool A, Smilansky Z 2002. Precalibration of matrix-assisted laser desorption/ionization-time of flight spectra for peptide mass fingerprinting. \emph{Proteomics.} 2(10):1365-73.
    ##r Wolski
    ##sa wsFilter.massvector,wsdist.massvector, wsFilter.massvectorlist
    ##e data(mv1)
    ##e data(mv2)
    ##e length(mv1)
    ##e length(wsFilter(mv1))
    ##e length(mv2)
    ##e length(wsFilter(mv2))
    if(length(object)<2)
      return(NULL)
                                        #die function gibt die indices der contaminanten zurck.
                                        #der aufrufenden function bleibt berlassen was sie mit ihnen macht.
                                        #pl - peaklist
                                        #mdist - distance of the contaminant cluster.
                                        #fraction - the contaminant cluster shouldnt be greater than fraction.
    if(is.null(rownames(object)))
      {
        rownames(object)<-1:length(object)
      }
    hst <- hclust(wsdist(object,freq=freq),method="single")
    tmp <- which(hst$height > mdist)

    if(length(tmp)>0)
      {
         tmp<-cutree(hst,k=2)
                                        #count how big are the branches.
         c2<-sum(tmp==2)
         c1<-sum(tmp==1)
        # cat("c2",c2,"c1",c1,"\n")
         if(min(c(c2,c1))/(c1+c2)< fraction)
           {
             if(c2>c1)
               {
                 res<- as.numeric(rownames(object)[tmp==1])
                 res<-c( res , wsiFilter(object[tmp==2,] , mdist=mdist , fraction=fraction , freq=freq))
                 return(as.numeric(res))
               }else{
                 res<-as.numeric(rownames(object)[tmp==2])
                 res<-c(res , wsiFilter(object[tmp==1,] , mdist=mdist , fraction=fraction , freq=freq))
                 return(res)
               }
           }
      }
                                        # if no contaminations where found.
                                        #wenn keine contaminationen gefunden wruden.
    return(NULL)
  }


setMethod("wsFilter"
          ,signature(object="Massvector")
          ,def = function(object , mdist=0.25 , fraction=0.2 , peptides=TRUE, freq=1.000495 , ... )
          {

            tmp<-wsiFilter(object,mdist=mdist,fraction=fraction,freq=freq,...)
            if(peptides)
              {
                if(length(tmp)==0)
                  return(object)
                else
                  return(object[-tmp,])
              }
            else
              {
                return(object[tmp,])
              }
          }
          )
          
setMethod("wsFilter"
          ,signature(object="Massvectorlist")
          ,def = function(object , mdist=0.25 , fraction=0.2 , peptides=TRUE,freq=1.000495,... )
          {
            ##t Smilanski Filtering
            ##- Removes chemical noise from massvectors in the massvectorlist (if \code{peptides} argument \code{TRUE}) or returns it.
            ##d Chemical noise can be removed from the peptide mass lists
            ##d due to the strong clustering of mono-isotopic peptide
            ##d peaks. Following the distance measure and filtering
            ##d method proposed by Wool Smilanski we developed an algorithm to
            ##d classify masses as peptide and non-peptide. The algorithm is based
            ##d on a modified distance measure and hierarchical clustering of all
            ##d intra massvector distances.
            ##+ object : massvectorlist.
            ##+ mdist : Minimal distance to branch to prune. The unit of the distance is Dalton.
            ##+ fraction : Maximal fraction (nr masses in branch)/(length of massvector) of branche to be prune.
            ##+ peptides : logical; \code{TRUE} - returns peptides, \code{FALSE} - returns chemical noise.
            ##+ ... : further parameters.
            tmp<-lapply(object,wsFilter,mdist=mdist,fraction=fraction,peptides=peptides,freq=freq,...)
            as(object,"list")<-tmp
            object
          }
          )



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


massdist <- function(object)
  {
    ret<-NULL
    pl<-object[,1,drop=TRUE]
    for(i in 1:length(pl))
    {
      ret<-rbind(ret,abs(pl-pl[i]))
    }
    rownames(ret) <- formatC(pl,digits=2,format="f")
    colnames(ret) <- formatC(pl,digits=2,format="f")
    ret <- as.dist(ret)
    return(ret)
  }


massFilterI <- function(object
                        , massdist=500
                        , maxsize=6 # if greater than this value not any longer considered as outlier.
                        )
  {
    res <- NULL
    if(length(object)<2)
      return(NULL)
                                        #die function gibt die indices der contaminanten zurck.
                                        #der aufrufenden function bleibt berlassen was sie mit ihnen macht.
                                        #pl - peaklist
                                        #massdist - distance of the contaminant cluster.
                                        #fraction - the contaminant cluster shouldnt be greater than fraction.
    if(is.null(rownames(object)))
      {
        rownames(object)<-1:length(object)
      }
    hst <- hclust(massdist(object),method="single")
    
    tmp <- which(hst$height > massdist)
    
    if(length(tmp)>0)
      {
         tmp<-cutree(hst,k=2)
                                                 #count how big are the branches.
         c2<-sum(tmp==2)
         c1<-sum(tmp==1)
         #cat("c1", c1 , "c2" , c2 ,"\n")
                                        #cat("fraction : ",min(c(c2,c1))/max(c(c2,c1)),"\n")
         if(c2<=maxsize)
           {
             res<- as.numeric(rownames(object)[tmp==2])
           }
         else
           {
             res2 <- massFilterI(object[tmp==2,] , massdist=massdist , maxsize=maxsize)
             res<-c( res , res2)
           }
        
         if(c1<=maxsize)
           {
             res<- c(res,as.numeric(rownames(object)[tmp==1]))
           }
         else
           {
             res1 <- massFilterI(object[tmp==1,] , massdist=massdist , maxsize=maxsize)
             res<-c(res , res1)
           }
         return(as.numeric(res))
       }
                                        # if no contaminations where found.
                                        #wenn keine contaminationen gefunden wruden.
    return(NULL)
  }

setMethod("massFilter"
          ,signature(object="Massvector")
          ,def = function(object , massdist=500 , maxsize=4 , peptides=TRUE, ... )
          {

            tmp <- massFilterI(object , massdist=massdist , maxsize=maxsize , ...)
            if(peptides)
              {
                if(length(tmp)==0)
                  return(object)
                else
                  return(object[-tmp,])
              }
            else
              {
                return(object[tmp,])
              }
          }
          )
 
#if (!isGeneric("pepFilter"))
    setGeneric("pepFilter",
               function(object,...)
               standardGeneric("pepFilter")
               )

setMethod("pepFilter"
          ,signature(object="Massvector")
          ,def = function(object
             ,mdist=0.25
             ,fraction=0.2
             ,massdist=500
             ,maxsize = 2
             ,peptides=TRUE
             ,freq=1.000495
             , ... )
          {
            tmp <- wsiFilter(object,mdist=mdist,fraction=fraction,m=freq,...)
            tmp2 <- massFilterI(object,massdist=massdist,maxsize=maxsize,...)
            tmp <- setdiff(tmp,tmp2)
            if(peptides)
              {
                if(length(tmp)==0)
                  return(object)
                else
                  return(object[-tmp,])
              }
            else
              {
                return(object[tmp,])
              }
          }
          )
          
setMethod("pepFilter"
          ,signature(object="Massvectorlist")
          ,def = function(object
             ,mdist=0.25
             ,fraction=0.2
             ,massdist=500
             ,maxsize=2
             ,peptides=TRUE
             ,freq=1.000495
             ,... )
          {
            ##t Smilanski Filtering
            ##- Removes chemical noise from massvectors in the massvectorlist (if \code{peptides} argument \code{TRUE}) or returns it.
            ##d Chemical noise can be removed from the peptide mass lists
            ##d due to the strong clustering of mono-isotopic peptide
            ##d peaks. Following the distance measure and filtering
            ##d method proposed by Wool Smilanski we developed an algorithm to
            ##d classify masses as peptide and non-peptide. The algorithm is based
            ##d on a modified distance measure and hierarchical clustering of all
            ##d intra massvector distances.
            ##+ object : massvectorlist.
            ##+ mdist : Minimal distance to branch to prune. The unit of the distance is Dalton.
            ##+ fraction : Maximal fraction (nr masses in branch)/(length of massvector) of branche to be prune.
            ##+ peptides : logical; \code{TRUE} - returns peptides, \code{FALSE} - returns chemical noise.
            ##+ ... : further parameters.
            tmp<-lapply(object,pepFilter,mdist=mdist,fraction=fraction,massdist=massdist,maxsize=maxsize,peptides=peptides,...)
            as(object,"list")<-tmp
            object
          }
          )



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

##Computes all mass differences in and massvectorlist.
##In addition computes the ratio of the intensities for each pair.
##ra  -> wich range of differences are of interest.
setMethod("getdiff"
          ,signature(object="Massvectorlist")
          ,def=function(object,ra=c(0,100),...)
          {
            as(object,"list")<-lapply(object,getdiff,ra=ra,...)
            object
          }
          )

setMethod("getdiff"
          ,signature(object="Massvector")
          ,def=function(object,ra =c(0,100),...)
          {
                res <- NULL # mass differences
                rarea <- NULL # ratio area
                if(!length(object)>1)
                  {
                    res <- new("Massvector"
                               ,info=object@info
                               ,tcoor=object@tcoor
                               ,gelcoor=object@gelcoor
                               ,access=object@access
                               ,pionm=object@pionm)
                    return(res)
                  }
                else
                  {
                    m <- object[,1]
                    a <- object[,2]
                    for(x in 1:(length(m)-1))
                      {
                        diffpl <- m[(x+1):length(m)] - m[x]
                        ratarea <- log2(a[(x+1):length(m)] / a[x])
                        names(diffpl)<-NULL
                        names(ratarea)<-NULL
                        res <- c(res,diffpl[diffpl>ra[1] & diffpl<ra[2]])
                        rarea <- c(rarea,ratarea[diffpl>ra[1] & diffpl<ra[2]])
                      }
                    
                  }
                if(length(res)==0)
                  {
                    res <- new("Massvector"
                               ,info=object@info
                               ,tcoor=object@tcoor
                               ,gelcoor=object@gelcoor
                               ,access=object@access
                               ,pionm=object@pionm)
                    return(res)
                  }
                ord<-order( res )
                res<-cbind( res[ord] , rarea[ord] )
                rownames(res) <- 1:length(res[,1])
                colnames(res) <- c("massd","arear")
                res <- new("Massvector",res
                           ,info=object@info
                           ,tcoor=object@tcoor
                           ,gelcoor=object@gelcoor
                           ,access=object@access
                           ,pionm=object@pionm)
                return(res)
              }
          )


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



##rint - ratio intensity.
##
##oby are the upper and lower mass range
##rint are the uper and lower intensity ratio. 
##


##not shure if its really usefull.
setMethod("diffFilter"
          ,signature(obx="Massvectorlist",oby="Massvector")
          ,def = function(obx,oby,higher=TRUE,error=0.05,errorI=100,prune=TRUE,...)
          {
            as(obx,"list") <- lapply(obx,diffFilter,oby,higher=higher,error=error,errorI=errorI,prune=prune,...)
            obx
          }
          )

setMethod("diffFilter"
          ,signature(obx="Massvector",oby="Massvector")
          ,def = function(obx
             , oby
             , higher=TRUE
             , error=0.05
             , errorI= 100
             , uniq=TRUE
             , prune=TRUE
             , ...)
          {
            ##t Abundant Differences
            ##- Removes mass differences from the massvector.
            ##d Removes one of the masses contributing to a mass difference given in the list of differences.
            ##d Can be used if a variable modification are present in the massvector but can not be considered by the identification software. It also can be used to return the modified masses.
            ##+ obx : massvector
            ##+ oby : massvector with mass differences
            ##+ higher : logical;\code{TRUE} - remove higher mass, \code{FALSE} = remove lower mass.
            ##+ prune : logical;\code{TRUE} - remove mass, \code{FALSE} = return modified mass.
            ##+ error : How much the differences can diviate from the differences given in listofdiffs.
            ##+ ... : further parameters.
            ##+ errorI : intensity error.
            ##v massvector : filtered massvector.
            ##sa getdiff.massvector, getdiff.massvectorlist, diffFilter.massvectorlist
            ##r Wolski
            ##e data(mv1)
            ##e res<-getdiff(mv1,range=c(0,100))
            ##e diffFilter(mv1,res,higher=TRUE)
            ##e diffFilter(mv1,res,higher=FALSE)
            if(length(obx)<=1)
              {
                return(obx)
              }
            pl <- obx[,1]
            ar <- obx[,2]
            opl <- outer(pl,pl,"-")
            oar <- log2(outer(ar,ar,"/"))
            res <- NULL
            ldiff <- oby[,1,drop=TRUE] # get the difference masses.
            larea <- oby[,2,drop=TRUE] # get the ratios
            for(x in 1:length(ldiff))
              {
                rpl<-matrix(FALSE,nrow=length(pl),ncol=length(pl))
                rar<-matrix(FALSE,nrow=length(ar),ncol=length(ar))
                rpl[opl > (ldiff[x]-error) & opl < (ldiff[x]+error)] <- TRUE
                rar[oar > (larea[x]-errorI) & oar < (larea[x]+errorI)] <- TRUE
                rar <- rpl & rar
                rpl <- which(rar==TRUE,arr.ind=TRUE)
                if(higher)
                  res<-c(res,rpl[,1])
                else
                  res<-c(res,rpl[,2])
              }
            if(prune)
              {
                if(length(res)>0)
                  {
                    return(obx[-res,])
                  }
                else
                  return(obx)
              }
            else
              {
                if(length(res)>0)
                  return(obx[res,])
                else
                  return(obx[NULL,])
              }
          }
          )


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

#abline( h = c(0.5,1.5,2.5,3.5) )
#abline( h = seq(0,5,1), col = 2 )
            
setMethod("peproleFilter"
          ,signature(object = "Massvectorlist")
          ,def = function(object
             ,freq = 1.000495
             ,window = 0.3
             ,wchange = 1e-5
             ,peptide = TRUE
             ,ppm = TRUE
             ,...)
          {
            as(object,"list") <- lapply(object
                                        ,peproleFilter
                                        ,freq=freq
                                        ,window=window
                                        ,wchange=wchange
                                        ,peptide=peptide
                                        ,ppm=ppm
                                        )
            object
          }
          )

#########################################################
##   peptide - TRUE return peptide , FALSE NONPEPTIDE
#########################################################

setMethod("peproleFilter"
          , signature( object = "Massvector" )
          , def = function(
              object
              ,freq = 1.000495
              ,window = 0.3
              ,wchange = 1e-5
              ,peptide = TRUE
              ,ppm=TRUE
              , ...
              )
          {
            mass <- object[,1,drop=TRUE]
            mv2 <- distance(mass,0,freq=freq)
            tt <- cbind(mass,mv2)
            if(ppm)
              {
                tt[,2] <- (tt[,2]/tt[,1])*1e6
                sel <- which( (tt[,2] - (window +  wchange*tt[,2]))<0)
              }
            else
              {
                sel <- which( (abs(tt[,2]) - (window + wchange*tt[,2])) < 0 )
              }
            
            if(peptide)
              {
                if(length(sel)>0)
                  {
                    object <- object[sel,]
                  }
                else
                  {
                    object <- object[NULL,]
                  }
              }
            else
              {
                if(length(sel)>0)
                  {
                    object <- object[-sel,]
                  }
              }
            object
          }
          )
