Nothing
##################################################################################
# MultinomialParameter.R ##
##################################################################################
#' @include global.R
#' @include Parameter.R
NULL
#' Constructor of [\code{\linkS4class{MultinomialParameter}}] class
#'
#' This class defines parameters of a Multinomial Mixture Model. Inherits the [\code{\linkS4class{Parameter}}] class.
#'
#' \describe{
#' \item{center}{a numeric vector containing center of each cluster.}
#' \item{scatter}{a vector of matrix containing dispersion matrix of each cluster.}
#' \item{factor}{a character vector containing the modalities.}
#' }
#'
#' @examples
#' new("MultinomialParameter")
#'
#' getSlots("MultinomialParameter")
#' @name MultinomialParameter-class
#' @rdname MultinomialParameter-class
#' @exportClass MultinomialParameter
#'
setClass(
Class = "MultinomialParameter",
representation = representation(
center = "numeric",
scatter = "numeric",
factor = "factor"
),
prototype = prototype(
center = numeric(0),
scatter = numeric(0),
factor = factor()
),
contains = c("Parameter")
)
#' @rdname print-methods
#' @aliases print print,MultinomialParameter-method
#'
setMethod(
f = "print",
signature = c("MultinomialParameter"),
function(x, ...) {
if (length(x@proportions) > 0) {
cat("****************************************\n")
cat("* number of modalities = ", x@factor, "\n")
for (i in seq_along(x@proportions)) {
cat("*** Cluster", i, "\n")
cat("* proportion = ", formatC(x@proportions[i], digits = 4, format = "f"), "\n")
cat("* center = ", formatC(x@center[i, ], digits = 4, format = "f"), "\n")
cat("* scatter = |", formatC(x@scatter[[i]][1, 1:x@factor[1]], digits = 4, width = 10, format = "f"), "|\n")
for (j in 2:nrow(x@scatter[[i]])) {
cat(" |", formatC(x@scatter[[i]][j, 1:x@factor[j]], digits = 4, width = 10, format = "f"), "|\n")
}
}
cat("****************************************\n")
}
}
)
#' @rdname show-methods
#' @aliases show show,MultinomialParameter-method
#'
setMethod(
f = "show",
signature = c("MultinomialParameter"),
function(object) {
if (length(object@proportions) > 0) {
cat("****************************************\n")
cat("* number of modalities = ", object@factor, "\n")
for (i in seq_along(object@proportions)) {
cat("*** Cluster", i, "\n")
cat("* proportion = ", formatC(object@proportions[i], digits = 4, format = "f"), "\n")
cat("* center = ", formatC(object@center[i, ], digits = 4, format = "f"), "\n")
if (length(object@scatter) > 1) {
if (length(dim(object@scatter)) == 2) {
cat("* scatter = ", formatC(object@scatter[i, ], digits = 4, format = "f"), "\n")
} else if (length(object@scatter[[i]]) > 1) {
if (nrow(object@scatter[[i]]) > 1) {
cat("* scatter = |", formatC(object@scatter[[i]][1, 1:object@factor[1]],
digits = 4, width = 10,
format = "f"
), "|\n")
for (j in 2:nrow(object@scatter[[i]])) {
cat(" |", formatC(object@scatter[[i]][j, 1:object@factor[j]],
digits = 4, width = 10,
format = "f"
), "|\n")
}
} else {
cat("* scatter = ", formatC(object@scatter[[i]], digits = 4, format = "f"), "\n")
}
} else {
cat("* scatter = ", formatC(object@scatter[i], digits = 4, format = "f"), "\n")
}
} else {
cat("* scatter = ", formatC(object@scatter, digits = 4, format = "f"), " \n")
}
}
cat("****************************************\n")
}
}
)
#' @rdname summary-methods
#' @aliases summary summary,MultinomialParameter-method
#'
setMethod(
f = "summary",
signature = c("MultinomialParameter"),
function(object, ...) {
if (length(object@proportions) > 0) {
for (k in seq_along(object@proportions)) {
cat("* Cluster ", k, ": \n")
cat(" Proportion = ", formatC(object@proportions[k], digits = 4, format = "f"), "\n")
cat(" Center = ", formatC(object@center[k, ], digits = 4, format = "f"), "\n")
if (length(object@scatter) > 1) {
if (length(dim(object@scatter)) == 2) {
cat(" Scatter = ", formatC(object@scatter[k, ], digits = 4, format = "f"), "\n")
} else if (length(object@scatter[[k]]) > 1) {
if (nrow(object@scatter[[k]]) > 1) {
cat(" Scatter = |", formatC(object@scatter[[k]][1, 1:object@factor[1]],
digits = 4,
width = 10, format = "f"
), "|\n")
for (j in 2:nrow(object@scatter[[k]])) {
cat(" |", formatC(object@scatter[[k]][j, 1:object@factor[j]],
digits = 4,
width = 10, format = "f"
), "|\n")
}
} else {
cat(" Scatter = ", formatC(object@scatter[[k]], digits = 4, format = "f"), "\n")
}
} else {
cat(" Scatter = ", formatC(object@scatter[k], digits = 4, format = "f"), "\n")
}
} else {
cat(" Scatter = ", formatC(object@scatter, digits = 4, format = "f"), " \n")
}
}
}
}
)
#' @rdname extract-methods
#' @aliases [,MultinomialParameter-method
#'
setMethod(
f = "[",
signature(x = "MultinomialParameter"),
definition = function(x, i, j, drop) {
if (missing(j)) {
switch(EXPR = i,
"proportions" = {
return(x@proportions)
},
"center" = {
return(x@center)
},
"scatter" = {
return(x@scatter)
},
stop("This attribute doesn't exist !")
)
} else {
switch(EXPR = i,
"proportions" = {
return(x@proportions[j])
},
"center" = {
return(x@center[j, ])
},
"scatter" = {
return(x@scatter[j])
},
stop("This attribute doesn't exist !")
)
}
}
)
# ' @name [
#' @rdname extract-methods
#' @aliases [<-,MultinomialParameter-method
#'
setReplaceMethod(
f = "[",
signature(x = "MultinomialParameter"),
definition = function(x, i, j, value) {
if (missing(j)) {
switch(EXPR = i,
"proportions" = {
x@proportions <- value
},
"center" = {
x@center <- value
},
"scatter" = {
x@scatter <- value
},
stop("This attribute doesn't exist !")
)
} else {
switch(EXPR = i,
"proportions" = {
x@proportions[j] <- value
},
"center" = {
x@center[j, ] <- value
},
"scatter" = {
x@scatter[j] <- value
},
stop("This attribute doesn't exist !")
)
}
validObject(x)
return(x)
}
)
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.