aobjects.r

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

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

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

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

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

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


setClass("gausspr",representation(tol = "numeric",
                                  kernelf = "function",
                                  kpar = "list",
                                  kcall = "ANY",
                                  type = "character",
                                  kterms = "ANY",
                                  xmatrix = "matrix",
                                  ymatrix = "ANY",
                                  fit = "ANY",
                                  lev = "vector",
                                  nclass = "numeric",
                                  alpha = "ANY",
                                  alphaindex="list",
                                  nvar = "numeric",
                                  error = "numeric",
                                  cross = "numeric",
                                  n.action = "ANY"))


         
setMethod("kpar","gausspr", function(object) object@kpar)
setReplaceMethod("kpar","gausspr", function(x, value){
  x@kpar <- value
  x
})

setMethod("lev","gausspr", function(object) object@lev)
setReplaceMethod("lev","gausspr", function(x, value){
  x@lev <- value
  x
})

setMethod("type","gausspr", function(object) object@type)
setReplaceMethod("type","gausspr", function(x, value){
  x@type <- value
  x
})

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

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

setMethod("ymatrix","gausspr", function(object) object@ymatrix)
setReplaceMethod("ymatrix","gausspr", function(x, value){
  x@ymatrix <- value
  x
})

setMethod("nclass","gausspr", function(object) object@nclass)
setReplaceMethod("nclass","gausspr", function(x, value){
  x@nclass <- value
  x
})


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

setMethod("fit","gausspr", function(object) object@fit)
setReplaceMethod("fit","gausspr", function(x, value){
  x@fit <- value
  x
})

setMethod("error","gausspr", function(object) object@error)
setReplaceMethod("error","gausspr", function(x, value){
  x@error <- value
  x
})

setMethod("cross","gausspr", function(object) object@cross)
setReplaceMethod("cross","gausspr", function(x, value){
  x@cross <- value
  x
})

setMethod("alphaindex","gausspr", function(object) object@alphaindex)
setReplaceMethod("alphaindex","gausspr", function(x, value){
  x@alphaindex <- value
  x
})



setMethod("kterms","gausspr", function(object) object@kterms)
setReplaceMethod("kterms","gausspr", function(x, value){
  x@kterms <- value
  x
})

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

# Relevance Vector Machine object 
setClass("rvm", representation( 
                                tol = "numeric",
                                kernelf = "function",
                                kpar = "list",
                                kcall = "ANY",
                                type = "character",
                                kterms = "ANY",
                                xmatrix = "matrix",
                                ymatrix = "ANY",
                                fit = "ANY",
                                lev = "vector",
                                nclass = "numeric",
                                alpha = "ANY",
                                nvar = "numeric",
                                mlike = "numeric",
                                RVindex = "vector",
                                nRV = "numeric",
                                cross = "ANY",
                                error = "numeric",
                                n.action= "ANY"))


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


setMethod("type","rvm", function(object) object@type)
setReplaceMethod("type","rvm", function(x, value){
  x@type <- value
  x
})

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

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

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


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


setMethod("kpar","rvm", function(object) object@kpar)
setReplaceMethod("kpar","rvm", function(x, value){
  x@kpar <- value
  x
})

setMethod("lev","rvm", function(object) object@lev)
setReplaceMethod("lev","rvm", function(x, value){
  x@lev <- value
  x
})

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

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

setMethod("ymatrix","rvm", function(object) object@ymatrix)
setReplaceMethod("ymatrix","rvm", function(x, value){
  x@ymatrix <- value
  x
})

setMethod("nclass","rvm", function(object) object@nclass)
setReplaceMethod("nclass","rvm", function(x, value){
  x@nclass <- value
  x
})

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

setMethod("fit","rvm", function(object) object@fit)
setReplaceMethod("fit","rvm", function(x, value){
  x@fit <- value
  x
})

setMethod("kterms","rvm", function(object) object@kterms)
setReplaceMethod("kterms","rvm", function(x, value){
  x@kterms <- value
  x
})
                 

setMethod("alpha","rvm", function(object) object@alpha)
setReplaceMethod("alpha","rvm", function(x, value){
  x@alpha <- value
  x
})


setMethod("error","rvm", function(object) object@error)
setReplaceMethod("error","rvm", function(x, value){
  x@error <- value
  x
})

setMethod("cross","rvm", function(object) object@cross)
setReplaceMethod("cross","rvm", function(x, value){
  x@cross <- value
  x
})

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

setClass("inc.chol",representation("matrix",
 				    pivots="vector",
				    diag.residues="vector",
				    maxresiduals="vector"),
				    prototype=structure(.Data=matrix(),
				    pivots=vector(),
				    diag.residues=vector(), 
				    maxresiduals=vector()))


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

if(!isGeneric("diag.residues")){
if (is.function("diag.residues"))
  fun <- diag.residues
else fun <- function(object) standardGeneric("diag.residues")
setGeneric("diag.residues", fun)
}
setMethod("diag.residues", "inc.chol", function(object) [e-mail])
setGeneric("diag.residues<-", function(x,value) standardGeneric("diag.residues<-"))
setReplaceMethod("diag.residues", "inc.chol", function(x, value) {
  [e-mail] <- value
  x
})

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




setClass("specc",representation(
 				    cluster="vector",
				    centers="matrix",
                                    size="vector",
                                    kernelf="function"
                                    ))

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

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

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

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