Nothing
# Mexico Toolkit
#
# version : 0.01
# date : 30 nov 2009
# MAJ : 8 feb 2011
# licence : GPL
# Author(s) : Juhui WANG, 10 April, 2014
# repository: https://mulcyber.toulouse.inra.fr/projects/baomexico/
# Web : http://www.reseau-mexico.fr/
#=======================================================================
#' The mtkLevels class make.mtkFeature
#' @slot levelValue value of the parameter among character, double, integer, logical
#' @slot weight numeric optional wheighting (bounded between 0 to 1)
#' @exportClass mtkLevels vector
#===================================================================
# class Declaration
setClass(Class="mtkLevels",
representation=representation(
type = "character",
levels="vector",
weights="numeric"
),
prototype=prototype(type="categorical", levels=vector(), weights =numeric(0))
)
#===================================================================
#' The constructor method
#' @param levelValue a character, double, integer, or logical atomic object
#' @param weight a numeric value, default weight=1 means no weight
#' @return an object of class \code{\linkS4class{mtkLevel}}
#' @export mtkLevel
mtkLevels = function(type = "categorical", levels=vector(), weights=numeric(0))
{
l <- length(levels)
w <- length(weights)
if(w==0 && l> 0) weights <- rep(1/l,l)
if(w != 0 && w != l) stop("Every levels must be weighted!\n")
new(Class="mtkLevels", type=type, levels=levels, weights=weights)
}
###########################################################################
#' Gives a name to the type
#' @param this the underlying object of class \code{\linkS4class{mtkLevels}}
#' @param name a string indicating the processing step associated with this process.
#' @return invisble()
#' @exportMethod setName
#' @title The setType method
setMethod(f="setType", signature=c(this="mtkLevels", type="character"),
definition=function(this, type ) {
nameThis <- deparse(substitute(this))
this@type <- type
assign(nameThis, this, envir=parent.frame())
return(invisible())
})
###########################################################################
#' get the type
#' @param this the underlying object of class \code{\linkS4class{mtkLevels}}
#' @return a string indicating the processing step associated with this mtkLevels.
#' @exportMethod getType
#' @title The getType method
setMethod(f="getType", signature=c(this="mtkLevels"),
definition=function(this) {
return(this@type)
})
###########################################################################
#' Gives a new vector of levels
#' @param this the underlying object of class \code{\linkS4class{mtkLevels}}
#' @param name a string indicating the processing step associated with this process.
#' @return invisble()
#' @exportMethod setName
#' @title The setType method
setMethod(f="setLevels", signature=c(this="mtkLevels", levels="vector"),
definition=function(this, levels) {
nameThis <- deparse(substitute(this))
l <- length(levels)
w <- length(this@weights)
if(l != w) cat(" Warning: the numbers of 'levels' and 'weights' are not equal! \n Don't forget to modify the 'weights' too.\n" )
this@levels <- levels
assign(nameThis, this, envir=parent.frame())
return(invisible())
})
###########################################################################
#' get the levels
#' @param this the underlying object of class \code{\linkS4class{mtkLevels}}
#' @return a string indicating the processing step associated with this mtkLevels.
#' @exportMethod getLevels
#' @title The getLevels method
setMethod(f="getLevels", signature=c(this="mtkLevels"),
definition=function(this) {
return(this@levels)
})
###########################################################################
#' Gives a new vector of weights
#' @param this the underlying object of class \code{\linkS4class{mtkLevels}}
#' @param name a string indicating the processing step associated with this process.
#' @return invisble()
#' @exportMethod setName
#' @title The setType method
setMethod(f="setWeights", signature=c(this="mtkLevels", weights="numeric"),
definition=function(this, weights ) {
nameThis <- deparse(substitute(this))
l <- length(this@levels)
w <- length(weights)
if(l != w) stop(" The numbers of 'levels' and 'weights' are not equal! \n Modify first the 'levels' and then the 'weights'.\n" )
this@weights <- weights
assign(nameThis, this, envir=parent.frame())
return(invisible())
})
###########################################################################
#' get the weights
#' @param this the underlying object of class \code{\linkS4class{mtkLevels}}
#' @return a string indicating the processing step associated with this mtkLevels.
#' @exportMethod getWeights
#' @title The getweights method
setMethod(f="getWeights", signature=c(this="mtkLevels"),
definition=function(this) {
return(this@weights)
})
##########################################################################
## Juhui WANG le 28/08/2012
#' Prints the information managed by the class.
#' @param x the underlying object of class \code{\linkS4class{mtkLevels}}.
#' @return a summary of the data managed by the \code{\linkS4class{mtkLevels}}.
#' @exportMethod print
#' @title The print method
setMethod(f="print", signature=c(x="mtkLevels"), definition=function(x,...){
levels <- unlist(x@levels)
weights <- unlist(x@weights)
tmp <- data.frame(levels, weights)
if(length(levels)>0){
cat("type: ",x@type,"\n")
print(tmp,...)
}
return(invisible())
}
)
##########################################################################
## Juhui WANG le 28/08/2012
#' Prints the information managed by the class.
#' @param x the underlying object of class \code{\linkS4class{mtkLevels}}.
#' @return a summary of the data managed by the \code{\linkS4class{mtkLevels}}.
#' @exportMethod print
#' @title The print method
setMethod(f="summary", signature=c(object="mtkLevels"), definition=function(object,...){
cat("---------------------------------------------------------------------------\n")
cat(paste(" HERE IS A SUMMARY OF THE \"", object@name, "\": \n", sep=""))
show(object)
}
)
# Method definition
#' The mtkLevel show method
#' @param this the underlying object of class \code{\linkS4class{mtkLevel}}
#' @return invisible.
#' @exportMethod show
### return nothing but the write on the R console the content of the mtkLevel
setMethod(f="show",
signature=c("mtkLevels"),
definition=function(object) {
print(object)
})
## )
#===================================================================
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.