aobjects.r

这是核学习的一个基础软件包

#Support Vector Machine object 
setClass("ksvm", representation(type = "character",
                                param = "list",
                                kernelf = "function",
                                kpar = "list",
                                kcall = "ANY",
                                scaling = "ANY",
                                kterms = "ANY",
                                xmatrix = "matrix",
                                ymatrix = "ANY",
                                fit = "ANY",
                                lev = "vector",
                                nclass = "numeric",
                                alpha = "ANY",
                                coeff = "ANY",
                                alphaindex = "ANY",
                                b = "numeric",
                                SVindex = "vector",
                                nSV = "numeric",
                                error = "numeric",
                                cross = "numeric",
                                n.action= "ANY"))

# Create accessors for all class slots
# can this be done in a neater way ?

if(!isGeneric("type")){
  if (is.function("type"))
    fun <- type
  else fun <- function(object) standardGeneric("type")
  setGeneric("type", fun)
}
setMethod("type", "ksvm", function(object) object@type)
setGeneric("type<-", function(x, value) standardGeneric("type<-"))
setReplaceMethod("type", "ksvm", function(x, value) {
  x@type <- value
  x
})

if(!isGeneric("param")){
  if (is.function("param"))
    fun <- param
  else fun <- function(object) standardGeneric("param")
  setGeneric("param", fun)
}
setMethod("param", "ksvm", function(object) object@param)
setGeneric("param<-", function(x, value) standardGeneric("param<-"))
setReplaceMethod("param", "ksvm", function(x, value) {
  x@param <- value
  x
})

if(!isGeneric("kernelf")){
  if (is.function("kernelf"))
    fun <- kernelf
  else fun <- function(object) standardGeneric("kernelf")
  setGeneric("kernelf", fun)
}
setMethod("kernelf", "ksvm", function(object) object@kernelf)
setGeneric("kernelf<-", function(x, value) standardGeneric("kernelf<-"))
setReplaceMethod("kernelf", "ksvm", function(x, value) {
  x@kernelf <- value
  x
})

if(!isGeneric("kpar")){
  if (is.function("kpar"))
    fun <- kpar
  else fun <- function(object) standardGeneric("kpar")
  setGeneric("kpar", fun)
}
setMethod("kpar", "ksvm", function(object) object@kpar)
setGeneric("kpar<-", function(x, value) standardGeneric("kpar<-"))
setReplaceMethod("kpar", "ksvm", function(x, value) {
  x@kpar <- value
  x
})


if(!isGeneric("kcall")){
  if (is.function("kcall"))
    fun <- kcall
  else fun <- function(object) standardGeneric("kcall")
  setGeneric("kcall", fun)
}
setMethod("kcall", "ksvm", function(object) object@kcall)
setGeneric("kcall<-", function(x, value) standardGeneric("kcall<-"))
setReplaceMethod("kcall", "ksvm", function(x, value) {
  x@kcall <- value
  x
})

if(!isGeneric("scaling")){
  if (is.function("scaling"))
    fun <- scaling
  else fun <- function(object) standardGeneric("scaling")
  setGeneric("scaling", fun)
}
setMethod("scaling", "ksvm", function(object) object@scaling)
setGeneric("scaling<-", function(x, value) standardGeneric("scaling<-"))
setReplaceMethod("scaling", "ksvm", function(x, value) {
  x@scaling<- value
  x
})



if(!isGeneric("kterms")){
  if (is.function("kterms"))
    fun <- kterms
  else fun <- function(object) standardGeneric("kterms")
  setGeneric("kterms", fun)
}
setMethod("kterms", "ksvm", function(object) object@kterms)
setGeneric("kterms<-", function(x, value) standardGeneric("kterms<-"))
setReplaceMethod("kterms", "ksvm", function(x, value) {
  x@kterms <- value
  x
})

if(!isGeneric("xmatrix")){
  if (is.function("xmatrix"))
    fun <- xmatrix
  else fun <- function(object) standardGeneric("xmatrix")
  setGeneric("xmatrix", fun)
}
setMethod("xmatrix", "ksvm", function(object) object@xmatrix)
setGeneric("xmatrix<-", function(x, value) standardGeneric("xmatrix<-"))
setReplaceMethod("xmatrix", "ksvm", function(x, value) {
  x@xmatrix <- value
  x
})

if(!isGeneric("ymatrix")){
  if (is.function("ymatrix"))
    fun <- ymatrix
  else fun <- function(object) standardGeneric("ymatrix")
  setGeneric("ymatrix", fun)
}
setMethod("ymatrix", "ksvm", function(object) object@ymatrix)
setGeneric("ymatrix<-", function(x, value) standardGeneric("ymatrix<-"))
setReplaceMethod("ymatrix", "ksvm", function(x, value) {
  x@ymatrix <- value
  x
})

if(!isGeneric("fit")){
  if (is.function("fit"))
    fun <- fit
  else fun <- function(object) standardGeneric("fit")
  setGeneric("fit", fun)
}
setMethod("fit", "ksvm", function(object) object@fit)
setGeneric("fit<-", function(x, value) standardGeneric("fit<-"))
setReplaceMethod("fit", "ksvm", function(x, value) {
  x@fit <- value
  x
})

if(!isGeneric("lev")){
  if (is.function("lev"))
    fun <- lev
  else fun <- function(object) standardGeneric("lev")
  setGeneric("lev", fun)
}
setMethod("lev", "ksvm", function(object) object@lev)
setGeneric("lev<-", function(x, value) standardGeneric("lev<-"))
setReplaceMethod("lev", "ksvm", function(x, value) {
  x@lev <- value
  x
})

if(!isGeneric("nclass")){
  if (is.function("nclass"))
    fun <- nclass
  else fun <- function(object) standardGeneric("nclass")
  setGeneric("nclass", fun)
}
setMethod("nclass", "ksvm", function(object) object@nclass)
setGeneric("nclass<-", function(x, value) standardGeneric("nclass<-"))
setReplaceMethod("nclass", "ksvm", function(x, value) {
  x@nclass <- value
  x
})

if(!isGeneric("alpha")){
  if (is.function("alpha"))
    fun <- alpha
  else fun <- function(object) standardGeneric("alpha")
  setGeneric("alpha", fun)
}
setMethod("alpha", "ksvm", function(object) object@alpha)
setGeneric("alpha<-", function(x, value) standardGeneric("alpha<-"))
setReplaceMethod("alpha", "ksvm", function(x, value) {
  x@alpha <- value
  x
})

if(!isGeneric("coeff")){
  if (is.function("coeff"))
    fun <- coeff
  else fun <- function(object) standardGeneric("coeff")
  setGeneric("coeff", fun)
}
setMethod("coeff", "ksvm", function(object) object@coeff)
setGeneric("coeff<-", function(x, value) standardGeneric("coeff<-"))
setReplaceMethod("coeff", "ksvm", function(x, value) {
  x@coeff <- value
  x
})

if(!isGeneric("alphaindex")){
  if (is.function("alphaindex"))
    fun <- alphaindex
  else fun <- function(object) standardGeneric("alphaindex")
  setGeneric("alphaindex", fun)
}
setMethod("alphaindex", "ksvm", function(object) object@alphaindex)
setGeneric("alphaindex<-", function(x, value) standardGeneric("alphaindex<-"))
setReplaceMethod("alphaindex", "ksvm", function(x, value) {
  x@alphaindex <- value
  x
})

if(!isGeneric("b")){
  if (is.function("b"))
    fun <- b
  else fun <- function(object) standardGeneric("b")
  setGeneric("b", fun)
}
setMethod("b", "ksvm", function(object) object@b)
setGeneric("b<-", function(x, value) standardGeneric("b<-"))
setReplaceMethod("b", "ksvm", function(x, value) {
  x@b <- value
  x
})

if(!isGeneric("SVindex")){
  if (is.function("SVindex"))
    fun <- SVindex
  else fun <- function(object) standardGeneric("SVindex")
  setGeneric("SVindex", fun)
}
setMethod("SVindex", "ksvm", function(object) object@SVindex)
setGeneric("SVindex<-", function(x, value) standardGeneric("SVindex<-"))
setReplaceMethod("SVindex", "ksvm", function(x, value) {
  x@SVindex <- value
  x
})

if(!isGeneric("nSV")){
  if (is.function("nSV"))
    fun <- nSV
  else fun <- function(object) standardGeneric("nSV")
  setGeneric("nSV", fun)
}
setMethod("nSV", "ksvm", function(object) object@nSV)
setGeneric("nSV<-", function(x, value) standardGeneric("nSV<-"))
setReplaceMethod("nSV", "ksvm", function(x, value) {
  x@nSV <- value
  x
})

if(!isGeneric("error")){
  if (is.function("error"))
    fun <- error
  else fun <- function(object) standardGeneric("error")
  setGeneric("error", fun)
}
setMethod("error", "ksvm", function(object) object@error)
setGeneric("error<-", function(x, value) standardGeneric("error<-"))
setReplaceMethod("error", "ksvm", function(x, value) {
  x@error <- value
  x
})

if(!isGeneric("cross")){
  if (is.function("cross"))
    fun <- cross
  else fun <- function(object) standardGeneric("cross")
  setGeneric("cross", fun)
}
setMethod("cross", "ksvm", function(object) object@cross)
setGeneric("cross<-", function(x, value) standardGeneric("cross<-"))
setReplaceMethod("cross", "ksvm", function(x, value) {
  x@cross <- value
  x
})

if(!isGeneric("n.action")){
  if (is.function("n.action"))
    fun <- n.action
  else fun <- function(object) standardGeneric("n.action")
  setGeneric("n.action", fun)
}
setMethod("n.action", "ksvm", function(object) [e-mail])
setGeneric("n.action<-", function(x, value) standardGeneric("n.action<-"))
setReplaceMethod("n.action", "ksvm", function(x, value) {
  [e-mail] <- value
  x
})













## failed attempt to get rid of all this above


## mkaccesfun <- function(cls)
#{
#  snames <- slotNames(cls)
## 
#
#  for(i in 1:length(snames))
#    { resF <- paste("\"",snames[i],"\"",sep="")
#      if(!isGeneric(snames[i]))
#        eval(parse(file="",text=paste("setGeneric(",resF,",function(object)","standardGeneric(",resF,")",")",sep=" ")))   
#    setGeneric(snames[i], function(object) standardGeneric(snames[i]))
# 
#  setMethod(snames[i], cls, function(object)  eval(parse(file="",text=paste("object@",snames[i],sep=""))))
#  resG  <-  paste("\"",snames[i],"<-","\"",sep="")
#eval(parse(file="",text=paste("setGeneric(",resG,",function(x, value)","standardGeneric(",resG,")",")",sep=" ")))
#  setReplaceMethod(snames[i], cls, function(x, value) {
#    eval(parse(file="",text=paste("x@",snames[i],"<-value",sep="")))
#    x
#  })                   
#  }
#}


#kernel principal components object
setClass("kpca", representation(pcv = "matrix",
                                eig = "vector",
                                kernelf = "function",
                                kpar = "list",
                                rotated = "matrix",
                                xmatrix = "matrix",
                                kcall = "ANY",
                                n.action = "ANY"))
#accessor functions 
if(!isGeneric("pcv")){
  if (is.function("pcv"))
    fun <- pcv
  else fun <- function(object) standardGeneric("pcv")
  setGeneric("pcv", fun)
}
setMethod("pcv", "kpca", function(object) object@pcv)
setGeneric("pcv<-", function(x, value) standardGeneric("pcv<-"))
setReplaceMethod("pcv", "kpca", function(x, value) {
  x@pcv <- value
  x
})

if(!isGeneric("eig")){
  if (is.function("eig"))
    fun <- eig
  else fun <- function(object) standardGeneric("eig")
  setGeneric("eig", fun)
}
setMethod("eig", "kpca", function(object) object@eig)
setGeneric("eig<-", function(x, value) standardGeneric("eig<-"))
setReplaceMethod("eig", "kpca", function(x, value) {
  x@eig <- value
  x
})

if(!isGeneric("rotated")){
  if (is.function("rotated"))
    fun <- rotated
  else fun <- function(object) standardGeneric("rotated")
  setGeneric("rotated", fun)
}
setMethod("rotated", "kpca", function(object) object@rotated)
setGeneric("rotated<-", function(x, value) standardGeneric("rotated<-"))
setReplaceMethod("rotated", "kpca", function(x, value) {
  x@rotated <- value
  x
})



setMethod("kernelf","kpca", function(object) object@kernelf)
setReplaceMethod("kernelf","kpca", function(x, value){
  x@kernelf <- value
  x
})

setMethod("xmatrix","kpca", function(object) object@xmatrix)
setReplaceMethod("xmatrix","kpca", function(x, value){
  x@xmatrix <- value
  x
})

setMethod("kcall","kpca", function(object) object@kcall)
setReplaceMethod("kcall","kpca", function(x, value){
  x@kcall <- value
  x
})

setMethod("n.action","kpca", function(object) [e-mail])
setReplaceMethod("n.action","kpca", function(x, value){
  [e-mail] <- value
  x
})


setClass("ipop", representation(primal = "vector",
                                dual = "numeric",
                                how = "character"
                               ))

if(!isGeneric("primal")){
  if (is.function("primal"))
    fun <- primal
  else fun <- function(object) standardGeneric("primal")
  setGeneric("primal", fun)
}
setMethod("primal", "ipop", function(object) object@primal)
setGeneric("primal<-", function(x, value) standardGeneric("primal<-"))
setReplaceMethod("primal", "ipop", function(x, value) {
  x@primal <- value
  x
})

if(!isGeneric("dual")){
  if (is.function("dual"))
    fun <- dual
  else fun <- function(object) standardGeneric("dual")
  setGeneric("dual", fun)
}
setMethod("dual", "ipop", function(object) object@dual)
setGeneric("dual<-", function(x, value) standardGeneric("dual<-"))
setReplaceMethod("dual", "ipop", function(x, value) {
  x@dual <- value
  x
})

if(!isGeneric("how")){
  if (is.function("how"))
    fun <- how
  else fun <- function(object) standardGeneric("how")
  setGeneric("how", fun)
}
setMethod("how", "ipop", function(object) object@how)
setGeneric("how<-", function(x, value) standardGeneric("how<-"))
setReplaceMethod("how", "ipop", function(x, value) {
  x@how <- value
  x
})

# Kernel Canonical Correlation Analysis
setClass("kcca", representation(kcor = "vector",
                                xcoef = "matrix",
                                ycoef = "matrix",
                                xvar = "matrix",
                                yvar = "matrix"))