Nothing
#' @title Turn Various Objects to \linkS4class{fmx} Class
#'
#' @description
#'
#' Turn various objects created in other R packages
#' to \linkS4class{fmx} class.
#'
#' @param x an R object
#'
#' @param ... additional parameters, see **Arguments** in individual S3 dispatches
#'
#' @details
#' Various mixture distribution estimates obtained from other R packages
#' are converted to \linkS4class{fmx} class,
#' so that we could take advantage of all methods defined for \linkS4class{fmx} objects.
#'
#' @returns
#' S3 generic function [as.fmx] returns an \linkS4class{fmx} object.
#'
#' @export
as.fmx <- function(x, ...) UseMethod('as.fmx')
#' @export
as.fmx.fmx <- function(x, ...) x
#' @title Convert \link[fitdistrplus]{fitdist} Objects to \linkS4class{fmx} Class
#'
#' @description
#' To convert \link[fitdistrplus]{fitdist} objects (from package \CRANpkg{fitdistrplus})
#' to \linkS4class{fmx} class.
#'
#' @param x \link[fitdistrplus]{fitdist} object
#'
#' @param ... ..
#'
#' @returns
#' Function [as.fmx.fitdist] returns an \linkS4class{fmx} object.
#'
#' @examples
#' library(fitdistrplus)
#' # ?fitdist
#' data(endosulfan, package = 'fitdistrplus')
#' ATV <- subset(endosulfan, group == 'NonArthroInvert')$ATV
#' log10ATV <- log10(ATV)
#' fln <- fitdist(log10ATV, distr = 'norm')
#' (fln2 <- as.fmx(fln))
#' hist.default(log10ATV, freq = FALSE)
#' curve(dfmx(x, dist = fln2), xlim = range(log10ATV), add = TRUE)
#'
#' @method as.fmx fitdist
#' @export as.fmx.fitdist
#' @export
as.fmx.fitdist <- function(x, ...) {
if (!length(data <- x[['data']])) stop('Rerun ?fitdistrplus::fitdist with `keepdata = TRUE')
new(Class = 'fmx',
pars = matrix(x[['estimate']], nrow = 1L),
distname = x[['distname']],
data = data,
vcov = if (length(x[['vcov']])) x[['vcov']] else array(dim = c(0, 0)))
}
#' @title Convert `mixEM` Objects to \linkS4class{fmx} Class
#'
#' @description
#' To convert `mixEM` objects (from package \CRANpkg{mixtools})
#' to \linkS4class{fmx} class.
#'
#' Currently only the returned value of
#' \link[mixtools]{normalmixEM} and \link[mixtools]{gammamixEM} are supported
#'
#' @param x `mixEM` object
#'
#' @param data \link[base]{numeric} \link[base]{vector}
#'
#' @param ... ..
#'
#' @note
#' \link[mixtools]{plot.mixEM} not plot \link[mixtools]{gammamixEM} returns, as of 2022-09-19.
#'
#' @returns
#' Function [as.fmx.mixEM] returns an \linkS4class{fmx} object.
#'
#' @examples
#' library(mixtools)
#' (wait = as.fmx(normalmixEM(faithful$waiting, k = 2)))
#' hist.default(faithful$waiting, freq = FALSE)
#' curve(dfmx(x, dist = wait), xlim = range(faithful$waiting), add = TRUE)
#'
#' @method as.fmx mixEM
#' @export as.fmx.mixEM
#' @export
as.fmx.mixEM <- function(x, data = x[['x']], ...) {
if (!length(data)) stop('wont happen')
x <- sort.mixEM(x, decreasing = FALSE)
switch(x[['ft']], normalmixEM = {
pars <- cbind(mean = x[['mu']], sd = x[['sigma']])
distname <- 'norm'
}, gammamixEM = {
pars <- t.default(x[['gamma.pars']])
colnames(pars) <- c('shape', 'scale') # names of parameters of ?stats::dgamma
# read \link[mixtools]{gammamixEM} carefully: 'beta' is actually `scale`
distname <- 'gamma'
}, stop(x[['ft']], ' not supported yet'))
new(Class = 'fmx',
pars = pars, w = x[['lambda']], distname = distname,
data = data)
}
#' @title Convert `Skew.normal` Object to \linkS4class{fmx}
#'
#' @description
#' To convert `Skew.normal` object (from package \CRANpkg{mixsmsn})
#' to \linkS4class{fmx} class.
#'
#' @param x `'Skew.normal'` object,
#' returned from \link[mixsmsn]{smsn.mix} with parameter
#' `family = 'Skew.normal'`.
#'
#' @param data \link[base]{numeric} \link[base]{vector}
#'
#' @param ... additional parameters, currently not in use
#'
#' @note
#' \link[mixsmsn]{smsn.mix} does not offer a parameter to keep the input data, as of 2021-10-06.
#'
#' @returns
#' Function [as.fmx.Skew.normal] returns an \linkS4class{fmx} object.
#'
#' @examples
#' library(mixsmsn)
#' # ?smsn.mix
#' arg1 = c(mu = 5, sigma2 = 9, lambda = 5, nu = 5)
#' arg2 = c(mu = 20, sigma2 = 16, lambda = -3, nu = 5)
#' arg3 = c(mu = 35, sigma2 = 9, lambda = -6, nu = 5)
#' set.seed(120); x = rmix(n = 1e3L, p=c(.5, .2, .3), family = 'Skew.t',
#' arg = list(unname(arg1), unname(arg2), unname(arg3)))
#'
#' # Skew Normal
#' class(m1 <- smsn.mix(x, nu = 3, g = 3, family = 'Skew.normal', calc.im = FALSE))
#' mix.hist(y = x, model = m1)
#' m1a = as.fmx(m1, data = x)
#' (l1a = logLik(m1a))
#' hist(x, freq = FALSE)
#' curve(dfmx(x, dist = m1a), xlim = range(x), add = TRUE)
#'
#' @method as.fmx Skew.normal
#' @export as.fmx.Skew.normal
#' @export
as.fmx.Skew.normal <- function(x, data, ...) {
x <- sort.Skew.normal(x, decreasing = FALSE)
ret <- new(Class = 'fmx', pars = cbind(
xi = x[['mu']],
omega = sqrt(x[['sigma2']]),
alpha = x[['shape']]
),
w = x[['pii']],
distname = 'sn')
if (!missing(data)) {
if (!length(data) || !is.numeric(data) || anyNA(data)) stop('illegal `data`')
ret@data <- data
ret@Kolmogorov <- Kolmogorov_fmx(ret)
ret@CramerVonMises <- CramerVonMises_fmx(ret)
ret@KullbackLeibler <- KullbackLeibler_fmx(ret)
}
return(ret)
}
#' @title Convert `Normal` fit from \CRANpkg{mixsmsn} to \linkS4class{fmx}
#'
#' @description
#' To convert `Normal` object (from package \CRANpkg{mixsmsn})
#' to \linkS4class{fmx} class.
#'
#' @param x `'Normal'` object,
#' returned from \link[mixsmsn]{smsn.mix} with parameter
#' `family = 'Normal'`
#'
#' @param data \link[base]{numeric} \link[base]{vector}
#'
#' @param ... additional parameters, currently not in use
#'
#' @note
#' \link[mixsmsn]{smsn.mix} does not offer a parameter to keep the input data, as of 2021-10-06.
#'
#' @returns
#' Function [as.fmx.Normal] returns an \linkS4class{fmx} object.
#'
#' @examples
#' library(mixsmsn)
#' # ?smsn.mix
#' arg1 = c(mu = 5, sigma2 = 9, lambda = 5, nu = 5)
#' arg2 = c(mu = 20, sigma2 = 16, lambda = -3, nu = 5)
#' arg3 = c(mu = 35, sigma2 = 9, lambda = -6, nu = 5)
#' set.seed(120); x = rmix(n = 1e3L, p=c(.5, .2, .3), family = 'Skew.t',
#' arg = list(unname(arg1), unname(arg2), unname(arg3)))
#'
#' # Normal
#' class(m2 <- smsn.mix(x, nu = 3, g = 3, family = 'Normal', calc.im = FALSE))
#' mix.hist(y = x, model = m2)
#' m2a = as.fmx(m2, data = x)
#' hist(x, freq = FALSE)
#' curve(dfmx(x, dist = m2a), xlim = range(x), add = TRUE)
#'
#' @method as.fmx Normal
#' @export as.fmx.Normal
#' @export
as.fmx.Normal <- function(x, data, ...) {
x <- sort.Normal(x, decreasing = FALSE)
ret <- new(Class = 'fmx', pars = cbind(
mean = x[['mu']],
sd = sqrt(x[['sigma2']])
),
w = x[['pii']],
distname = 'norm')
if (!missing(data)) {
if (!length(data) || !is.numeric(data) || anyNA(data)) stop('illegal `data`')
ret@data <- data
ret@Kolmogorov <- Kolmogorov_fmx(ret)
ret@CramerVonMises <- CramerVonMises_fmx(ret)
ret@KullbackLeibler <- KullbackLeibler_fmx(ret)
}
return(ret)
}
#' @title Convert `Skew.t` fit from \CRANpkg{mixsmsn} to \linkS4class{fmx}
#'
#' @description
#' To convert `Skew.t` object (from package \CRANpkg{mixsmsn})
#' to \linkS4class{fmx} class.
#'
#' @param x `'Skew.t'` object,
#' returned from \link[mixsmsn]{smsn.mix} with parameter
#' `family = 'Skew.t'`
#'
#' @param data \link[base]{numeric} \link[base]{vector}
#'
#' @param ... additional parameters, currently not in use
#'
#' @note
#' \link[mixsmsn]{smsn.mix} does not offer a parameter to keep the input data, as of 2021-10-06.
#'
#' @returns
#' Function [as.fmx.Skew.t] returns an \linkS4class{fmx} object.
#'
#' @examples
#' \donttest{
#' # mixsmsn::smsn.mix with option `family = 'Skew.t'` is slow
#'
#' library(mixsmsn)
#' # ?smsn.mix
#' arg1 = c(mu = 5, sigma2 = 9, lambda = 5, nu = 5)
#' arg2 = c(mu = 20, sigma2 = 16, lambda = -3, nu = 5)
#' arg3 = c(mu = 35, sigma2 = 9, lambda = -6, nu = 5)
#' set.seed(120); x = rmix(n = 1e3L, p=c(.5, .2, .3), family = 'Skew.t',
#' arg = list(unname(arg1), unname(arg2), unname(arg3)))
#'
#' # Skew t
#' class(m3 <- smsn.mix(x, nu = 3, g = 3, family = 'Skew.t', calc.im = FALSE))
#' mix.hist(y = x, model = m3)
#' m3a = as.fmx(m3, data = x)
#' hist(x, freq = FALSE)
#' curve(dfmx(x, dist = m3a), xlim = range(x), add = TRUE)
#' (l3a = logLik(m3a))
#' stopifnot(all.equal.numeric(AIC(l3a), m3$aic), all.equal.numeric(BIC(l3a), m3$bic))
#' }
#'
#' @method as.fmx Skew.t
#' @export as.fmx.Skew.t
#' @export
as.fmx.Skew.t <- function(x, data, ...) {
x <- sort.Skew.t(x, decreasing = FALSE)
K <- length(x[['mu']]) # number of components
if (length(x[['nu']]) != 1L) stop('\\pkg{mixsmsn} update to enable multiple `nu`? Modify ?npar.fmx')
ret <- new(Class = 'fmx', pars = cbind(
xi = x[['mu']],
omega = sqrt(x[['sigma2']]),
alpha = x[['shape']],
nu = x[['nu']]
),
w = x[['pii']],
distname = 'st')
if (!missing(data)) {
if (!length(data) || !is.numeric(data) || anyNA(data)) stop('illegal `data`')
ret@data <- data
ret@Kolmogorov <- Kolmogorov_fmx(ret)
ret@CramerVonMises <- CramerVonMises_fmx(ret)
ret@KullbackLeibler <- KullbackLeibler_fmx(ret)
}
return(ret)
}
#' @title Convert `t` fit from \CRANpkg{mixsmsn} to \linkS4class{fmx}
#'
#' @description
#' To convert `t` object (from package \CRANpkg{mixsmsn})
#' to \linkS4class{fmx} class.
#'
#' @param x `'t'` object,
#' returned from \link[mixsmsn]{smsn.mix} with parameter
#' `family = 't'`
#'
#' @param data \link[base]{numeric} \link[base]{vector}
#'
#' @param ... additional parameters, currently not in use
#'
#' @note
#' \link[mixsmsn]{smsn.mix} does not offer a parameter to keep the input data, as of 2021-10-06.
#'
#' @returns
#' Function [as.fmx.t] has not been completed yet
#'
#' @examples
#'
#' library(mixsmsn)
#' # ?smsn.mix
#' arg1 = c(mu = 5, sigma2 = 9, lambda = 5, nu = 5)
#' arg2 = c(mu = 20, sigma2 = 16, lambda = -3, nu = 5)
#' arg3 = c(mu = 35, sigma2 = 9, lambda = -6, nu = 5)
#' set.seed(120); x = rmix(n = 1e3L, p=c(.5, .2, .3), family = 'Skew.t',
#' arg = list(unname(arg1), unname(arg2), unname(arg3)))
#'
#' # t
#' class(m4 <- smsn.mix(x, nu = 3, g = 3, family = 't', calc.im = FALSE))
#' mix.hist(y = x, model = m4)
#' # as.fmx(m4, data = x) # not ready yet!!
#'
#'
#' @method as.fmx t
#' @export
as.fmx.t <- function(x, data, ...) {
if (!length(data) || !is.numeric(data) || anyNA(data)) stop('illegal `data`')
x <- sort.t(x, decreasing = FALSE)
stop('need to programe scale_and_shift_t')
#new(Class = 'fmx', pars = cbind(
# mean = x[['mu']],
# sd = sqrt(x[['sigma2']])
#),
#w = x[['pii']],
#distname = 'norm',
#data = data)
}
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.