From f208924bc805884082cb88715f681e71a48f4f33 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Wed, 11 Aug 2021 11:42:50 +0200 Subject: [PATCH 01/24] Included nloptApi.h and CXX11 in the flags plus adapted the code to the nlopt library. Changed NAMESPACE and DESCRIPTION to include nloptr and nloptC.so respectively. --- DESCRIPTION | 4 ++-- NAMESPACE | 2 ++ src/Makevars | 11 +++++++---- src/ParStudmultFix.cc | 8 ++++---- src/algorithms.h | 4 ++-- src/mincol.h | 1 + src/optimize.h | 12 ++++++------ src/relabel_algorithms.cc | 37 +++++++++++++++++++++++-------------- 8 files changed, 47 insertions(+), 32 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 826a66f..a75a0e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,9 +9,9 @@ Description: More about what it does (maybe more than one line) License: GPL (>= 3) Depends: Rcpp (>= 0.10.2), RcppArmadillo (>= 0.3.6.2), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 2.23.10), dfoptim(>= 2011.8.1) -Imports: Rcpp (>= 0.11.4), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2) +Imports: Rcpp (>= 1.0.6), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2), nloptr(>= 1.2.2.2) Suggests: RUnit -LinkingTo: Rcpp, RcppArmadillo +LinkingTo: Rcpp, RcppArmadillo, nloptr Collate: AllGenerics.R graphic_func.R diff --git a/NAMESPACE b/NAMESPACE index 57cc3c6..65506d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,3 +1,5 @@ +import(nloptr) +useDynLib(nloptC) useDynLib(finmix) exportPattern("^[[:alpha:]]+") diff --git a/src/Makevars b/src/Makevars index 6ca68ff..c43fc71 100644 --- a/src/Makevars +++ b/src/Makevars @@ -1,13 +1,16 @@ ## Use the R_HOME indirection to support installations of multiple R version -NLOPT_VERSION = 2.3 +#NLOPT_VERSION = 2.3 -NLOPT_LIBS=-lnlopt -lm +#NLOPT_LIBS=-lnlopt -lm +CXX_STD = CXX11 #PKG_CPPFLAGS = ${NLOPT_INCL} -Winvalid-pch #PKG_CFLAGS = -pipe ${NLOPT_INCL} -PKG_LIBS = ${NLOPT_LIBS} +PKG_LIBS = $(SHLIB_OPENMP_CFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) +#${NLOPT_LIBS} -PKG_CXXFLAGS = -g `Rscript -e "Rcpp:::CxxFlags()"` +PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) +#-g `Rscript -e "Rcpp:::CxxFlags()"` ## As an alternative, one can also add this code in a file 'configure' ## ## PKG_LIBS=`${R_HOME}/bin/Rscript -e "Rcpp:::LdFlags()"` diff --git a/src/ParStudmultFix.cc b/src/ParStudmultFix.cc index a11efd7..3e02843 100644 --- a/src/ParStudmultFix.cc +++ b/src/ParStudmultFix.cc @@ -2,10 +2,10 @@ #include "distributions.h" ParStudmultFix::ParStudmultFix (const bool& STARTPAR, - const FinmixModel& model) : INDEPENDENT(true), - mu(model.K, model.r), sigma(model.r, model.r, model.K), - sigmainv(model.r, model.r, model.K), df(model.K), - acc(model.K) + const FinmixModel& model) : mu(model.K, model.r), + sigma(model.r, model.r, model.K), + sigmainv(model.r, model.r, model.K), df(model.K), + acc(model.K), INDEPENDENT(true) { acc.fill(0.0); if (model.par.size() > 0) { diff --git a/src/algorithms.h b/src/algorithms.h index d0d1238..7a530bc 100644 --- a/src/algorithms.h +++ b/src/algorithms.h @@ -20,8 +20,8 @@ inline double kulback_leibler(const arma::vec &values, const arma::vec &base) { - const unsigned int N = values.n_elem; - const unsigned int K = values.n_elem; + //const unsigned int N = values.n_elem; + //const unsigned int K = values.n_elem; double rvalue; rvalue = arma::sum(values % arma::log(values/base)); return rvalue; diff --git a/src/mincol.h b/src/mincol.h index f2018a7..9210d8a 100644 --- a/src/mincol.h +++ b/src/mincol.h @@ -15,6 +15,7 @@ #ifndef __FINMIX_MINCOL_H__ #define __FINMIX_MINCOL_H__ +// Matrix to column inline arma::vec mincol (const arma::mat& m) { diff --git a/src/optimize.h b/src/optimize.h index 230dec2..e293c36 100644 --- a/src/optimize.h +++ b/src/optimize.h @@ -45,14 +45,14 @@ * ------------------------------------------------------------ **/ inline -double obj_stephens1997a_poisson (const std::vector &x, - std::vector &grad, void *f_data) +double obj_stephens1997a_poisson (unsigned n, const double* x, + double* grad, void *f_data) { std::vector *arma_data = static_cast* >(f_data); const unsigned int M = (*arma_data)[0]->n_rows; const unsigned int K = (*arma_data)[0]->n_cols; arma::vec rvalues(M); - arma::vec arma_x(x); + arma::vec arma_x(*x); arma::vec dirich(&x[0], K); arma::vec shape(&x[0] + K, K); arma::vec rate(&x[0] + 2 * K, K); @@ -84,14 +84,14 @@ double obj_stephens1997a_poisson (const std::vector &x, * ------------------------------------------------------------ **/ inline -double obj_stephens1997a_binomial (const std::vector &x, - std::vector &grad, void *f_data) +double obj_stephens1997a_binomial (unsigned n, const double* x, + double* grad, void *f_data) { std::vector *arma_data = static_cast* >(f_data); const unsigned int M = (*arma_data)[0]->n_rows; const unsigned int K = (*arma_data)[0]->n_cols; arma::vec rvalues(M); - arma::vec arma_x(x); + arma::vec arma_x(*x); arma::vec dirich(&x[0], K); arma::vec shape1(&x[0] + K, K); arma::vec shape2(&x[0] + 2 * K, K); diff --git a/src/relabel_algorithms.cc b/src/relabel_algorithms.cc index 9eb3671..6f27de2 100644 --- a/src/relabel_algorithms.cc +++ b/src/relabel_algorithms.cc @@ -26,7 +26,7 @@ #include "algorithms.h" #include "optimize.h" #include "hungarian.h" -#include +#include // ============================================================ @@ -83,18 +83,22 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, row_index.at(m) = m; } /* Set up the optimizer */ - nlopt::opt optim(nlopt::LN_NELDERMEAD, n); + nlopt_opt optim; + optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); std::vector f_data(2); f_data[0] = λ f_data[1] = &weight; - optim.set_max_objective(obj_stephens1997a_poisson, &f_data); - optim.set_lower_bounds(1e-10); - optim.set_upper_bounds(1e+7); - std::vector opt_par = arma::conv_to >::from(pars); + double lower_bound[1] = {1e-10}; + double upper_bound[1] = {1e+7}; + nlopt_set_lower_bounds(optim, lower_bound); + nlopt_set_upper_bounds(optim, upper_bound); + nlopt_set_max_objective(optim, obj_stephens1997a_poisson, &f_data); + std::vector opt_par = arma::conv_to>::from(pars); + while (value != value_next) { value = value_next; - nlopt::result result = optim.optimize(opt_par, value_next); + nlopt_optimize(optim, &opt_par[0], &value_next); for (unsigned int k = 0; k < K; ++k) { dirich.at(k) = opt_par[k]; shape.at(k) = opt_par[k + K]; @@ -109,12 +113,13 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, for (unsigned int m = 0; m < M; ++m) { tmp2 = arma::conv_to::from(func_val.row(m)); col_index = arma::sort_index(tmp2, "descend"); - ind.row(m) = arma_perm.row(col_index(0)); + ind.row(m) = arma_perm.row(col_index(0)); } swapmat_by_index(lambda, ind); swapmat_by_index(weight, ind); swapumat_by_index(index, ind); } + nlopt_destroy(optim); index += 1; return arma::conv_to::from(index); } @@ -170,18 +175,21 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, row_index.at(m) = m; } /* Set up the optimizer */ - nlopt::opt optim(nlopt::LN_NELDERMEAD, n); + nlopt_opt optim; + optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); std::vector f_data(2); f_data[0] = &pp; f_data[1] = &weight; - optim.set_max_objective(obj_stephens1997a_binomial, &f_data); - optim.set_lower_bounds(1e-10); - optim.set_upper_bounds(1e+7); - std::vector opt_par = arma::conv_to >::from(pars); + double lower_bound[1] = {1e-10}; + double upper_bound[1] = {1e+7}; + nlopt_set_lower_bounds(optim, lower_bound); + nlopt_set_upper_bounds(optim, upper_bound); + nlopt_set_max_objective(optim, obj_stephens1997a_binomial, &f_data); + std::vector opt_par = arma::conv_to>::from(pars); while (value != value_next) { value = value_next; - nlopt::result result = optim.optimize(opt_par, value_next); + nlopt_optimize(optim, &opt_par[0], &value_next); for (unsigned int k = 0; k < K; ++k) { dirich.at(k) = opt_par[k]; shape1.at(k) = opt_par[k + K]; @@ -202,6 +210,7 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, swapmat_by_index(weight, ind); swapumat_by_index(index, ind); } + nlopt_destroy(optim); index += 1; return arma::conv_to::from(index); } From 463a6c0dfc428b5b885b40885ad27337b51e31ee Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Wed, 18 Aug 2021 19:51:40 +0200 Subject: [PATCH 02/24] Removed dynamic loading of NloptC, recompiled RcppExports and changed attributes to RcppExport for mcmc_binomial_cc and mcmc_normult_cc. Package installs and runs. --- DESCRIPTION | 4 ++-- NAMESPACE | 8 ++++---- R/RcppExports.R | 42 +++++++++++++++++------------------------- R/mcmcoutputbase.R | 2 +- R/mcmcoutputpermpost.R | 2 +- src/RcppExports.cpp | 37 +++++-------------------------------- src/attributes.cc | 1 + src/mcmc_binomial.cc | 3 +-- src/mcmc_normult.cc | 3 +-- src/mcmc_poisson.cc | 6 +----- 10 files changed, 34 insertions(+), 74 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a75a0e0..c90545b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,9 +9,9 @@ Description: More about what it does (maybe more than one line) License: GPL (>= 3) Depends: Rcpp (>= 0.10.2), RcppArmadillo (>= 0.3.6.2), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 2.23.10), dfoptim(>= 2011.8.1) -Imports: Rcpp (>= 1.0.6), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2), nloptr(>= 1.2.2.2) +Imports: Rcpp (>= 1.0.6), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2), nloptr (>= 1.2.0) Suggests: RUnit -LinkingTo: Rcpp, RcppArmadillo, nloptr +LinkingTo: Rcpp, RcppArmadillo, nloptr (>= 1.2.0) Collate: AllGenerics.R graphic_func.R diff --git a/NAMESPACE b/NAMESPACE index 65506d7..eda60b4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,8 @@ +useDynLib(finmix, .registration=TRUE) + import(nloptr) -useDynLib(nloptC) -useDynLib(finmix) -exportPattern("^[[:alpha:]]+") +importFrom("Rcpp", "sourceCpp") +#exportPattern("^[[:alpha:]]+") importFrom(graphics, barplot) importFrom(graphics, hist) @@ -10,7 +11,6 @@ importFrom(graphics, contour) importFrom(graphics, pairs) importFrom(KernSmooth, bkde2D) importFrom(dfoptim, nmkb) -importFrom(Rcpp, evalCpp) export( ## user-defined constructors "model", "modelmoments", diff --git a/R/RcppExports.R b/R/RcppExports.R index 689eac2..866367a 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -2,78 +2,70 @@ # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 swap_cc <- function(values, index) { - .Call('_finmix_swap_cc', PACKAGE = 'finmix', values, index) + .Call(`_finmix_swap_cc`, values, index) } swap_3d_cc <- function(values, index) { - .Call('_finmix_swap_3d_cc', PACKAGE = 'finmix', values, index) + .Call(`_finmix_swap_3d_cc`, values, index) } swapInteger_cc <- function(values, index) { - .Call('_finmix_swapInteger_cc', PACKAGE = 'finmix', values, index) + .Call(`_finmix_swapInteger_cc`, values, index) } swapInd_cc <- function(values, index) { - .Call('_finmix_swapInd_cc', PACKAGE = 'finmix', values, index) + .Call(`_finmix_swapInd_cc`, values, index) } swapST_cc <- function(values, index) { - .Call('_finmix_swapST_cc', PACKAGE = 'finmix', values, index) + .Call(`_finmix_swapST_cc`, values, index) } ldgamma_cc <- function(values, shape, rate) { - .Call('_finmix_ldgamma_cc', PACKAGE = 'finmix', values, shape, rate) + .Call(`_finmix_ldgamma_cc`, values, shape, rate) } dgamma_cc <- function(values, shape, rate) { - .Call('_finmix_dgamma_cc', PACKAGE = 'finmix', values, shape, rate) + .Call(`_finmix_dgamma_cc`, values, shape, rate) } lddirichlet_cc <- function(values, par) { - .Call('_finmix_lddirichlet_cc', PACKAGE = 'finmix', values, par) + .Call(`_finmix_lddirichlet_cc`, values, par) } ddirichlet_cc <- function(values, par) { - .Call('_finmix_ddirichlet_cc', PACKAGE = 'finmix', values, par) + .Call(`_finmix_ddirichlet_cc`, values, par) } hungarian_cc <- function(cost) { - .Call('_finmix_hungarian_cc', PACKAGE = 'finmix', cost) + .Call(`_finmix_hungarian_cc`, cost) } moments_cc <- function(classS4) { - .Call('_finmix_moments_cc', PACKAGE = 'finmix', classS4) + .Call(`_finmix_moments_cc`, classS4) } permmoments_cc <- function(classS4) { - .Call('_finmix_permmoments_cc', PACKAGE = 'finmix', classS4) -} - -mcmc_binomial_cc <- function(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { - .Call('_finmix_mcmc_binomial_cc', PACKAGE = 'finmix', fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) -} - -mcmc_normult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { - .Call('_finmix_mcmc_normult_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) + .Call(`_finmix_permmoments_cc`, classS4) } stephens1997a_poisson_cc <- function(values1, values2, pars, perm) { - .Call('_finmix_stephens1997a_poisson_cc', PACKAGE = 'finmix', values1, values2, pars, perm) + .Call(`_finmix_stephens1997a_poisson_cc`, values1, values2, pars, perm) } stephens1997a_binomial_cc <- function(values1, values2, pars, perm) { - .Call('_finmix_stephens1997a_binomial_cc', PACKAGE = 'finmix', values1, values2, pars, perm) + .Call(`_finmix_stephens1997a_binomial_cc`, values1, values2, pars, perm) } stephens1997b_poisson_cc <- function(values, comp_par, weight_par) { - .Call('_finmix_stephens1997b_poisson_cc', PACKAGE = 'finmix', values, comp_par, weight_par) + .Call(`_finmix_stephens1997b_poisson_cc`, values, comp_par, weight_par) } stephens1997b_binomial_cc <- function(values, reps, comp_par, weight_par) { - .Call('_finmix_stephens1997b_binomial_cc', PACKAGE = 'finmix', values, reps, comp_par, weight_par) + .Call(`_finmix_stephens1997b_binomial_cc`, values, reps, comp_par, weight_par) } stephens1997b_exponential_cc <- function(values, comp_par, weight_par) { - .Call('_finmix_stephens1997b_exponential_cc', PACKAGE = 'finmix', values, comp_par, weight_par) + .Call(`_finmix_stephens1997b_exponential_cc`, values, comp_par, weight_par) } diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index 881c1b5..fd64f6e 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -127,7 +127,7 @@ setMethod( "plotDens", signature( x = "mcmcoutputbase", } ) -setMethod("plotPointProc", signature(x = "mcmcoutputhier", +setMethod("plotPointProc", signature(x = "mcmcoutputbase", dev = "ANY"), function(x, dev = TRUE, ...) { diff --git a/R/mcmcoutputpermpost.R b/R/mcmcoutputpermpost.R index e93a8cc..9ee8939 100644 --- a/R/mcmcoutputpermpost.R +++ b/R/mcmcoutputpermpost.R @@ -144,7 +144,7 @@ setMethod( "plotTraces", signature( x = "mcmcoutputpermpost", } if ( lik %in% c( 1, 2 ) ) { ## log ## - .permtraces.Log.Base( x, dev, col ) + .permtraces.Log.Base( x, dev ) } } ) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index ce14394..c86a16e 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -6,6 +6,11 @@ using namespace Rcpp; +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); +#endif + // swap_cc Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index); RcppExport SEXP _finmix_swap_cc(SEXP valuesSEXP, SEXP indexSEXP) { @@ -149,36 +154,6 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// mcmc_binomial_cc -RcppExport SEXP mcmc_binomial_cc(SEXP fdata_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); -RcppExport SEXP _finmix_mcmc_binomial_cc(SEXP fdata_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type fdata_S4(fdata_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); - rcpp_result_gen = Rcpp::wrap(mcmc_binomial_cc(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); - return rcpp_result_gen; -END_RCPP -} -// mcmc_normult_cc -RcppExport SEXP mcmc_normult_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); -RcppExport SEXP _finmix_mcmc_normult_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); - Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); - rcpp_result_gen = Rcpp::wrap(mcmc_normult_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); - return rcpp_result_gen; -END_RCPP -} // stephens1997a_poisson_cc arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm); RcppExport SEXP _finmix_stephens1997a_poisson_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) { @@ -270,8 +245,6 @@ static const R_CallMethodDef CallEntries[] = { {"_finmix_hungarian_cc", (DL_FUNC) &_finmix_hungarian_cc, 1}, {"_finmix_moments_cc", (DL_FUNC) &_finmix_moments_cc, 1}, {"_finmix_permmoments_cc", (DL_FUNC) &_finmix_permmoments_cc, 1}, - {"_finmix_mcmc_binomial_cc", (DL_FUNC) &_finmix_mcmc_binomial_cc, 5}, - {"_finmix_mcmc_normult_cc", (DL_FUNC) &_finmix_mcmc_normult_cc, 5}, {"_finmix_stephens1997a_poisson_cc", (DL_FUNC) &_finmix_stephens1997a_poisson_cc, 4}, {"_finmix_stephens1997a_binomial_cc", (DL_FUNC) &_finmix_stephens1997a_binomial_cc, 4}, {"_finmix_stephens1997b_poisson_cc", (DL_FUNC) &_finmix_stephens1997b_poisson_cc, 3}, diff --git a/src/attributes.cc b/src/attributes.cc index 2dc4cc6..6c790c1 100644 --- a/src/attributes.cc +++ b/src/attributes.cc @@ -27,6 +27,7 @@ #include "hungarian.h" #include "mincol.h" #include "moments.h" + // [[Rcpp::export]] Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index) { diff --git a/src/mcmc_binomial.cc b/src/mcmc_binomial.cc index 55f1472..18fa16f 100644 --- a/src/mcmc_binomial.cc +++ b/src/mcmc_binomial.cc @@ -20,7 +20,6 @@ * along with finmix. If not, see . * ******************************************************************************/ - #include "FinmixData.h" #include "FinmixModel.h" #include "FinmixPrior.h" @@ -37,7 +36,7 @@ #include "ParOutBinomial.h" #include "PostOutBinomialInd.h" -//[[Rcpp::export]] + RcppExport SEXP mcmc_binomial_cc(SEXP fdata_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_normult.cc b/src/mcmc_normult.cc index 8dd4c6e..0f43c86 100644 --- a/src/mcmc_normult.cc +++ b/src/mcmc_normult.cc @@ -20,7 +20,6 @@ #include "LogNormultInd.h" #include "PostOutNormultInd.h" -//[[Rcpp::export]] RcppExport SEXP mcmc_normult_cc (SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { @@ -98,4 +97,4 @@ RcppExport SEXP mcmc_normult_cc (SEXP data_S4, SEXP model_S4, } return Rcpp::wrap(mcmcOutputS4O); } -#endif +#endif //__FINMIX_MCMC_BINOMIAL_CC__ diff --git a/src/mcmc_poisson.cc b/src/mcmc_poisson.cc index cda3175..4305868 100644 --- a/src/mcmc_poisson.cc +++ b/src/mcmc_poisson.cc @@ -20,9 +20,6 @@ * along with finmix. If not, see . * ******************************************************************************/ -#ifndef MCMCPOISSON_CC -#define MCMCPOISSON_CC - #include // C++ linear algebra library #include "FinmixData.h" #include "FinmixModel.h" @@ -130,5 +127,4 @@ RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, } return Rcpp::wrap(mcmcOutputS4O); -} -#endif +} \ No newline at end of file From ee3f376d8e7d72e6795d3bea6fd56928fd7ce1c8 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Thu, 19 Aug 2021 13:17:07 +0200 Subject: [PATCH 03/24] Changed all file endings from .cc to .cpp. Furthermore, changed the pointer in nlopt_optimize from std::vector to arma::vec.memptr() --- DESCRIPTION | 1 + src/Makevars | 8 -- src/Makevars.win | 5 +- src/{ParBinomialFix.cc => ParBinomialFix.cpp} | 0 src/{ParBinomialInd.cc => ParBinomialInd.cpp} | 0 ...ondPoissonFix.cc => ParCondPoissonFix.cpp} | 0 ...ondPoissonInd.cc => ParCondPoissonInd.cpp} | 0 ...xponentialFix.cc => ParExponentialFix.cpp} | 0 ...xponentialInd.cc => ParExponentialInd.cpp} | 0 src/{ParNormalFix.cc => ParNormalFix.cpp} | 0 src/{ParNormalInd.cc => ParNormalInd.cpp} | 0 src/{ParNormultFix.cc => ParNormultFix.cpp} | 0 src/{ParNormultInd.cc => ParNormultInd.cpp} | 0 src/{ParPoissonFix.cc => ParPoissonFix.cpp} | 0 src/{ParPoissonInd.cc => ParPoissonInd.cpp} | 0 src/{ParStudentFix.cc => ParStudentFix.cpp} | 0 src/{ParStudentInd.cc => ParStudentInd.cpp} | 0 src/{ParStudmultFix.cc => ParStudmultFix.cpp} | 0 src/{ParStudmultInd.cc => ParStudmultInd.cpp} | 0 ...iorBinomialFix.cc => PriorBinomialFix.cpp} | 0 ...iorBinomialInd.cc => PriorBinomialInd.cpp} | 0 ...dPoissonFix.cc => PriorCondPoissonFix.cpp} | 0 ...dPoissonInd.cc => PriorCondPoissonInd.cpp} | 0 ...onentialFix.cc => PriorExponentialFix.cpp} | 0 ...onentialInd.cc => PriorExponentialInd.cpp} | 0 src/{PriorNormalFix.cc => PriorNormalFix.cpp} | 0 src/{PriorNormalInd.cc => PriorNormalInd.cpp} | 0 ...PriorNormultFix.cc => PriorNormultFix.cpp} | 0 ...PriorNormultInd.cc => PriorNormultInd.cpp} | 0 ...PriorPoissonFix.cc => PriorPoissonFix.cpp} | 0 ...PriorPoissonInd.cc => PriorPoissonInd.cpp} | 0 ...PriorStudentFix.cc => PriorStudentFix.cpp} | 0 ...PriorStudentInd.cc => PriorStudentInd.cpp} | 0 ...iorStudmultFix.cc => PriorStudmultFix.cpp} | 0 ...iorStudmultInd.cc => PriorStudmultInd.cpp} | 0 src/{attributes.cc => attributes.cpp} | 0 src/{mcmc_binomial.cc => mcmc_binomial.cpp} | 0 ...mc_condpoisson.cc => mcmc_condpoisson.cpp} | 0 ...mc_exponential.cc => mcmc_exponential.cpp} | 0 src/{mcmc_normal.cc => mcmc_normal.cpp} | 0 src/{mcmc_normult.cc => mcmc_normult.cpp} | 0 src/mcmc_poisson.cc | 130 ------------------ src/mcmc_poisson.cpp | 130 ++++++++++++++++++ src/{mcmc_student.cc => mcmc_student.cpp} | 0 src/{mcmc_studmult.cc => mcmc_studmult.cpp} | 0 ...l_algorithms.cc => relabel_algorithms.cpp} | 19 ++- 46 files changed, 143 insertions(+), 150 deletions(-) rename src/{ParBinomialFix.cc => ParBinomialFix.cpp} (100%) rename src/{ParBinomialInd.cc => ParBinomialInd.cpp} (100%) rename src/{ParCondPoissonFix.cc => ParCondPoissonFix.cpp} (100%) rename src/{ParCondPoissonInd.cc => ParCondPoissonInd.cpp} (100%) rename src/{ParExponentialFix.cc => ParExponentialFix.cpp} (100%) rename src/{ParExponentialInd.cc => ParExponentialInd.cpp} (100%) rename src/{ParNormalFix.cc => ParNormalFix.cpp} (100%) rename src/{ParNormalInd.cc => ParNormalInd.cpp} (100%) rename src/{ParNormultFix.cc => ParNormultFix.cpp} (100%) rename src/{ParNormultInd.cc => ParNormultInd.cpp} (100%) rename src/{ParPoissonFix.cc => ParPoissonFix.cpp} (100%) rename src/{ParPoissonInd.cc => ParPoissonInd.cpp} (100%) rename src/{ParStudentFix.cc => ParStudentFix.cpp} (100%) rename src/{ParStudentInd.cc => ParStudentInd.cpp} (100%) rename src/{ParStudmultFix.cc => ParStudmultFix.cpp} (100%) rename src/{ParStudmultInd.cc => ParStudmultInd.cpp} (100%) rename src/{PriorBinomialFix.cc => PriorBinomialFix.cpp} (100%) rename src/{PriorBinomialInd.cc => PriorBinomialInd.cpp} (100%) rename src/{PriorCondPoissonFix.cc => PriorCondPoissonFix.cpp} (100%) rename src/{PriorCondPoissonInd.cc => PriorCondPoissonInd.cpp} (100%) rename src/{PriorExponentialFix.cc => PriorExponentialFix.cpp} (100%) rename src/{PriorExponentialInd.cc => PriorExponentialInd.cpp} (100%) rename src/{PriorNormalFix.cc => PriorNormalFix.cpp} (100%) rename src/{PriorNormalInd.cc => PriorNormalInd.cpp} (100%) rename src/{PriorNormultFix.cc => PriorNormultFix.cpp} (100%) rename src/{PriorNormultInd.cc => PriorNormultInd.cpp} (100%) rename src/{PriorPoissonFix.cc => PriorPoissonFix.cpp} (100%) rename src/{PriorPoissonInd.cc => PriorPoissonInd.cpp} (100%) rename src/{PriorStudentFix.cc => PriorStudentFix.cpp} (100%) rename src/{PriorStudentInd.cc => PriorStudentInd.cpp} (100%) rename src/{PriorStudmultFix.cc => PriorStudmultFix.cpp} (100%) rename src/{PriorStudmultInd.cc => PriorStudmultInd.cpp} (100%) rename src/{attributes.cc => attributes.cpp} (100%) rename src/{mcmc_binomial.cc => mcmc_binomial.cpp} (100%) rename src/{mcmc_condpoisson.cc => mcmc_condpoisson.cpp} (100%) rename src/{mcmc_exponential.cc => mcmc_exponential.cpp} (100%) rename src/{mcmc_normal.cc => mcmc_normal.cpp} (100%) rename src/{mcmc_normult.cc => mcmc_normult.cpp} (100%) delete mode 100644 src/mcmc_poisson.cc create mode 100644 src/mcmc_poisson.cpp rename src/{mcmc_student.cc => mcmc_student.cpp} (100%) rename src/{mcmc_studmult.cc => mcmc_studmult.cpp} (100%) rename src/{relabel_algorithms.cc => relabel_algorithms.cpp} (97%) diff --git a/DESCRIPTION b/DESCRIPTION index c90545b..70a4142 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,6 +7,7 @@ Author: Lars Simon Zehnder Maintainer: Lars Simon Zehnder Description: More about what it does (maybe more than one line) License: GPL (>= 3) +SystemRequirements: C++11 Depends: Rcpp (>= 0.10.2), RcppArmadillo (>= 0.3.6.2), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 2.23.10), dfoptim(>= 2011.8.1) Imports: Rcpp (>= 1.0.6), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2), nloptr (>= 1.2.0) diff --git a/src/Makevars b/src/Makevars index c43fc71..c963b54 100644 --- a/src/Makevars +++ b/src/Makevars @@ -1,16 +1,8 @@ ## Use the R_HOME indirection to support installations of multiple R version -#NLOPT_VERSION = 2.3 - -#NLOPT_LIBS=-lnlopt -lm - CXX_STD = CXX11 -#PKG_CPPFLAGS = ${NLOPT_INCL} -Winvalid-pch -#PKG_CFLAGS = -pipe ${NLOPT_INCL} PKG_LIBS = $(SHLIB_OPENMP_CFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -#${NLOPT_LIBS} PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -#-g `Rscript -e "Rcpp:::CxxFlags()"` ## As an alternative, one can also add this code in a file 'configure' ## ## PKG_LIBS=`${R_HOME}/bin/Rscript -e "Rcpp:::LdFlags()"` diff --git a/src/Makevars.win b/src/Makevars.win index 779bb79..9840f38 100644 --- a/src/Makevars.win +++ b/src/Makevars.win @@ -1,5 +1,8 @@ ## This assume that we can call Rscript to ask Rcpp about its locations ## Use the R_HOME indirection to support installations of multiple R version -PKG_LIBS = $(shell $(R_HOME)/bin/Rscript.exe -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) +CXX_STD = CXX11 +PKG_LIBS = $(SHLIB_OPENMP_CFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) + +PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) diff --git a/src/ParBinomialFix.cc b/src/ParBinomialFix.cpp similarity index 100% rename from src/ParBinomialFix.cc rename to src/ParBinomialFix.cpp diff --git a/src/ParBinomialInd.cc b/src/ParBinomialInd.cpp similarity index 100% rename from src/ParBinomialInd.cc rename to src/ParBinomialInd.cpp diff --git a/src/ParCondPoissonFix.cc b/src/ParCondPoissonFix.cpp similarity index 100% rename from src/ParCondPoissonFix.cc rename to src/ParCondPoissonFix.cpp diff --git a/src/ParCondPoissonInd.cc b/src/ParCondPoissonInd.cpp similarity index 100% rename from src/ParCondPoissonInd.cc rename to src/ParCondPoissonInd.cpp diff --git a/src/ParExponentialFix.cc b/src/ParExponentialFix.cpp similarity index 100% rename from src/ParExponentialFix.cc rename to src/ParExponentialFix.cpp diff --git a/src/ParExponentialInd.cc b/src/ParExponentialInd.cpp similarity index 100% rename from src/ParExponentialInd.cc rename to src/ParExponentialInd.cpp diff --git a/src/ParNormalFix.cc b/src/ParNormalFix.cpp similarity index 100% rename from src/ParNormalFix.cc rename to src/ParNormalFix.cpp diff --git a/src/ParNormalInd.cc b/src/ParNormalInd.cpp similarity index 100% rename from src/ParNormalInd.cc rename to src/ParNormalInd.cpp diff --git a/src/ParNormultFix.cc b/src/ParNormultFix.cpp similarity index 100% rename from src/ParNormultFix.cc rename to src/ParNormultFix.cpp diff --git a/src/ParNormultInd.cc b/src/ParNormultInd.cpp similarity index 100% rename from src/ParNormultInd.cc rename to src/ParNormultInd.cpp diff --git a/src/ParPoissonFix.cc b/src/ParPoissonFix.cpp similarity index 100% rename from src/ParPoissonFix.cc rename to src/ParPoissonFix.cpp diff --git a/src/ParPoissonInd.cc b/src/ParPoissonInd.cpp similarity index 100% rename from src/ParPoissonInd.cc rename to src/ParPoissonInd.cpp diff --git a/src/ParStudentFix.cc b/src/ParStudentFix.cpp similarity index 100% rename from src/ParStudentFix.cc rename to src/ParStudentFix.cpp diff --git a/src/ParStudentInd.cc b/src/ParStudentInd.cpp similarity index 100% rename from src/ParStudentInd.cc rename to src/ParStudentInd.cpp diff --git a/src/ParStudmultFix.cc b/src/ParStudmultFix.cpp similarity index 100% rename from src/ParStudmultFix.cc rename to src/ParStudmultFix.cpp diff --git a/src/ParStudmultInd.cc b/src/ParStudmultInd.cpp similarity index 100% rename from src/ParStudmultInd.cc rename to src/ParStudmultInd.cpp diff --git a/src/PriorBinomialFix.cc b/src/PriorBinomialFix.cpp similarity index 100% rename from src/PriorBinomialFix.cc rename to src/PriorBinomialFix.cpp diff --git a/src/PriorBinomialInd.cc b/src/PriorBinomialInd.cpp similarity index 100% rename from src/PriorBinomialInd.cc rename to src/PriorBinomialInd.cpp diff --git a/src/PriorCondPoissonFix.cc b/src/PriorCondPoissonFix.cpp similarity index 100% rename from src/PriorCondPoissonFix.cc rename to src/PriorCondPoissonFix.cpp diff --git a/src/PriorCondPoissonInd.cc b/src/PriorCondPoissonInd.cpp similarity index 100% rename from src/PriorCondPoissonInd.cc rename to src/PriorCondPoissonInd.cpp diff --git a/src/PriorExponentialFix.cc b/src/PriorExponentialFix.cpp similarity index 100% rename from src/PriorExponentialFix.cc rename to src/PriorExponentialFix.cpp diff --git a/src/PriorExponentialInd.cc b/src/PriorExponentialInd.cpp similarity index 100% rename from src/PriorExponentialInd.cc rename to src/PriorExponentialInd.cpp diff --git a/src/PriorNormalFix.cc b/src/PriorNormalFix.cpp similarity index 100% rename from src/PriorNormalFix.cc rename to src/PriorNormalFix.cpp diff --git a/src/PriorNormalInd.cc b/src/PriorNormalInd.cpp similarity index 100% rename from src/PriorNormalInd.cc rename to src/PriorNormalInd.cpp diff --git a/src/PriorNormultFix.cc b/src/PriorNormultFix.cpp similarity index 100% rename from src/PriorNormultFix.cc rename to src/PriorNormultFix.cpp diff --git a/src/PriorNormultInd.cc b/src/PriorNormultInd.cpp similarity index 100% rename from src/PriorNormultInd.cc rename to src/PriorNormultInd.cpp diff --git a/src/PriorPoissonFix.cc b/src/PriorPoissonFix.cpp similarity index 100% rename from src/PriorPoissonFix.cc rename to src/PriorPoissonFix.cpp diff --git a/src/PriorPoissonInd.cc b/src/PriorPoissonInd.cpp similarity index 100% rename from src/PriorPoissonInd.cc rename to src/PriorPoissonInd.cpp diff --git a/src/PriorStudentFix.cc b/src/PriorStudentFix.cpp similarity index 100% rename from src/PriorStudentFix.cc rename to src/PriorStudentFix.cpp diff --git a/src/PriorStudentInd.cc b/src/PriorStudentInd.cpp similarity index 100% rename from src/PriorStudentInd.cc rename to src/PriorStudentInd.cpp diff --git a/src/PriorStudmultFix.cc b/src/PriorStudmultFix.cpp similarity index 100% rename from src/PriorStudmultFix.cc rename to src/PriorStudmultFix.cpp diff --git a/src/PriorStudmultInd.cc b/src/PriorStudmultInd.cpp similarity index 100% rename from src/PriorStudmultInd.cc rename to src/PriorStudmultInd.cpp diff --git a/src/attributes.cc b/src/attributes.cpp similarity index 100% rename from src/attributes.cc rename to src/attributes.cpp diff --git a/src/mcmc_binomial.cc b/src/mcmc_binomial.cpp similarity index 100% rename from src/mcmc_binomial.cc rename to src/mcmc_binomial.cpp diff --git a/src/mcmc_condpoisson.cc b/src/mcmc_condpoisson.cpp similarity index 100% rename from src/mcmc_condpoisson.cc rename to src/mcmc_condpoisson.cpp diff --git a/src/mcmc_exponential.cc b/src/mcmc_exponential.cpp similarity index 100% rename from src/mcmc_exponential.cc rename to src/mcmc_exponential.cpp diff --git a/src/mcmc_normal.cc b/src/mcmc_normal.cpp similarity index 100% rename from src/mcmc_normal.cc rename to src/mcmc_normal.cpp diff --git a/src/mcmc_normult.cc b/src/mcmc_normult.cpp similarity index 100% rename from src/mcmc_normult.cc rename to src/mcmc_normult.cpp diff --git a/src/mcmc_poisson.cc b/src/mcmc_poisson.cc deleted file mode 100644 index 4305868..0000000 --- a/src/mcmc_poisson.cc +++ /dev/null @@ -1,130 +0,0 @@ -/****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ -#include // C++ linear algebra library -#include "FinmixData.h" -#include "FinmixModel.h" -#include "FinmixPrior.h" -#include "FinmixMCMC.h" -#include "BASE.h" -#include "ADAPTER.h" -#include "FIX.h" -#include "IND.h" -#include "HIER.h" -#include "POST.h" -#include "LogPoissonFix.h" -#include "LogPoissonInd.h" -#include "ParPoissonInd.h" -#include "ParOutPoisson.h" -#include "HierOutPoisson.h" -#include "PostOutPoissonFix.h" -#include "PostOutPoissonInd.h" - - -RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) -{ - - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; - - BASE* ptr; - typedef FIX POISSONFIX; - typedef IND > POISSONIND; - if (INDICFIX || K == 1) - { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutPoissonFix> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - - } - else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - } - else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } - else { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutPoissonInd> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - } - else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } - for(unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - - return Rcpp::wrap(mcmcOutputS4O); -} \ No newline at end of file diff --git a/src/mcmc_poisson.cpp b/src/mcmc_poisson.cpp new file mode 100644 index 0000000..6859859 --- /dev/null +++ b/src/mcmc_poisson.cpp @@ -0,0 +1,130 @@ +/****************************************************************************** + * + * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. + * + * Author: Lars Simon Zehnder + * + * This file is part of the R package finmix. + * + * finmix is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published + * by the Free Software Foundatio, either version 3 of the License, or + * any later version. + * + * finmix is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with finmix. If not, see . + * + ******************************************************************************/ +//#include // C++ linear algebra library +#include "FinmixData.h" +#include "FinmixModel.h" +#include "FinmixPrior.h" +#include "FinmixMCMC.h" +#include "BASE.h" +#include "ADAPTER.h" +#include "FIX.h" +#include "IND.h" +#include "HIER.h" +#include "POST.h" +#include "LogPoissonFix.h" +#include "LogPoissonInd.h" +#include "ParPoissonInd.h" +#include "ParOutPoisson.h" +#include "HierOutPoisson.h" +#include "PostOutPoissonFix.h" +#include "PostOutPoissonInd.h" + + +RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +{ + + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + + const bool INDICFIX = finModel.indicFix; + const bool HIER_IND = finPrior.hier; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; + + BASE* ptr; + typedef FIX POISSONFIX; + typedef IND > POISSONIND; + if (INDICFIX || K == 1) + { + if (HIER_IND) { + if (POST_IND) { + ptr = new ADAPTER, PostOutPoissonFix> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + + } + else { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + } + else { + if (POST_IND) { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + else { + if (HIER_IND) { + if (POST_IND) { + ptr = new ADAPTER, PostOutPoissonInd> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + } + else { + if (POST_IND) { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + for(unsigned int i = 0; i < BURNIN + M; ++i) { + ptr->update(); + ptr->store(i); + } + + return Rcpp::wrap(mcmcOutputS4O); +} \ No newline at end of file diff --git a/src/mcmc_student.cc b/src/mcmc_student.cpp similarity index 100% rename from src/mcmc_student.cc rename to src/mcmc_student.cpp diff --git a/src/mcmc_studmult.cc b/src/mcmc_studmult.cpp similarity index 100% rename from src/mcmc_studmult.cc rename to src/mcmc_studmult.cpp diff --git a/src/relabel_algorithms.cc b/src/relabel_algorithms.cpp similarity index 97% rename from src/relabel_algorithms.cc rename to src/relabel_algorithms.cpp index 6f27de2..be87b4f 100644 --- a/src/relabel_algorithms.cc +++ b/src/relabel_algorithms.cpp @@ -93,16 +93,14 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, nlopt_set_lower_bounds(optim, lower_bound); nlopt_set_upper_bounds(optim, upper_bound); nlopt_set_max_objective(optim, obj_stephens1997a_poisson, &f_data); - std::vector opt_par = arma::conv_to>::from(pars); - while (value != value_next) { value = value_next; - nlopt_optimize(optim, &opt_par[0], &value_next); + nlopt_optimize(optim, pars.memptr(), &value_next); for (unsigned int k = 0; k < K; ++k) { - dirich.at(k) = opt_par[k]; - shape.at(k) = opt_par[k + K]; - rate.at(k) = opt_par[k + 2 * K]; + dirich.at(k) = pars[k]; + shape.at(k) = pars[k + K]; + rate.at(k) = pars[k + 2 * K]; } /* Loop over permutations */ for (unsigned int p = 0; p < P; ++p) { @@ -185,15 +183,14 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, nlopt_set_lower_bounds(optim, lower_bound); nlopt_set_upper_bounds(optim, upper_bound); nlopt_set_max_objective(optim, obj_stephens1997a_binomial, &f_data); - std::vector opt_par = arma::conv_to>::from(pars); while (value != value_next) { value = value_next; - nlopt_optimize(optim, &opt_par[0], &value_next); + nlopt_optimize(optim, pars.memptr(), &value_next); for (unsigned int k = 0; k < K; ++k) { - dirich.at(k) = opt_par[k]; - shape1.at(k) = opt_par[k + K]; - shape2.at(k) = opt_par[k + 2 * K]; + dirich.at(k) = pars[k]; + shape1.at(k) = pars[k + K]; + shape2.at(k) = pars[k + 2 * K]; } /* Loop over permutations */ for (unsigned int p = 0; p < P; ++p) { From 68e53942e78a5882faed16360486c9eaebb6b2a8 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Wed, 1 Sep 2021 09:12:41 +0200 Subject: [PATCH 04/24] Made a longer check on the relabeling algorithms of Stephens1997b and Stephens1997a with Poisson and Binomial distributions. Removed many unused variables and hcnaged order in constructors. --- R/RcppExports.R | 4 ++-- R/mcmcestimate.R | 19 ++++++++++++---- R/mcmcoutputbase.R | 2 +- R/mcmcpermute.R | 17 +++++++++----- src/ParNormultFix.cpp | 6 ++--- src/ParOutNormult.h | 2 +- src/ParOutStudmult.h | 2 +- src/RcppExports.cpp | 9 ++++---- src/algorithms.h | 12 ++++++++-- src/attributes.cpp | 2 +- src/hungarian.h | 4 ++-- src/mcmc_condpoisson.cpp | 15 ++++++------- src/mcmc_exponential.cpp | 17 +++++++------- src/mcmc_poisson.cpp | 10 ++++----- src/moments.h | 4 ---- src/optimize.h | 14 ++++++++---- src/prior_likelihood.h | 1 - src/relabel_algorithms.cpp | 45 ++++++++++++++++++-------------------- src/rtruncnorm.h | 2 +- 19 files changed, 104 insertions(+), 83 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 866367a..e954ab9 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -57,8 +57,8 @@ stephens1997a_binomial_cc <- function(values1, values2, pars, perm) { .Call(`_finmix_stephens1997a_binomial_cc`, values1, values2, pars, perm) } -stephens1997b_poisson_cc <- function(values, comp_par, weight_par) { - .Call(`_finmix_stephens1997b_poisson_cc`, values, comp_par, weight_par) +stephens1997b_poisson_cc <- function(values, comp_par, weight_par, max_iter = 200L) { + .Call(`_finmix_stephens1997b_poisson_cc`, values, comp_par, weight_par, max_iter) } stephens1997b_binomial_cc <- function(values, reps, comp_par, weight_par) { diff --git a/R/mcmcestimate.R b/R/mcmcestimate.R index 23b3969..4246691 100644 --- a/R/mcmcestimate.R +++ b/R/mcmcestimate.R @@ -16,9 +16,9 @@ # along with finmix. If not, see . "mcmcestimate" <- function(mcmcout, method = "kmeans", fdata = NULL, - permOut = FALSE) { + permOut = FALSE, opt_ctrl=list(max_iter=200L)) { ## Check input ## - .check.args.Mcmcestimate(mcmcout, method, fdata, permOut) + .check.args.Mcmcestimate(mcmcout, method, fdata, permOut, opt_ctrl) ## Constants K <- mcmcout@model@K M <- mcmcout@M @@ -84,7 +84,7 @@ } } else { ## Use function 'mcmcpermute' to permute the sample - mcmcoutperm <- mcmcpermute( mcmcout, method = method, fdata = fdata ) + mcmcoutperm <- mcmcpermute( mcmcout, method = method, fdata = fdata, opt_ctrl=opt_ctrl ) perm <- TRUE if ( mcmcoutperm@Mperm > 0 ) { ## Use ergodic average function on 'mcmcoutputperm' @@ -148,7 +148,7 @@ ### of three permutation algorithms in 'mcmcpermute()'. ### Argument 3 must be of type logical. If any case is not true ### an error is thrown. -".check.args.Mcmcestimate" <- function( obj, arg2, arg3, arg4 ) +".check.args.Mcmcestimate" <- function( obj, arg2, arg3, arg4, arg5 ) { if ( !inherits( obj, c( "mcmcoutput", "mcmcoutputperm" ) ) ) { stop( paste( "Wrong argument: Argument 1 must be an object ", @@ -163,6 +163,17 @@ if ( !is.logical( arg4 ) ) { stop( "Wrong argument: Argument 4 must be of type 'logical'." ) } + if (length(arg5) != 0){ + if("max_iter" %in% names(arg5)) { + if(!is.numeric(arg5$max_iter)) { + stop(paste0("Wrong argument: In argument 5 'max_iter' ", + "has to be of type integer.")) + } + } else { + stop(paste0("Wrong argument: Argument 5 must contain a variable ", + "'max_iter' of type integer.")) + } + } } ".map.Mcmcestimate" <- function( obj ) { diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index fd64f6e..a13514a 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -366,7 +366,7 @@ setMethod("getClust", "mcmcoutputbase", ### @see ?plotTraces, ?rainbow, ?gray.colors ### @author Lars Simon Zehnder ### ------------------------------------------------------------------ -".traces.Log.Base" <- function( x, dev, col ) +".traces.Log.Base" <- function( x, dev, col=FALSE ) { if ( .check.grDevice() && dev ) { dev.new( title = "Log Likelihood Traceplots" ) diff --git a/R/mcmcpermute.R b/R/mcmcpermute.R index 65089c3..6bb3ae3 100644 --- a/R/mcmcpermute.R +++ b/R/mcmcpermute.R @@ -15,17 +15,22 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -"mcmcpermute" <- function( mcmcout, fdata = NULL, method = "kmeans" ) { +"mcmcpermute" <- function( mcmcout, fdata = NULL, method = "kmeans", opt_ctrl=list(max_iter=200L) ) { ## Check arguments ## .check.arg.Mcmcpermute( mcmcout ) match.arg( method, c( "kmeans", "Stephens1997a", "Stephens1997b" ) ) + if (!is.numeric(opt_ctrl$max_iter)) { + stop("Max. iterations 'max_iter' in list 'opt_ctrl' needs to be of type integer.") + } else { + opt_ctrl$max_iter <- as.integer(opt_ctrl$max_iter) + } mcmcout <- .coerce.Mcmcpermute( mcmcout ) if ( method == "kmeans" ) { .kmeans.Mcmcpermute(mcmcout) } else if ( method == "Stephens1997a" ) { .stephens1997a.Mcmcpermute( mcmcout ) } else { - .stephens1997b.Mcmcpermute( mcmcout, fdata ) + .stephens1997b.Mcmcpermute( mcmcout, fdata, opt_ctrl$max_iter ) } } @@ -260,12 +265,12 @@ ### if it is valid in regard to the 'model' object carried ### by the 'mcmcoutput' object. ### If no permutation is possible, a warning is thrown. -".stephens1997b.Mcmcpermute" <- function( obj, fdata.obj ) +".stephens1997b.Mcmcpermute" <- function( obj, fdata.obj, max_iter=200L ) { .check.fdata.model.Mcmcstart( fdata.obj, obj@model ) dist <- obj@model@dist if ( dist == "poisson" ) { - index <- .stephens1997b.poisson.Mcmcpermute( obj, fdata.obj ) + index <- .stephens1997b.poisson.Mcmcpermute( obj, fdata.obj, max_iter=max_iter ) } else if ( dist == "binomial" ) { index <- .stephens1997b.binomial.Mcmcpermute( obj, fdata.obj ) } else if ( dist == "exponential" ) { @@ -282,10 +287,10 @@ } } -".stephens1997b.poisson.Mcmcpermute" <- function( obj, fdata.obj ) +".stephens1997b.poisson.Mcmcpermute" <- function( obj, fdata.obj, max_iter=200L ) { stephens1997b_poisson_cc( fdata.obj@y, obj@par$lambda, - obj@weight ) + obj@weight, max_iter=max_iter ) } ".stephens1997b.binomial.Mcmcpermute" <- function( obj, fdata.obj ) diff --git a/src/ParNormultFix.cpp b/src/ParNormultFix.cpp index eb6c23e..4cddf0f 100644 --- a/src/ParNormultFix.cpp +++ b/src/ParNormultFix.cpp @@ -2,9 +2,9 @@ #include "distributions.h" ParNormultFix::ParNormultFix (const bool& STARTPAR, - const FinmixModel& model) : INDEPENDENT(true), - mu(model.K, model.r), sigma(model.r, model.r, model.K), - sigmainv(model.r, model.r, model.K) + const FinmixModel& model) : mu(model.K, model.r), + sigma(model.r, model.r, model.K), sigmainv(model.r, model.r, model.K), + INDEPENDENT(true) { if (model.par.size() > 0) { mu = Rcpp::as(model.par["mu"]); diff --git a/src/ParOutNormult.h b/src/ParOutNormult.h index 2e6ffe6..b111156 100644 --- a/src/ParOutNormult.h +++ b/src/ParOutNormult.h @@ -36,7 +36,7 @@ class ParOutNormult { }; ParOutNormult::ParOutNormult (const Rcpp::List& list) : - STOREINV(false), M(0), r(0), s(0), K(0) + M(0), r(0), s(0), K(0), STOREINV(false) { STOREINV = Rcpp::as(list["storeinv"]); /* mu is an (M x r x K) array */ diff --git a/src/ParOutStudmult.h b/src/ParOutStudmult.h index 3055aa2..c386c4b 100644 --- a/src/ParOutStudmult.h +++ b/src/ParOutStudmult.h @@ -38,7 +38,7 @@ class ParOutStudmult { }; ParOutStudmult::ParOutStudmult (const Rcpp::List& list) : - STOREINV(false), M(0), r(0), s(0), K(0) + M(0), r(0), s(0), K(0),STOREINV(false) { STOREINV = Rcpp::as(list["storeinv"]); /* mu is an (M x r x K) array */ diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index c86a16e..f61a439 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -183,15 +183,16 @@ BEGIN_RCPP END_RCPP } // stephens1997b_poisson_cc -arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par); -RcppExport SEXP _finmix_stephens1997b_poisson_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) { +arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par, signed int max_iter); +RcppExport SEXP _finmix_stephens1997b_poisson_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP, SEXP max_iterSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - rcpp_result_gen = Rcpp::wrap(stephens1997b_poisson_cc(values, comp_par, weight_par)); + Rcpp::traits::input_parameter< signed int >::type max_iter(max_iterSEXP); + rcpp_result_gen = Rcpp::wrap(stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter)); return rcpp_result_gen; END_RCPP } @@ -247,7 +248,7 @@ static const R_CallMethodDef CallEntries[] = { {"_finmix_permmoments_cc", (DL_FUNC) &_finmix_permmoments_cc, 1}, {"_finmix_stephens1997a_poisson_cc", (DL_FUNC) &_finmix_stephens1997a_poisson_cc, 4}, {"_finmix_stephens1997a_binomial_cc", (DL_FUNC) &_finmix_stephens1997a_binomial_cc, 4}, - {"_finmix_stephens1997b_poisson_cc", (DL_FUNC) &_finmix_stephens1997b_poisson_cc, 3}, + {"_finmix_stephens1997b_poisson_cc", (DL_FUNC) &_finmix_stephens1997b_poisson_cc, 4}, {"_finmix_stephens1997b_binomial_cc", (DL_FUNC) &_finmix_stephens1997b_binomial_cc, 4}, {"_finmix_stephens1997b_exponential_cc", (DL_FUNC) &_finmix_stephens1997b_exponential_cc, 3}, {"mcmc_binomial_cc", (DL_FUNC) &mcmc_binomial_cc, 5}, diff --git a/src/algorithms.h b/src/algorithms.h index 7a530bc..7539270 100644 --- a/src/algorithms.h +++ b/src/algorithms.h @@ -20,10 +20,18 @@ inline double kulback_leibler(const arma::vec &values, const arma::vec &base) { - //const unsigned int N = values.n_elem; + const unsigned int N = values.n_elem; //const unsigned int K = values.n_elem; double rvalue; - rvalue = arma::sum(values % arma::log(values/base)); + if (arma::any(values == 0.0) || arma::any(base == 0.0)) { + arma::vec values_smoothed = (values * N + 1.0) / (N + 1.0); + arma::vec base_smoothed = (base * N + 1.0) / (N + 1.0); + rvalue = arma::sum(values_smoothed % arma::log(values_smoothed/base_smoothed)); + } else { + rvalue = arma::sum(values % arma::log(values/base)); + } + + //Rcpp::Rcout << "kullback: " << rvalue << std::endl; return rvalue; } diff --git a/src/attributes.cpp b/src/attributes.cpp index 6c790c1..05c069f 100644 --- a/src/attributes.cpp +++ b/src/attributes.cpp @@ -62,7 +62,7 @@ Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix i const unsigned int r = valDim[1]; const unsigned int K = valDim[2]; /* If dimensions of both arguments do not agree thrw an exception */ - if ( M != index.nrow() || K != index.ncol()) { + if ( M != (unsigned)index.nrow() || K != (unsigned)index.ncol()) { throw Rcpp::exception("Matrix dimensions disagree."); } arma::cube values_arma(values.begin(), M, r, K, false, true); diff --git a/src/hungarian.h b/src/hungarian.h index 8c30644..cb6db49 100644 --- a/src/hungarian.h +++ b/src/hungarian.h @@ -67,7 +67,7 @@ void find_star_in_row (const int &row, int &col, void find_prime_in_row (const int &row, int &col, const arma::umat &indM, const unsigned int &N); -void augment_path (const int &path_count, arma::umat &indM, +void augment_path (const unsigned int &path_count, arma::umat &indM, const arma::imat &path); void clear_covers (arma::ivec &rcov, arma::ivec &ccov); @@ -526,7 +526,7 @@ void find_prime_in_row (const int &row, int &col, * @return void * */ inline -void augment_path (const int &path_count, arma::umat &indM, +void augment_path (const unsigned int &path_count, arma::umat &indM, const arma::imat &path) { for (unsigned int p = 0; p < path_count; ++p) { diff --git a/src/mcmc_condpoisson.cpp b/src/mcmc_condpoisson.cpp index ddf57c0..80f3e73 100644 --- a/src/mcmc_condpoisson.cpp +++ b/src/mcmc_condpoisson.cpp @@ -53,16 +53,15 @@ RcppExport SEXP mcmc_condpoisson_cc(SEXP data_S4, SEXP model_S4, Rcpp::S4 mcmcS4O(mcmc_S4); Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; + const bool INDICFIX = finModel.indicFix; + const bool POST_IND = finMCMC.storePost; const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; BASE* ptr; typedef FIXn_rows; const unsigned int K = (*arma_data)[0]->n_cols; arma::vec rvalues(M); - arma::vec arma_x(*x); arma::vec dirich(&x[0], K); arma::vec shape(&x[0] + K, K); arma::vec rate(&x[0] + 2 * K, K); rvalues = lddirichlet((*(*arma_data)[1]), dirich); - rvalues += arma::sum(ldgamma((*(*arma_data)[0]), + rvalues += arma::sum(ldgamma((*(*arma_data)[0]), shape, rate), 1); - return arma::sum(rvalues); + if (rvalues.has_inf()) { + rvalues.elem(arma::find(rvalues == arma::datum::inf)).fill(10.0e+6); + rvalues.elem(arma::find(rvalues == -arma::datum::inf)).fill(-10.0e+6); + } else if (rvalues.has_nan()) { + rvalues.elem(arma::find(rvalues == arma::datum::nan)).zeros(); + } + + return arma::as_scalar(arma::sum(rvalues)); } /** * ------------------------------------------------------------ @@ -98,7 +104,7 @@ double obj_stephens1997a_binomial (unsigned n, const double* x, rvalues = lddirichlet((*(*arma_data)[1]), dirich); rvalues += arma::sum(ldbeta((*(*arma_data)[0]), shape1, shape2), 1); - return arma::sum(rvalues); + return arma::as_scalar(arma::sum(rvalues)); } #endif /* __FINMIX_OPTIMIZE_H__ */ diff --git a/src/prior_likelihood.h b/src/prior_likelihood.h index b016af7..7d3ae32 100644 --- a/src/prior_likelihood.h +++ b/src/prior_likelihood.h @@ -224,7 +224,6 @@ double priormixlik_normult (const bool& INDEPENDENT, const bool& HIER, const arma::cube& sigma) { const unsigned int K = mu.n_cols; - const unsigned int r = mu.n_rows; double mixlik = 0.0; if (INDEPENDENT) { mixlik += logdnormult(mu, bStart, BStart, BInvStart); diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index be87b4f..14885e0 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -27,6 +27,7 @@ #include "optimize.h" #include "hungarian.h" #include +#include // ============================================================ @@ -58,15 +59,15 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, arma::vec pars, const arma::umat perm) { const unsigned int M = values1.rows(); - const unsigned int K = values2.cols(); + const unsigned int K = values1.cols(); const unsigned int P = perm.n_rows; const unsigned int n = pars.n_elem; - double value = 1.0; - double value_next = 0.0; + double value = 0.0; + double value_next = -10.0e-8; arma::mat lambda(values1.begin(), M, K, true, true); arma::mat weight(values2.begin(), M, K, true, true); const arma::umat arma_perm = perm - 1; - arma::uvec row_index(M); + arma::uvec row_index = arma::linspace(0, M - 1, M); arma::uvec col_index(K); arma::vec tmp(M); arma::vec tmp2(K); @@ -79,21 +80,16 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, for (unsigned int k = 0; k < K; ++k) { index.unsafe_col(k) *= k; } - for (unsigned int m = 0; m < M; ++m) { - row_index.at(m) = m; - } /* Set up the optimizer */ - nlopt_opt optim; - optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); std::vector f_data(2); f_data[0] = λ f_data[1] = &weight; - double lower_bound[1] = {1e-10}; - double upper_bound[1] = {1e+7}; - nlopt_set_lower_bounds(optim, lower_bound); - nlopt_set_upper_bounds(optim, upper_bound); + nlopt_opt optim; + optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); + double lower_bound = 10e-6; + nlopt_set_lower_bounds1(optim, lower_bound); nlopt_set_max_objective(optim, obj_stephens1997a_poisson, &f_data); - + double results; while (value != value_next) { value = value_next; nlopt_optimize(optim, pars.memptr(), &value_next); @@ -152,7 +148,7 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, const unsigned int P = perm.n_rows; const unsigned int n = pars.n_elem; double value = 1.0; - double value_next = 0.0; + double value_next = -10.0e-8; arma::mat pp(values1.begin(), M, K, true, true); arma::mat weight(values2.begin(), M, K, true, true); const arma::umat arma_perm = perm - 1; @@ -203,9 +199,11 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, col_index = arma::sort_index(tmp2, "descend"); ind.row(m) = arma_perm.row(col_index(0)); } + swapmat_by_index(pp, ind); swapmat_by_index(weight, ind); swapumat_by_index(index, ind); + } nlopt_destroy(optim); index += 1; @@ -216,7 +214,8 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, - Rcpp::NumericMatrix weight_par) + Rcpp::NumericMatrix weight_par, + signed int max_iter=200) { unsigned int N = values.size(); unsigned int M = comp_par.rows(); @@ -244,7 +243,9 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, /* Save a pointer to the STL vector */ mat_vector[m] = pmat_ptr; } - while (value != value_next) { + signed int iter = 0; + while (value != value_next){ + iter += 1; value = value_next; value_next = 0.0; /* For all sampled MCMC parameters a matrix @@ -258,8 +259,6 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, % dpoisson(arma_values.at(n), lambda.row(m)); mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); } - } - for (unsigned int m = 0; m < M; ++m) { pmat_hat += *(mat_vector[m]); } /* This computes the reference estimator P_hat*/ @@ -279,7 +278,6 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, for (unsigned int m = 0; m < M; ++m) { for (unsigned int k = 0; k < K; ++k) { for (unsigned int l = 0; l < K; ++l) { - arma::vec mycol = mat_vector[m]->unsafe_col(l); cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), pmat_hat.unsafe_col(k)); } @@ -294,7 +292,7 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, swapmat_by_index(lambda, index); swapmat_by_index(weight, index); swapumat_by_index(index_out, index); - pmat_hat = arma::zeros(N, K); + pmat_hat.fill(0.0); } for (unsigned int m = 0; m < M; ++m) { delete mat_vector[m]; @@ -370,7 +368,6 @@ arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, for (unsigned int m = 0; m < M; ++m) { for (unsigned int k = 0; k < K; ++k) { for (unsigned int l = 0; l < K; ++l) { - arma::vec mycol = mat_vector[m]->unsafe_col(l); cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), pmat_hat.unsafe_col(k)); } @@ -385,7 +382,7 @@ arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, swapmat_by_index(p, index); swapmat_by_index(weight, index); swapumat_by_index(index_out, index); - pmat_hat = arma::zeros(N, K); + pmat_hat.fill(0.0); } for (unsigned int m = 0; m < M; ++m) { delete mat_vector[m]; @@ -475,7 +472,7 @@ arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, swapmat_by_index(lambda, index); swapmat_by_index(weight, index); swapumat_by_index(index_out, index); - pmat_hat = arma::zeros(N, K); + pmat_hat.fill(0.0); } for (unsigned int m = 0; m < M; ++m) { delete mat_vector[m]; diff --git a/src/rtruncnorm.h b/src/rtruncnorm.h index becfa65..81b1e20 100644 --- a/src/rtruncnorm.h +++ b/src/rtruncnorm.h @@ -90,7 +90,7 @@ inline static double urs_a_b (const double& a, const double& b) { const double phi_a = R::dnorm(a, 0.0, 1.0, 0); - double x = 0.0, u = 0.0; + double x = 0.0; /* Upper bound of normal density on [a,b] */ const double ub = a < 0.0 && b > 0.0 ? M1_SQRT_2PI : phi_a; From ddb699b7468b2fe120248f539b172439d66b8d8a Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Fri, 3 Sep 2021 12:04:51 +0200 Subject: [PATCH 05/24] Tested Stephens1997a again as results are very often identical to the ergodic average. --- src/relabel_algorithms.cpp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index 14885e0..310dd43 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -89,7 +89,6 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, double lower_bound = 10e-6; nlopt_set_lower_bounds1(optim, lower_bound); nlopt_set_max_objective(optim, obj_stephens1997a_poisson, &f_data); - double results; while (value != value_next) { value = value_next; nlopt_optimize(optim, pars.memptr(), &value_next); From 73eee2b48cad43bd222461dfb8b169a51659e25c Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Fri, 10 Sep 2021 13:19:56 +0200 Subject: [PATCH 06/24] Added another package to the DESCRIPTION file. --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 70a4142..0848b51 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,8 @@ Description: More about what it does (maybe more than one line) License: GPL (>= 3) SystemRequirements: C++11 Depends: Rcpp (>= 0.10.2), RcppArmadillo (>= 0.3.6.2), graphics, - mvtnorm (>= 0.9-7), KernSmooth (>= 2.23.10), dfoptim(>= 2011.8.1) + mvtnorm (>= 0.9-7), KernSmooth (>= 2.23.10), dfoptim(>= 2011.8.1), + nloptr (>= 1.2.0) Imports: Rcpp (>= 1.0.6), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2), nloptr (>= 1.2.0) Suggests: RUnit LinkingTo: Rcpp, RcppArmadillo, nloptr (>= 1.2.0) From 5e98ed92a3b20e0296cd777ba3483125602b7b48 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Fri, 10 Sep 2021 14:41:16 +0200 Subject: [PATCH 07/24] Ran beautifier over C++ code (uncrustify) and styler over R code. --- R/AllGenerics.R | 29 +- R/binomialmodelmoments.R | 144 +- R/cdatamoments.R | 254 +- R/cmodelmoments.R | 47 +- R/csdatamoments.R | 287 +- R/dataclass.R | 606 ++-- R/datamoments.R | 35 +- R/ddatamoments.R | 219 +- R/distributions.R | 5 +- R/dmodelmoments.R | 47 +- R/exponentialmodelmoments.R | 158 +- R/fdata.R | 2045 +++++++------- R/graphic_func.R | 418 +-- R/groupmoments.R | 247 +- R/likelihood.R | 237 +- R/mcmc.R | 273 +- R/mcmcestfix.R | 427 +-- R/mcmcestimate.R | 1239 ++++---- R/mcmcestind.R | 395 +-- R/mcmcextract.R | 145 +- R/mcmcoutputbase.R | 1211 ++++---- R/mcmcoutputfix.R | 3040 ++++++++++---------- R/mcmcoutputfixhier.R | 1639 ++++++----- R/mcmcoutputfixhierpost.R | 257 +- R/mcmcoutputfixpost.R | 424 +-- R/mcmcoutputhier.R | 464 +-- R/mcmcoutputhierpost.R | 322 ++- R/mcmcoutputpermbase.R | 848 +++--- R/mcmcoutputpermfix.R | 1690 ++++++----- R/mcmcoutputpermfixhier.R | 758 ++--- R/mcmcoutputpermfixhierpost.R | 312 ++- R/mcmcoutputpermfixpost.R | 302 +- R/mcmcoutputpermhier.R | 542 ++-- R/mcmcoutputpermhierpost.R | 440 +-- R/mcmcoutputpermpost.R | 409 +-- R/mcmcoutputpost.R | 283 +- R/mcmcpermfix.R | 61 +- R/mcmcpermfixpost.R | 27 +- R/mcmcpermind.R | 103 +- R/mcmcpermindpost.R | 27 +- R/mcmcpermute.R | 670 ++--- R/mcmcstart.R | 689 ++--- R/mincol.R | 81 +- R/mixturemcmc.R | 3121 +++++++++++---------- R/mixturemoments.R | 112 +- R/model.R | 4960 ++++++++++++++++++--------------- R/modelmoments.R | 86 +- R/normalmodelmoments.R | 170 +- R/normultmodelmoments.R | 273 +- R/poissonmodelmoments.R | 139 +- R/prior.R | 2770 +++++++++--------- R/sdatamoments.R | 90 +- R/studentmodelmoments.R | 162 +- R/studmultmodelmoments.R | 309 +- R/unass.R | 37 +- src/ADAPTER.h | 88 +- src/BASE.h | 94 +- src/DataClass.h | 268 +- src/FIX.h | 377 +-- src/FinmixData.h | 94 +- src/FinmixMCMC.h | 85 +- src/FinmixModel.h | 83 +- src/FinmixPrior.h | 71 +- src/HIER.h | 261 +- src/HierOutExponential.h | 75 +- src/HierOutNormal.h | 59 +- src/HierOutNormult.h | 63 +- src/HierOutPoisson.h | 75 +- src/HierOutStudent.h | 59 +- src/HierOutStudmult.h | 63 +- src/IND.h | 383 +-- src/LogBinomialFix.h | 85 +- src/LogBinomialInd.h | 112 +- src/LogCondPoissonFix.h | 91 +- src/LogCondPoissonInd.h | 109 +- src/LogExponentialFix.h | 91 +- src/LogExponentialInd.h | 112 +- src/LogNormalFix.h | 79 +- src/LogNormalInd.h | 92 +- src/LogNormultFix.h | 77 +- src/LogNormultInd.h | 92 +- src/LogPoissonFix.h | 93 +- src/LogPoissonInd.h | 112 +- src/LogStudentFix.h | 76 +- src/LogStudentInd.h | 94 +- src/LogStudmultFix.h | 87 +- src/LogStudmultInd.h | 92 +- src/POST.h | 273 +- src/ParBinomialFix.cpp | 71 +- src/ParBinomialFix.h | 58 +- src/ParBinomialInd.cpp | 73 +- src/ParBinomialInd.h | 54 +- src/ParCondPoissonFix.cpp | 157 +- src/ParCondPoissonFix.h | 72 +- src/ParCondPoissonInd.cpp | 63 +- src/ParCondPoissonInd.h | 58 +- src/ParExponentialFix.cpp | 75 +- src/ParExponentialFix.h | 62 +- src/ParExponentialInd.cpp | 63 +- src/ParExponentialInd.h | 58 +- src/ParNormalFix.cpp | 45 +- src/ParNormalFix.h | 44 +- src/ParNormalInd.cpp | 19 +- src/ParNormalInd.h | 40 +- src/ParNormultFix.cpp | 76 +- src/ParNormultFix.h | 46 +- src/ParNormultInd.cpp | 19 +- src/ParNormultInd.h | 36 +- src/ParOutBinomial.h | 73 +- src/ParOutCondPoisson.h | 79 +- src/ParOutExponential.h | 75 +- src/ParOutNormal.h | 63 +- src/ParOutNormult.h | 114 +- src/ParOutPoisson.h | 75 +- src/ParOutStudent.h | 79 +- src/ParOutStudmult.h | 133 +- src/ParPoissonFix.cpp | 75 +- src/ParPoissonFix.h | 62 +- src/ParPoissonInd.cpp | 63 +- src/ParPoissonInd.h | 58 +- src/ParStudentFix.cpp | 50 +- src/ParStudentFix.h | 48 +- src/ParStudentInd.cpp | 19 +- src/ParStudentInd.h | 38 +- src/ParStudmultFix.cpp | 70 +- src/ParStudmultFix.h | 50 +- src/ParStudmultInd.cpp | 19 +- src/ParStudmultInd.h | 36 +- src/PostOutBinomialFix.h | 89 +- src/PostOutBinomialInd.h | 58 +- src/PostOutCondPoissonFix.h | 87 +- src/PostOutCondPoissonInd.h | 79 +- src/PostOutExponentialFix.h | 87 +- src/PostOutExponentialInd.h | 79 +- src/PostOutNormalFix.h | 89 +- src/PostOutNormalInd.h | 59 +- src/PostOutNormultFix.h | 116 +- src/PostOutNormultInd.h | 55 +- src/PostOutPoissonFix.h | 87 +- src/PostOutPoissonInd.h | 79 +- src/PostOutStudentFix.h | 96 +- src/PostOutStudentInd.h | 57 +- src/PostOutStudmultFix.h | 116 +- src/PostOutStudmultInd.h | 55 +- src/PriorBinomialFix.cpp | 102 +- src/PriorBinomialFix.h | 62 +- src/PriorBinomialInd.cpp | 72 +- src/PriorBinomialInd.h | 60 +- src/PriorCondPoissonFix.cpp | 94 +- src/PriorCondPoissonFix.h | 72 +- src/PriorCondPoissonInd.cpp | 72 +- src/PriorCondPoissonInd.h | 62 +- src/PriorExponentialFix.cpp | 107 +- src/PriorExponentialFix.h | 74 +- src/PriorExponentialInd.cpp | 72 +- src/PriorExponentialInd.h | 62 +- src/PriorNormalFix.cpp | 195 +- src/PriorNormalFix.h | 66 +- src/PriorNormalInd.cpp | 18 +- src/PriorNormalInd.h | 44 +- src/PriorNormultFix.cpp | 298 +- src/PriorNormultFix.h | 80 +- src/PriorNormultInd.cpp | 14 +- src/PriorNormultInd.h | 44 +- src/PriorPoissonFix.cpp | 129 +- src/PriorPoissonFix.h | 74 +- src/PriorPoissonInd.cpp | 72 +- src/PriorPoissonInd.h | 62 +- src/PriorStudentFix.cpp | 310 ++- src/PriorStudentFix.h | 82 +- src/PriorStudentInd.cpp | 235 +- src/PriorStudentInd.h | 46 +- src/PriorStudmultFix.cpp | 430 +-- src/PriorStudmultFix.h | 94 +- src/PriorStudmultInd.cpp | 14 +- src/PriorStudmultInd.h | 44 +- src/RcppExports.cpp | 448 +-- src/algorithms.h | 100 +- src/attributes.cpp | 421 +-- src/distributions.h | 537 ++-- src/hungarian.h | 757 ++--- src/likelihood.h | 579 ++-- src/mcmc_binomial.cpp | 147 +- src/mcmc_condpoisson.cpp | 155 +- src/mcmc_exponential.cpp | 156 +- src/mcmc_normal.cpp | 161 +- src/mcmc_normult.cpp | 161 +- src/mcmc_poisson.cpp | 219 +- src/mcmc_student.cpp | 161 +- src/mcmc_studmult.cpp | 161 +- src/mincol.h | 146 +- src/moments.h | 1058 +++---- src/optimize.h | 113 +- src/posterior.h | 82 +- src/prior_likelihood.h | 448 +-- src/relabel_algorithms.cpp | 869 +++--- src/rtruncnorm.h | 325 ++- tests/doRUnit.R | 123 +- 198 files changed, 28135 insertions(+), 24260 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 0a20ce9..10940be 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -146,7 +146,7 @@ setGeneric("getExp", function(object) standardGeneric("getExp")) setGeneric("setY<-", function(object, value) standardGeneric("setY<-")) -setGeneric("setN<-", function(object, value) standardGeneric("setN<-")) +setGeneric("setN<-", function(object, value) standardGeneric("setN<-")) setGeneric("setS<-", function(object, value) standardGeneric("setS<-")) @@ -178,15 +178,13 @@ setGeneric("getSmoments", function(object) standardGeneric("getSmoments")) ## Class 'prior' ----------------------------------------------------- -setGeneric( "hasPriorPar", function( object, model, verbose = FALSE ) standardGeneric( "hasPriorPar" ) ) +setGeneric("hasPriorPar", function(object, model, verbose = FALSE) standardGeneric("hasPriorPar")) setGeneric("hasPriorWeight", function(object, model, verbose = FALSE) standardGeneric("hasPriorWeight")) -setGeneric("generatePrior", function(object, ... ) - { - standardGeneric("generatePrior") - } -) +setGeneric("generatePrior", function(object, ...) { + standardGeneric("generatePrior") +}) setGeneric("getHier", function(object) standardGeneric("getHier")) @@ -234,7 +232,7 @@ setGeneric("getLoglikcd", function(object) standardGeneric("getLoglikcd")) ## Class 'mcmcextract' -------------------------------------------------------------------------- -setGeneric( "moments", function( object ) standardGeneric( "moments" ) ) +setGeneric("moments", function(object) standardGeneric("moments")) ## Class 'mcmcoutputfix' ------------------------------------------------ @@ -252,7 +250,7 @@ setGeneric("subseq", function(object, index) standardGeneric("subseq")) setGeneric("swapElements", function(object, index) standardGeneric("swapElements")) -setGeneric( "extract", function( object, index ) standardGeneric( "extract" ) ) +setGeneric("extract", function(object, index) standardGeneric("extract")) setGeneric("getLog", function(object) standardGeneric("getLog")) @@ -311,16 +309,3 @@ setGeneric("getSdpost", function(object) standardGeneric("getSdpost")) ## Class 'mcmcestind' ------------------------------------------------------ setGeneric("getEavg", function(object) standardGeneric("getEavg")) - - - - - - - - - - - - - diff --git a/R/binomialmodelmoments.R b/R/binomialmodelmoments.R index 1a93793..865d380 100644 --- a/R/binomialmodelmoments.R +++ b/R/binomialmodelmoments.R @@ -16,89 +16,97 @@ # along with finmix. If not, see . .binomialmodelmoments <- setClass("binomialmodelmoments", - representation(extrabinvar = "numeric"), - contains = c("dmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype(extrabinvar = numeric() - ) + representation(extrabinvar = "numeric"), + contains = c("dmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(extrabinvar = numeric()) ) -setMethod("initialize", "binomialmodelmoments", - function(.Object, ..., model) - { - .Object <- callNextMethod(.Object, ..., model = model) - generateMoments(.Object) - } +setMethod( + "initialize", "binomialmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + generateMoments(.Object) + } ) -setMethod("generateMoments", "binomialmodelmoments", - function(object) - { - .generateMomentsBinomial(object) - } +setMethod( + "generateMoments", "binomialmodelmoments", + function(object) { + .generateMomentsBinomial(object) + } ) -setMethod("show", "binomialmodelmoments", - function(object) - { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" factorial :", - paste(dim(object@factorial), collapse = "x"), - "\n") - cat(" over :", object@over, "\n") - cat(" zero :", object@zero, "\n") - cat(" extrabinvar :", object@extrabinvar, - "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "binomialmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " factorial :", + paste(dim(object@factorial), collapse = "x"), + "\n" + ) + cat(" over :", object@over, "\n") + cat(" zero :", object@zero, "\n") + cat( + " extrabinvar :", object@extrabinvar, + "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) ## Getters ## -setMethod("getExtrabinvar", "binomialmodelmoments", - function(object) - { - return(object@extrabinvar) - } +setMethod( + "getExtrabinvar", "binomialmodelmoments", + function(object) { + return(object@extrabinvar) + } ) ## No setters as users are not intended to manipulate ## ## this object ## ### Private functions -### These function are not exported -".generateMomentsBinomial" <- function(object) -{ - p <- object@model@par$p - n <- object@model@par$n - weight <- object@model@weight - object@mean <- sum(weight * n * p) - object@var <- array(sum(weight * (n * p - object@mean)^2) - + sum(weight * n * p * (1 - p)), dim = c(1, 1)) - factm <- array(NA, dim = c(4, 1)) - factm[1] <- object@mean - for (i in seq(2,4)) { - if(n >= i) { - factm[i] <- sum(weight * factorial(n)/factorial(n - i) * p^i) - } else { - factm[i] <- NaN - } - } - dimnames(factm) <- list(c("1st", "2nd", "3rd", "4th"), "") - object@factorial <- factm - if (object@model@K > 1) { - object@over <- object@var[1] - object@mean +### These function are not exported +".generateMomentsBinomial" <- function(object) { + p <- object@model@par$p + n <- object@model@par$n + weight <- object@model@weight + object@mean <- sum(weight * n * p) + object@var <- array(sum(weight * (n * p - object@mean)^2) + + sum(weight * n * p * (1 - p)), dim = c(1, 1)) + factm <- array(NA, dim = c(4, 1)) + factm[1] <- object@mean + for (i in seq(2, 4)) { + if (n >= i) { + factm[i] <- sum(weight * factorial(n) / factorial(n - i) * p^i) } else { - object@over <- 0 + factm[i] <- NaN } - object@zero <- sum(weight * (1 - p)^n) - object@extrabinvar <- object@mean * (1 - object@mean/n[1]) - return(object) + } + dimnames(factm) <- list(c("1st", "2nd", "3rd", "4th"), "") + object@factorial <- factm + if (object@model@K > 1) { + object@over <- object@var[1] - object@mean + } else { + object@over <- 0 + } + object@zero <- sum(weight * (1 - p)^n) + object@extrabinvar <- object@mean * (1 - object@mean / n[1]) + return(object) } diff --git a/R/cdatamoments.R b/R/cdatamoments.R index 69b68ce..43c4aa5 100644 --- a/R/cdatamoments.R +++ b/R/cdatamoments.R @@ -16,145 +16,163 @@ # along with finmix. If not, see . .cdatamoments <- setClass("cdatamoments", - representation(higher = "array", - skewness = "vector", - kurtosis = "vector", - corr = "matrix", - smoments = "csdatamomentsOrNULL" - ), - contains = c("datamoments"), - validity = function(object) - { - ## else: ok - TRUE - }, - prototype(higher = array(), - skewness = vector(), - kurtosis = vector(), - corr = matrix(), - smoments = .csdatamoments() - ) + representation( + higher = "array", + skewness = "vector", + kurtosis = "vector", + corr = "matrix", + smoments = "csdatamomentsOrNULL" + ), + contains = c("datamoments"), + validity = function(object) { + ## else: ok + TRUE + }, + prototype( + higher = array(), + skewness = vector(), + kurtosis = vector(), + corr = matrix(), + smoments = .csdatamoments() + ) ) -setMethod("initialize", "cdatamoments", - function(.Object, ..., value = fdata()) - { - .Object@fdata <- value - if (hasS(value)) { - .Object@smoments <- sdatamoments(value = value) - } else { - .Object@smoments <- NULL - } - generateMoments(.Object) - } +setMethod( + "initialize", "cdatamoments", + function(.Object, ..., value = fdata()) { + .Object@fdata <- value + if (hasS(value)) { + .Object@smoments <- sdatamoments(value = value) + } else { + .Object@smoments <- NULL + } + generateMoments(.Object) + } ) -setMethod("generateMoments", "cdatamoments", - function(object) - { - .generateCdatamoments(object) - } +setMethod( + "generateMoments", "cdatamoments", + function(object) { + .generateCdatamoments(object) + } ) -setMethod("show", "cdatamoments", - function(object) - { - cat("Object 'datamoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var : Vector of", - length(object@var), "\n") - cat(" higher :", - paste(dim(object@higher), collapse = "x"), "\n") - cat(" skewness : Vector of", - length(object@skewness), "\n") - cat(" kurtosis : Vector of", - length(object@kurtosis), "\n") - if (!all(is.na(object@corr))) { - cat(" corr :", - paste(dim(object@corr), collapse = "x"), "\n") - } - if (hasS(object@fdata)) { - cat(" smoments : Object of class", - class(object@smoments), "\n") - } - cat(" fdata : Object of class", - class(object@fdata), "\n") - } +setMethod( + "show", "cdatamoments", + function(object) { + cat("Object 'datamoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var : Vector of", + length(object@var), "\n" + ) + cat( + " higher :", + paste(dim(object@higher), collapse = "x"), "\n" + ) + cat( + " skewness : Vector of", + length(object@skewness), "\n" + ) + cat( + " kurtosis : Vector of", + length(object@kurtosis), "\n" + ) + if (!all(is.na(object@corr))) { + cat( + " corr :", + paste(dim(object@corr), collapse = "x"), "\n" + ) + } + if (hasS(object@fdata)) { + cat( + " smoments : Object of class", + class(object@smoments), "\n" + ) + } + cat( + " fdata : Object of class", + class(object@fdata), "\n" + ) + } ) ## Getters ## -setMethod("getSmoments", "cdatamoments", - function(object) - { - return(object@smoments) - } +setMethod( + "getSmoments", "cdatamoments", + function(object) { + return(object@smoments) + } ) -setMethod("getHigher", "cdatamoments", - function(object) - { - return(object@higher) - } +setMethod( + "getHigher", "cdatamoments", + function(object) { + return(object@higher) + } ) -setMethod("getSkewness", "cdatamoments", - function(object) - { - return(object@skewness) - } +setMethod( + "getSkewness", "cdatamoments", + function(object) { + return(object@skewness) + } ) -setMethod("getKurtosis", "cdatamoments", - function(object) - { - return(object@kurtosis) - } +setMethod( + "getKurtosis", "cdatamoments", + function(object) { + return(object@kurtosis) + } ) -setMethod("getCorr", "cdatamoments", - function(object) - { - return(object@corr) - } +setMethod( + "getCorr", "cdatamoments", + function(object) { + return(object@corr) + } ) ## Setters ## ## No setters as users should not manipulate a 'cdatamoments' object ## ### Private functions ### These function are not exported -".generateCdatamoments" <- function(object) -{ - ## enforce column-wise ordering ## - hasY(object@fdata, verbose = TRUE) - datam <- getColY(object@fdata) - ## Compute higher moments ## - ## higher.moments is a r x L matrix (L = 4) ## - means <- apply(datam, 2, mean, na.rm = TRUE) - object@mean <- means - object@var <- var(datam, na.rm = TRUE) - d <- datam - rep(means, each = nrow(datam)) - momentsm <- array(0, dim = c(4, object@fdata@r)) - momentsm[2,] <- apply(d^2, 2, mean, na.rm = TRUE) - momentsm[3,] <- apply(d^3, 2, mean, na.rm = TRUE) - momentsm[4,] <- apply(d^4, 2, mean, na.rm = TRUE) - dimnames(momentsm) <- list(c("1st", "2nd", "3rd", "4th"), - colnames(datam)) - object@higher <- momentsm - ## Compute skewness and kurtosis ## - ## skewness and kurtosis are 1 x r vectors ## - skewm <- momentsm[3, ]/momentsm[2, ]^1.5 - kurtm <- momentsm[4, ]/momentsm[2, ]^2 - names(skewm) <- colnames(datam) - names(kurtm) <- colnames(datam) - object@skewness <- skewm - object@kurtosis <- kurtm - ## Compute corr matrix in case of r > 1 ## - ## corr is a r x r matrix ## - if(object@fdata@r > 1) { - object@corr <- cor(datam) - } else { - object@corr <- matrix() - } - return(object) +".generateCdatamoments" <- function(object) { + ## enforce column-wise ordering ## + hasY(object@fdata, verbose = TRUE) + datam <- getColY(object@fdata) + ## Compute higher moments ## + ## higher.moments is a r x L matrix (L = 4) ## + means <- apply(datam, 2, mean, na.rm = TRUE) + object@mean <- means + object@var <- var(datam, na.rm = TRUE) + d <- datam - rep(means, each = nrow(datam)) + momentsm <- array(0, dim = c(4, object@fdata@r)) + momentsm[2, ] <- apply(d^2, 2, mean, na.rm = TRUE) + momentsm[3, ] <- apply(d^3, 2, mean, na.rm = TRUE) + momentsm[4, ] <- apply(d^4, 2, mean, na.rm = TRUE) + dimnames(momentsm) <- list( + c("1st", "2nd", "3rd", "4th"), + colnames(datam) + ) + object@higher <- momentsm + ## Compute skewness and kurtosis ## + ## skewness and kurtosis are 1 x r vectors ## + skewm <- momentsm[3, ] / momentsm[2, ]^1.5 + kurtm <- momentsm[4, ] / momentsm[2, ]^2 + names(skewm) <- colnames(datam) + names(kurtm) <- colnames(datam) + object@skewness <- skewm + object@kurtosis <- kurtm + ## Compute corr matrix in case of r > 1 ## + ## corr is a r x r matrix ## + if (object@fdata@r > 1) { + object@corr <- cor(datam) + } else { + object@corr <- matrix() + } + return(object) } diff --git a/R/cmodelmoments.R b/R/cmodelmoments.R index fff64df..382d6b9 100644 --- a/R/cmodelmoments.R +++ b/R/cmodelmoments.R @@ -15,39 +15,36 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.cmodelmoments <- setClass("cmodelmoments", - representation( - higher = "array", - skewness = "vector", - kurtosis = "vector" - ), - contains = c("modelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype( - higher = array(), - skewness = vector(), - kurtosis = vector() - ) +.cmodelmoments <- setClass("cmodelmoments", + representation( + higher = "array", + skewness = "vector", + kurtosis = "vector" + ), + contains = c("modelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + higher = array(), + skewness = vector(), + kurtosis = vector() + ) ) ## Getters ## setMethod("getHigher", "cmodelmoments", function(object) { - return(object@higher) - } -) + return(object@higher) +}) setMethod("getSkewness", "cmodelmoments", function(object) { - return(object@skewness) - } -) + return(object@skewness) +}) setMethod("getKurtosis", "cmodelmoments", function(object) { - return(object@kurtosis) - } -) + return(object@kurtosis) +}) ## Setters ## ## No setters as users should not manipulate a 'nsmodelmoments' object ## diff --git a/R/csdatamoments.R b/R/csdatamoments.R index 68f44a3..e8f23dc 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -16,137 +16,149 @@ # along with finmix. If not, see . .csdatamoments <- setClass("csdatamoments", - representation(B = "vector", - W = "vector", - T = "vector", - R = "numeric", - Rtr = "numeric", - Rdet = "numeric"), - contains = c("sdatamoments"), - validity = function(object) - { - ## else: ok - TRUE - }, - prototype(B = vector("numeric"), - W = vector("numeric"), - T = vector("numeric"), - R = numeric(), - Rtr = numeric(), - Rdet = numeric() - ) + representation( + B = "vector", + W = "vector", + T = "vector", + R = "numeric", + Rtr = "numeric", + Rdet = "numeric" + ), + contains = c("sdatamoments"), + validity = function(object) { + ## else: ok + TRUE + }, + prototype( + B = vector("numeric"), + W = vector("numeric"), + T = vector("numeric"), + R = numeric(), + Rtr = numeric(), + Rdet = numeric() + ) ) setClassUnion("csdatamomentsOrNULL", members = c("csdatamoments", "NULL")) -setMethod("initialize", "csdatamoments", - function(.Object, ..., value = fdata()) - { - .Object <- callNextMethod(.Object, ..., value = value) - if(hasY(value) && hasS(value)) { - .Object <- generateMoments(.Object) - } - return(.Object) - } +setMethod( + "initialize", "csdatamoments", + function(.Object, ..., value = fdata()) { + .Object <- callNextMethod(.Object, ..., value = value) + if (hasY(value) && hasS(value)) { + .Object <- generateMoments(.Object) + } + return(.Object) + } ) -setMethod("generateMoments", "csdatamoments", - function(object) - { - .generateCsdatamoments(object) - } +setMethod( + "generateMoments", "csdatamoments", + function(object) { + .generateCsdatamoments(object) + } ) -setMethod("show", "csdatamoments", - function(object) - { - cat("Object 'sdatamoments'\n") - cat(" B : Vector of", - length(object@B), "\n") - cat(" W : Vector of", - length(object@W), "\n") - cat(" T : Vector of", - length(object@T), "\n") - if (object@fdata@r > 1) { - cat(" Rdet :", object@Rdet, "\n") - cat(" Rtr :", object@Rtr, "\n") - } - cat(" gmoments : Object of class", - class(object@gmoments), "\n") - cat(" fdata : Object of class", - class(object@fdata), "\n") - } +setMethod( + "show", "csdatamoments", + function(object) { + cat("Object 'sdatamoments'\n") + cat( + " B : Vector of", + length(object@B), "\n" + ) + cat( + " W : Vector of", + length(object@W), "\n" + ) + cat( + " T : Vector of", + length(object@T), "\n" + ) + if (object@fdata@r > 1) { + cat(" Rdet :", object@Rdet, "\n") + cat(" Rtr :", object@Rtr, "\n") + } + cat( + " gmoments : Object of class", + class(object@gmoments), "\n" + ) + cat( + " fdata : Object of class", + class(object@fdata), "\n" + ) + } ) ## Getters ## -setMethod("getGmoments", "csdatamoments", - function(object) - { - return(object@gmoments) - } +setMethod( + "getGmoments", "csdatamoments", + function(object) { + return(object@gmoments) + } ) -setMethod("getWK", "csdatamoments", - function(object) - { - return(object@WK) - } +setMethod( + "getWK", "csdatamoments", + function(object) { + return(object@WK) + } ) -setMethod("getVar", "csdatamoments", - function(object) - { - return(object@var) - } +setMethod( + "getVar", "csdatamoments", + function(object) { + return(object@var) + } ) -setMethod("getB", "csdatamoments", - function(object) - { - return(object@B) - } +setMethod( + "getB", "csdatamoments", + function(object) { + return(object@B) + } ) -setMethod("getW", "csdatamoments", - function(object) - { - return(object@W) - } +setMethod( + "getW", "csdatamoments", + function(object) { + return(object@W) + } ) -setMethod("getT", "csdatamoments", - function(object) - { - return(object@T) - } +setMethod( + "getT", "csdatamoments", + function(object) { + return(object@T) + } ) -setMethod("getR", "csdatamoments", - function(object) - { - return(object@R) - } +setMethod( + "getR", "csdatamoments", + function(object) { + return(object@R) + } ) -setMethod("getRtr", "csdatamoments", - function(object) - { - return(object@Rtr) - } +setMethod( + "getRtr", "csdatamoments", + function(object) { + return(object@Rtr) + } ) -setMethod("getRdet", "csdatamoments", - function(object) - { - return(object@Rdet) - } +setMethod( + "getRdet", "csdatamoments", + function(object) { + return(object@Rdet) + } ) -setMethod("getFdata", "csdatamoments", - function(object) - { - return(object@fdata) - } +setMethod( + "getFdata", "csdatamoments", + function(object) { + return(object@fdata) + } ) ## Setters ## @@ -154,40 +166,39 @@ setMethod("getFdata", "csdatamoments", ### Private functions ### These functions are not exported -".generateCsdatamoments" <- function(object) -{ - ## enforce column.wise ordering ## - datam <- getColY(object@fdata) - classm <- getColS(object@fdata) - ## Calculate the between-group variance ## - ## 'B' is an r x r matrix ## - gmeans <- object@gmoments@mean - nkm <- object@gmoments@NK - ## Calculate the total heterogeneity ## - ## 'T' is an r x r array ## - object@T <- var(datam, na.rm = TRUE) * nrow(datam) - ## Calculate the within-group heterogeneity ## - ## 'W' is an r x r array ## - wkm <- object@gmoments@WK - object@W <- apply(wkm, c(1, 2), sum, na.rm = TRUE) - ## Calculate between-group heterogeneity ## - ## 'B' is an r x r array ## - object@B <- object@T - object@W - ## Calculate coefficient of determination ## - ## 'Rtr' is an 1 x 1 numeric ## - ## 'Rdet' is an 1 x 1 numeric ## - if (object@data@r > 1) { - r <- NA - object@R <- as.numeric(r) - object@Rtr <- 1 - sum(diag(object@W), na.rm = TRUE) / - sum(diag(object@T), na.rm = TRUE) - object@Rdet <- 1 - det(object@W)/det(object@T) - } else { - rtr <- NA - rdet <- NA - object@Rtr <- as.numeric(rtr) - object@Rdet <- as.numeric(rdet) - object@R <- 1 - object@W[1]/object@T[1] - } - return(object) +".generateCsdatamoments" <- function(object) { + ## enforce column.wise ordering ## + datam <- getColY(object@fdata) + classm <- getColS(object@fdata) + ## Calculate the between-group variance ## + ## 'B' is an r x r matrix ## + gmeans <- object@gmoments@mean + nkm <- object@gmoments@NK + ## Calculate the total heterogeneity ## + ## 'T' is an r x r array ## + object@T <- var(datam, na.rm = TRUE) * nrow(datam) + ## Calculate the within-group heterogeneity ## + ## 'W' is an r x r array ## + wkm <- object@gmoments@WK + object@W <- apply(wkm, c(1, 2), sum, na.rm = TRUE) + ## Calculate between-group heterogeneity ## + ## 'B' is an r x r array ## + object@B <- object@T - object@W + ## Calculate coefficient of determination ## + ## 'Rtr' is an 1 x 1 numeric ## + ## 'Rdet' is an 1 x 1 numeric ## + if (object@data@r > 1) { + r <- NA + object@R <- as.numeric(r) + object@Rtr <- 1 - sum(diag(object@W), na.rm = TRUE) / + sum(diag(object@T), na.rm = TRUE) + object@Rdet <- 1 - det(object@W) / det(object@T) + } else { + rtr <- NA + rdet <- NA + object@Rtr <- as.numeric(rtr) + object@Rdet <- as.numeric(rdet) + object@R <- 1 - object@W[1] / object@T[1] + } + return(object) } diff --git a/R/dataclass.R b/R/dataclass.R index b3f6798..2924b87 100644 --- a/R/dataclass.R +++ b/R/dataclass.R @@ -16,124 +16,130 @@ # along with finmix. If not, see . .dataclass <- setClass("dataclass", - representation( - logpy = "array", - prob = "array", - mixlik = "numeric", - entropy = "numeric", - loglikcd = "array", - postS = "numeric"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(logpy = array(), - prob = array(), - mixlik = numeric(), - entropy = numeric(), - loglikcd = array(), - postS = numeric() - ) - + representation( + logpy = "array", + prob = "array", + mixlik = "numeric", + entropy = "numeric", + loglikcd = "array", + postS = "numeric" + ), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + logpy = array(), + prob = array(), + mixlik = numeric(), + entropy = numeric(), + loglikcd = array(), + postS = numeric() + ) ) -"dataclass" <- function(fdata = NULL, model = NULL, simS = FALSE) -{ - - .check.fdata.model.Dataclass(fdata, model) - .check.model.Dataclass(model) - .valid.fdata.model.Prior(fdata, model) - if (hasS(fdata)) { - classm <- getColS(fdata) - } - datam <- getColY(fdata) - K <- model@K - dist <- model@dist - lik.list <- .liklist.Dataclass(fdata, model) - ## The following is only used as a temporary solution as long - ## as the 'Markov' model for the indicators is not yet implemented. - ## Check attribute 'indicmod' in 'model' argument - if(model@indicmod != "multinomial") { - model@indicmod <- "multinomial" - } - if (!model@indicfix) { - if (model@indicmod == "multinomial") { - .multinomial.Dataclass(fdata, model, lik.list, - simS) - } ## else: implemented later: Markov model for S - } else { ## indicfix == TRUE - .indicfix.Dataclass(fdata, model, lik.list) - } +"dataclass" <- function(fdata = NULL, model = NULL, simS = FALSE) { + .check.fdata.model.Dataclass(fdata, model) + .check.model.Dataclass(model) + .valid.fdata.model.Prior(fdata, model) + if (hasS(fdata)) { + classm <- getColS(fdata) + } + datam <- getColY(fdata) + K <- model@K + dist <- model@dist + lik.list <- .liklist.Dataclass(fdata, model) + ## The following is only used as a temporary solution as long + ## as the 'Markov' model for the indicators is not yet implemented. + ## Check attribute 'indicmod' in 'model' argument + if (model@indicmod != "multinomial") { + model@indicmod <- "multinomial" + } + if (!model@indicfix) { + if (model@indicmod == "multinomial") { + .multinomial.Dataclass( + fdata, model, lik.list, + simS + ) + } ## else: implemented later: Markov model for S + } else { ## indicfix == TRUE + .indicfix.Dataclass(fdata, model, lik.list) + } } -setMethod("show", "dataclass", - function(object) - { - has.loglikcd <- !all(is.na(object@loglikcd)) - has.mixlik <- !all(is.na(object@mixlik)) - has.entropy <- !all(is.na(object@entropy)) - has.postS <- !all(is.na(object@postS)) - cat("Object 'dataclass'\n") - cat(" logpy :", - paste(dim(object@logpy), collapse = "x"), - "\n") - cat(" prob :", - paste(dim(object@prob), collapse = "x"), - "\n") - if (has.mixlik) { - cat(" mixlik :", object@mixlik, "\n") - } - if (has.entropy) { - cat(" entropy :", object@entropy, "\n") - } - if (has.loglikcd) { - cat(" loglikcd :", - paste(dim(object@loglikcd), collapse = "x"), - "\n") - } - if (has.postS) { - cat(" postS :", object@postS, "\n") - } - } +setMethod( + "show", "dataclass", + function(object) { + has.loglikcd <- !all(is.na(object@loglikcd)) + has.mixlik <- !all(is.na(object@mixlik)) + has.entropy <- !all(is.na(object@entropy)) + has.postS <- !all(is.na(object@postS)) + cat("Object 'dataclass'\n") + cat( + " logpy :", + paste(dim(object@logpy), collapse = "x"), + "\n" + ) + cat( + " prob :", + paste(dim(object@prob), collapse = "x"), + "\n" + ) + if (has.mixlik) { + cat(" mixlik :", object@mixlik, "\n") + } + if (has.entropy) { + cat(" entropy :", object@entropy, "\n") + } + if (has.loglikcd) { + cat( + " loglikcd :", + paste(dim(object@loglikcd), collapse = "x"), + "\n" + ) + } + if (has.postS) { + cat(" postS :", object@postS, "\n") + } + } ) ## Getters ## -setMethod("getLogpy", "dataclass", - function(object) - { - return(object@logpy) - } +setMethod( + "getLogpy", "dataclass", + function(object) { + return(object@logpy) + } ) -setMethod("getProb", "dataclass", - function(object) - { - return(object@prob) - } +setMethod( + "getProb", "dataclass", + function(object) { + return(object@prob) + } ) -setMethod("getMixlik", "dataclass", - function(object) - { - return(object@mixlik) - } +setMethod( + "getMixlik", "dataclass", + function(object) { + return(object@mixlik) + } ) -setMethod("getEntropy", "dataclass", - function(object) - { - return(object@entropy) - } +setMethod( + "getEntropy", "dataclass", + function(object) { + return(object@entropy) + } ) -setMethod("getLoglikcd", "dataclass", - function(object) - { - return(object@loglikcd) - } +setMethod( + "getLoglikcd", "dataclass", + function(object) { + return(object@loglikcd) + } ) -setMethod("getPostS", "dataclass", - function(object) - { - return(object@postS) - } +setMethod( + "getPostS", "dataclass", + function(object) { + return(object@postS) + } ) ## No setters as users are not intended to mnaipulate ## @@ -143,223 +149,235 @@ setMethod("getPostS", "dataclass", ### These functions are not exported. ### Checking -### Check fdata/model: 'fdata' must be an object of class -### 'fdata'. Further, this object must be valid and must +### Check fdata/model: 'fdata' must be an object of class +### 'fdata'. Further, this object must be valid and must ### contain data in @y. The 'fdata' object and the 'model' ### object must be consistent to each other, i.e. the 'model' -### object must have defined a distribution in @dist that +### object must have defined a distribution in @dist that ### conforms with the dimension @r of the #fdata' object. -".check.fdata.model.Dataclass" <- function(fdata.obj, model.obj) -{ - if (class(fdata.obj) != "fdata") { - stop(paste("Wrong argument in 'dataclass()'. First ", - "argument must be an object of class 'fdata'", - sep = "")) - } - .valid.Fdata(fdata.obj) - hasY(fdata.obj, verbose = TRUE) +".check.fdata.model.Dataclass" <- function(fdata.obj, model.obj) { + if (class(fdata.obj) != "fdata") { + stop(paste("Wrong argument in 'dataclass()'. First ", + "argument must be an object of class 'fdata'", + sep = "" + )) + } + .valid.Fdata(fdata.obj) + hasY(fdata.obj, verbose = TRUE) } ### Check model: 'model' must be an object of class 'model'. ### Furthermore, it must be valid and contain specified ### parameters in @par and weights in @weight. -".check.model.Dataclass" <- function(model.obj) -{ - if (class(model.obj) != "model") { - stop(paste("Wrong argument in 'dataclass()'. Second ", - "argument must be an object of class 'model'.", - sep = "")) - } - .valid.Model(model.obj) - hasPar(model.obj, verbose = TRUE) - hasWeight(model.obj, verbose = TRUE) +".check.model.Dataclass" <- function(model.obj) { + if (class(model.obj) != "model") { + stop(paste("Wrong argument in 'dataclass()'. Second ", + "argument must be an object of class 'model'.", + sep = "" + )) + } + .valid.Model(model.obj) + hasPar(model.obj, verbose = TRUE) + hasWeight(model.obj, verbose = TRUE) } ### Check indicators: Indicators must have as many different factors ### as @K in the 'model' object. Further, values must be out of the ### sequence 1, ..., K. -".check.S.Dataclass" <- function(fdata.obj, model.obj) -{ - values <- levels(as.factor(fdata.obj@S)) - if (!identical(range(fdata.obj@S), range(seq(1, model.obj@K)))) { - stop(paste("Wrong specification of slot 'S' in 'fdata' ", - "object. Indicators must have integer values ", - "in the range 1 to slot 'K' of 'model' object.", - sep = "")) - } +".check.S.Dataclass" <- function(fdata.obj, model.obj) { + values <- levels(as.factor(fdata.obj@S)) + if (!identical(range(fdata.obj@S), range(seq(1, model.obj@K)))) { + stop(paste("Wrong specification of slot 'S' in 'fdata' ", + "object. Indicators must have integer values ", + "in the range 1 to slot 'K' of 'model' object.", + sep = "" + )) + } } -".check.Logdet.Norstud" <- function(model.obj) -{ - has.sigmainv <- "sigmainv" %in% names(model.obj@par) - has.logdet <- "logdet" %in% names(model.obj@par) - if(has.sigmainv && has.logdet) { - return(model.obj) - } else { - qinv <- array(0, dim = c(r,r,K)) - logdetq <- array(0, dim = c(1, K)) - for(k in 1:K) { - qinv[,,k] <- solve(model@par$sigma[,,k]) - logdetq[k] <- log(det(qinv[,,k])) - } - model.obj@par$qinv <- qinv - model.obj@par$logdetq <- logdetq - return(model.obj) +".check.Logdet.Norstud" <- function(model.obj) { + has.sigmainv <- "sigmainv" %in% names(model.obj@par) + has.logdet <- "logdet" %in% names(model.obj@par) + if (has.sigmainv && has.logdet) { + return(model.obj) + } else { + qinv <- array(0, dim = c(r, r, K)) + logdetq <- array(0, dim = c(1, K)) + for (k in 1:K) { + qinv[, , k] <- solve(model@par$sigma[, , k]) + logdetq[k] <- log(det(qinv[, , k])) } + model.obj@par$qinv <- qinv + model.obj@par$logdetq <- logdetq + return(model.obj) + } } ### Logic ### Logic liklist -### Compute the likelihood l(y_i|theta_k) for all i and k +### Compute the likelihood l(y_i|theta_k) for all i and k ### lik.list is a 'list' object containing ## -### 'lh' exp(llh - maxl), an N x K 'matrix' -### 'maxl' the maximum likelihood, an 1 x K 'vector' -### 'llh' the likelihood, a N x K 'matrix' -".liklist.Dataclass" <- function(fdata.obj, model.obj) -{ - K <- model.obj@K - N <- fdata.obj@N - dist <- model.obj@dist - datam <- getColY(fdata.obj) - if(dist == "normal") { - .likelihood.normal(datam, model.obj@par$mu, - model.obj@par$sigma) - } else if(dist == "student") { - .likelihood.student(datam, model.obj@par$mu, - model.obj@par$sigma, - model.obj@par$df) - } else if(dist == "exponential") { - .likelihood.exponential(datam, model.obj@par$lambda) - } else if(dist == "poisson" || dist == "cond.poisson") { - ## should give a N x K 'matrix' object - lambda <- model.obj@par$lambda - if (hasExp(fdata.obj)) { - expos <- getExp(fdata.obj) - lambda <- matrix(lambda, nrow = N, - ncol = K, byrow = TRUE) - lambda <- apply(lambda, 2, "*", expos) - } else { - lambda <- matrix(lambda, nrow = 1, - ncol = K) - } - .likelihood.poisson(datam, lambda) - } else if(dist == "binomial") { - .likelihood.binomial(datam, fdata.obj@T, model.obj@par$p) - } else if(dist == "normult") { - model.obj <- .check.Logdet.Norstud(model.obj) - .likelihood.normult(datam, model.obj@par$mu, - model.obj@par$sigmainv, - model.obj@par$logdet) - } else if(dist == "studmult") { - model.obj <- .check.Logdet.Norstud(model.obj) - .likelihood.studmult(datam, model.obj@par$mu, - model.obj@par$sigmainv, - model.obj@par$logdet, - model.obj@par$df) - } -} - -".multinomial.Dataclass" <- function(fdata.obj, model.obj, - lik.list, simS) -{ - N <- fdata.obj@N - K <- model.obj@K - mixlik.list <- .mixlik.Dataclass(model.obj, lik.list, - prob = TRUE) - mixlik <- mixlik.list$mixlik - p <- mixlik.list$p - if(simS && K > 1) { - sim.S <- .simulate.S.Dataclass(p, K, N) - S <- sim.S$S - postS <- sim.S$postS +### 'lh' exp(llh - maxl), an N x K 'matrix' +### 'maxl' the maximum likelihood, an 1 x K 'vector' +### 'llh' the likelihood, a N x K 'matrix' +".liklist.Dataclass" <- function(fdata.obj, model.obj) { + K <- model.obj@K + N <- fdata.obj@N + dist <- model.obj@dist + datam <- getColY(fdata.obj) + if (dist == "normal") { + .likelihood.normal( + datam, model.obj@par$mu, + model.obj@par$sigma + ) + } else if (dist == "student") { + .likelihood.student( + datam, model.obj@par$mu, + model.obj@par$sigma, + model.obj@par$df + ) + } else if (dist == "exponential") { + .likelihood.exponential(datam, model.obj@par$lambda) + } else if (dist == "poisson" || dist == "cond.poisson") { + ## should give a N x K 'matrix' object + lambda <- model.obj@par$lambda + if (hasExp(fdata.obj)) { + expos <- getExp(fdata.obj) + lambda <- matrix(lambda, + nrow = N, + ncol = K, byrow = TRUE + ) + lambda <- apply(lambda, 2, "*", expos) } else { - ## compute complete data likelihood in case - ## indicators were not simulated - if(hasS(fdata.obj) && K > 1) { - classm <- getColS(fdata.obj) - .check.S.Dataclass(fdata.obj, model.obj) - loglikcd <- matrix(0, nrow = 1, ncol = K) - for(k in seq(1, K)) { - loglikcd[k] <- sum(lik.list$llh[classm == k, k]) - } - } else { ## no indicators given or no mixture ## - loglikcd <- matrix(mixlik) - } - } - ## compute entropy - logp <- matrix(0, nrow = N, ncol = K) - for(k in seq(1, K)) { - logp[p[,k] == 0,k] <- -99 - logp[p[,k] != 0,k] <- log(p[p[,k] != 0, k]) + lambda <- matrix(lambda, + nrow = 1, + ncol = K + ) } - entropy <- (-1) * sum(logp * p) - if(simS) { - datac.obj <- .dataclass(logpy = lik.list$llh, - prob = p, mixlik = mixlik, - entropy = entropy, - loglikcd = matrix(), postS = postS) - l <- list(dataclass = datac.obj, S = as.integer(S)) - return(l) - } else { - .dataclass(logpy = lik.list$llh, - prob = p, mixlik = mixlik, - entropy = entropy, - loglikcd = loglikcd, postS = numeric()) - } - + .likelihood.poisson(datam, lambda) + } else if (dist == "binomial") { + .likelihood.binomial(datam, fdata.obj@T, model.obj@par$p) + } else if (dist == "normult") { + model.obj <- .check.Logdet.Norstud(model.obj) + .likelihood.normult( + datam, model.obj@par$mu, + model.obj@par$sigmainv, + model.obj@par$logdet + ) + } else if (dist == "studmult") { + model.obj <- .check.Logdet.Norstud(model.obj) + .likelihood.studmult( + datam, model.obj@par$mu, + model.obj@par$sigmainv, + model.obj@par$logdet, + model.obj@par$df + ) + } } -".mixlik.Dataclass" <- function(model.obj, lik.list, prob = FALSE) -{ - ## p is an N x K matrix ## - p <- t(apply(lik.list$lh, 1, "*", model.obj@weight)) - ## sump is an N x 1 matrix ## - sump <- apply(p, 1, sum) - ## lsump is an N x 1 matrix ## - lsump <- log(sump) + lik.list$maxl - mixlik <- sum(lsump) ## numeric - if (prob) { - ## p is the N x K probability classification matrix ## - p = apply(p, 2, "/", sump) - return(list(mixlik = mixlik, p = p)) - } else { - return(mixlik) +".multinomial.Dataclass" <- function(fdata.obj, model.obj, + lik.list, simS) { + N <- fdata.obj@N + K <- model.obj@K + mixlik.list <- .mixlik.Dataclass(model.obj, lik.list, + prob = TRUE + ) + mixlik <- mixlik.list$mixlik + p <- mixlik.list$p + if (simS && K > 1) { + sim.S <- .simulate.S.Dataclass(p, K, N) + S <- sim.S$S + postS <- sim.S$postS + } else { + ## compute complete data likelihood in case + ## indicators were not simulated + if (hasS(fdata.obj) && K > 1) { + classm <- getColS(fdata.obj) + .check.S.Dataclass(fdata.obj, model.obj) + loglikcd <- matrix(0, nrow = 1, ncol = K) + for (k in seq(1, K)) { + loglikcd[k] <- sum(lik.list$llh[classm == k, k]) + } + } else { ## no indicators given or no mixture ## + loglikcd <- matrix(mixlik) } + } + ## compute entropy + logp <- matrix(0, nrow = N, ncol = K) + for (k in seq(1, K)) { + logp[p[, k] == 0, k] <- -99 + logp[p[, k] != 0, k] <- log(p[p[, k] != 0, k]) + } + entropy <- (-1) * sum(logp * p) + if (simS) { + datac.obj <- .dataclass( + logpy = lik.list$llh, + prob = p, mixlik = mixlik, + entropy = entropy, + loglikcd = matrix(), postS = postS + ) + l <- list(dataclass = datac.obj, S = as.integer(S)) + return(l) + } else { + .dataclass( + logpy = lik.list$llh, + prob = p, mixlik = mixlik, + entropy = entropy, + loglikcd = loglikcd, postS = numeric() + ) + } } -".simulate.S.Dataclass" <- function(p, K, N) -{ - ## Simulate classifications from classification probability - ## matrix - rnd <- runif(N) - S <- t(apply(p, 1, cumsum)) < matrix(rnd, - nrow = length(rnd), - ncol = K) - S <- matrix(apply(S, 1, sum)) + 1 - Sm <- matrix(S, nrow = nrow(S), ncol = K) - Compm <- matrix(seq(1, K), nrow = nrow(S), ncol = K, byrow = TRUE) - postS <- sum(log(apply((Sm == Compm) * p, 1, sum))) - sim.S <- list(S = S, postS = postS) - return(sim.S) +".mixlik.Dataclass" <- function(model.obj, lik.list, prob = FALSE) { + ## p is an N x K matrix ## + p <- t(apply(lik.list$lh, 1, "*", model.obj@weight)) + ## sump is an N x 1 matrix ## + sump <- apply(p, 1, sum) + ## lsump is an N x 1 matrix ## + lsump <- log(sump) + lik.list$maxl + mixlik <- sum(lsump) ## numeric + if (prob) { + ## p is the N x K probability classification matrix ## + p <- apply(p, 2, "/", sump) + return(list(mixlik = mixlik, p = p)) + } else { + return(mixlik) + } } -".indicfix.Dataclass" <- function(fdata.obj, model.obj, lik.list) -{ - K <- model.obj@K - mixlik <- .mixlik.Dataclass(model.obj, lik.list) - if(hasS(fdata.obj) && K > 1) { - .check.S.Dataclass(fdata.obj, model.obj) - classm <- getColS(fdata.obj) - loglikcd <- matrix(0, nrow = 1, ncol = K) - for(k in seq(1, K)) { - loglikcd[k] <- sum(lik.list$llh[classm == k, k]) - } - } else { ## no indicators given or no mixture ## - loglikcd <- matrix(mixlik) - } - .dataclass(logpy = lik.list$llh, - prob = matrix(), mixlik = numeric(), - entropy = numeric(), - loglikcd = loglikcd, postS = numeric()) +".simulate.S.Dataclass" <- function(p, K, N) { + ## Simulate classifications from classification probability + ## matrix + rnd <- runif(N) + S <- t(apply(p, 1, cumsum)) < matrix(rnd, + nrow = length(rnd), + ncol = K + ) + S <- matrix(apply(S, 1, sum)) + 1 + Sm <- matrix(S, nrow = nrow(S), ncol = K) + Compm <- matrix(seq(1, K), nrow = nrow(S), ncol = K, byrow = TRUE) + postS <- sum(log(apply((Sm == Compm) * p, 1, sum))) + sim.S <- list(S = S, postS = postS) + return(sim.S) } +".indicfix.Dataclass" <- function(fdata.obj, model.obj, lik.list) { + K <- model.obj@K + mixlik <- .mixlik.Dataclass(model.obj, lik.list) + if (hasS(fdata.obj) && K > 1) { + .check.S.Dataclass(fdata.obj, model.obj) + classm <- getColS(fdata.obj) + loglikcd <- matrix(0, nrow = 1, ncol = K) + for (k in seq(1, K)) { + loglikcd[k] <- sum(lik.list$llh[classm == k, k]) + } + } else { ## no indicators given or no mixture ## + loglikcd <- matrix(mixlik) + } + .dataclass( + logpy = lik.list$llh, + prob = matrix(), mixlik = numeric(), + entropy = numeric(), + loglikcd = loglikcd, postS = numeric() + ) +} diff --git a/R/datamoments.R b/R/datamoments.R index 41e7c7d..42b8706 100644 --- a/R/datamoments.R +++ b/R/datamoments.R @@ -15,24 +15,25 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -## 'datamoments' is a virtual class from which the corresponding -## datamoments for 'continuous' and 'discrete' inherit -.datamoments <- setClass("datamoments", - representation(mean = "numeric", - var = "matrix", - fdata = "fdata", - "VIRTUAL" - ) +## 'datamoments' is a virtual class from which the corresponding +## datamoments for 'continuous' and 'discrete' inherit +.datamoments <- setClass( + "datamoments", + representation( + mean = "numeric", + var = "matrix", + fdata = "fdata", + "VIRTUAL" + ) ) ## mutual constructor for all type of datamoments ## -"datamoments" <- function(value = fdata()) -{ - hasY(value, verbose = TRUE) - if (value@type == "continuous") { - .Object <- .cdatamoments(value = value) - } else { - .Object <- .ddatamoments(value = value) - } - return(.Object) +"datamoments" <- function(value = fdata()) { + hasY(value, verbose = TRUE) + if (value@type == "continuous") { + .Object <- .cdatamoments(value = value) + } else { + .Object <- .ddatamoments(value = value) + } + return(.Object) } diff --git a/R/ddatamoments.R b/R/ddatamoments.R index e81a9a9..2e61d98 100644 --- a/R/ddatamoments.R +++ b/R/ddatamoments.R @@ -16,94 +16,110 @@ # along with finmix. If not, see . .ddatamoments <- setClass("ddatamoments", - representation(factorial = "array", - over = "vector", - zero = "vector", - smoments = "sdatamomentsOrNULL"), - contains = c("datamoments"), - validity = function(object) - { - ## else: ok - TRUE - }, - prototype(factorial = array(), - over = vector(), - zero = vector(), - smoments = .sdatamoments() - ) + representation( + factorial = "array", + over = "vector", + zero = "vector", + smoments = "sdatamomentsOrNULL" + ), + contains = c("datamoments"), + validity = function(object) { + ## else: ok + TRUE + }, + prototype( + factorial = array(), + over = vector(), + zero = vector(), + smoments = .sdatamoments() + ) ) -setMethod("initialize", "ddatamoments", - function(.Object, ..., value = fdata()) - { - .Object@fdata <- value - if (hasS(value)) { - .Object@smoments <- sdatamoments(value) - } else { - .Object@smoments <- NULL - } - generateMoments(.Object) - } +setMethod( + "initialize", "ddatamoments", + function(.Object, ..., value = fdata()) { + .Object@fdata <- value + if (hasS(value)) { + .Object@smoments <- sdatamoments(value) + } else { + .Object@smoments <- NULL + } + generateMoments(.Object) + } ) ## Generic set in 'groupmoments.R' ## -setMethod("generateMoments", "ddatamoments", - function(object) - { - .generateDdatamoments(object) - } +setMethod( + "generateMoments", "ddatamoments", + function(object) { + .generateDdatamoments(object) + } ) -setMethod("show", "ddatamoments", - function(object) - { - cat("Object 'datamoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var : Vector of", - length(object@var), "\n") - cat(" factorial :", - paste(dim(object@factorial), collapse = "x"), "\n") - cat(" over : Vector of", - length(object@over), "\n") - cat(" zero : Vector of", - length(object@zero), "\n") - if (hasS(object@fdata)) { - cat(" smoments : Object of class", - class(object@smoments), "\n") - } - cat(" fdata : Object of class", - class(object@fdata), "\n") - } +setMethod( + "show", "ddatamoments", + function(object) { + cat("Object 'datamoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var : Vector of", + length(object@var), "\n" + ) + cat( + " factorial :", + paste(dim(object@factorial), collapse = "x"), "\n" + ) + cat( + " over : Vector of", + length(object@over), "\n" + ) + cat( + " zero : Vector of", + length(object@zero), "\n" + ) + if (hasS(object@fdata)) { + cat( + " smoments : Object of class", + class(object@smoments), "\n" + ) + } + cat( + " fdata : Object of class", + class(object@fdata), "\n" + ) + } ) ## Getters ## -setMethod("getSmoments", "ddatamoments", - function(object) - { - return(object@smoments) - } +setMethod( + "getSmoments", "ddatamoments", + function(object) { + return(object@smoments) + } ) -setMethod("getFactorial", "ddatamoments", - function(object) - { - return(object@factorial) - } +setMethod( + "getFactorial", "ddatamoments", + function(object) { + return(object@factorial) + } ) -setMethod("getOver", "ddatamoments", - function(object) - { - return(object@over) - } +setMethod( + "getOver", "ddatamoments", + function(object) { + return(object@over) + } ) -setMethod("getZero", "ddatamoments", - function(object) - { - return(object@zero) - } +setMethod( + "getZero", "ddatamoments", + function(object) { + return(object@zero) + } ) ## Setters ## @@ -111,30 +127,37 @@ setMethod("getZero", "ddatamoments", ### Private functions ### These functions are not exported -".generateDdatamoments" <- function(object) -{ - ## enforce column-wise ordering ## - hasY(object@fdata, verbose = TRUE) - datam <- getColY(object@fdata) - ## Compute factorial moments ## - ## fact.moments is a L x r array (L = 4) ## - momentsm <- array(NA, dim = c(4, object@fdata@r)) - means <- apply(datam, 2, mean, na.rm = TRUE) - object@mean <- means - object@var <- var(datam, na.rm = TRUE) - momentsm[1, ] <- t(means) - momentsm[2, ] <- apply(datam * apply(datam - 1, 2, max, 0), - 2, mean, na.rm = TRUE) - momentsm[3, ] <- apply(datam * apply(datam - 2, 2, max, 0), - 2, mean, na.rm = TRUE) - momentsm[4, ] <- apply(datam * apply(datam - 3, 2, max, 0), - 2, mean, na.rm = TRUE) - dimnames(momentsm) <- list(c("1st", "2nd", "3rd", "4th"), - colnames(datam)) - object@factorial <- momentsm - ## Overdispersions and fractions of zeros ## - ## over and zeros are r x 1 matrices ## - object@over <- diag(var(datam)) - means - object@zero <- apply(apply(datam, 2, "==", 0), 2, sum) - return(object) +".generateDdatamoments" <- function(object) { + ## enforce column-wise ordering ## + hasY(object@fdata, verbose = TRUE) + datam <- getColY(object@fdata) + ## Compute factorial moments ## + ## fact.moments is a L x r array (L = 4) ## + momentsm <- array(NA, dim = c(4, object@fdata@r)) + means <- apply(datam, 2, mean, na.rm = TRUE) + object@mean <- means + object@var <- var(datam, na.rm = TRUE) + momentsm[1, ] <- t(means) + momentsm[2, ] <- apply(datam * apply(datam - 1, 2, max, 0), + 2, mean, + na.rm = TRUE + ) + momentsm[3, ] <- apply(datam * apply(datam - 2, 2, max, 0), + 2, mean, + na.rm = TRUE + ) + momentsm[4, ] <- apply(datam * apply(datam - 3, 2, max, 0), + 2, mean, + na.rm = TRUE + ) + dimnames(momentsm) <- list( + c("1st", "2nd", "3rd", "4th"), + colnames(datam) + ) + object@factorial <- momentsm + ## Overdispersions and fractions of zeros ## + ## over and zeros are r x 1 matrices ## + object@over <- diag(var(datam)) - means + object@zero <- apply(apply(datam, 2, "==", 0), 2, sum) + return(object) } diff --git a/R/distributions.R b/R/distributions.R index 7a7f472..b4a5d2a 100644 --- a/R/distributions.R +++ b/R/distributions.R @@ -16,8 +16,7 @@ # along with finmix. If not, see . "dstud" <- function(x, mu, sigma, df) { - - fun <- gamma((df + 1)/2)/(gamma(df/2)*sqrt(df * pi * sigma)) * (1 + (x - mu)^2/(df * sigma))^(-(df + 1)/2) + fun <- gamma((df + 1) / 2) / (gamma(df / 2) * sqrt(df * pi * sigma)) * (1 + (x - mu)^2 / (df * sigma))^(-(df + 1) / 2) - return(fun) + return(fun) } diff --git a/R/dmodelmoments.R b/R/dmodelmoments.R index 04c39b9..234e9b8 100644 --- a/R/dmodelmoments.R +++ b/R/dmodelmoments.R @@ -15,39 +15,36 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.dmodelmoments <- setClass("dmodelmoments", - representation( - over = "numeric", - factorial = "array", - zero = "numeric" - ), - contains = c("modelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype( - over = numeric(), - factorial = array(), - zero = numeric() - ) +.dmodelmoments <- setClass("dmodelmoments", + representation( + over = "numeric", + factorial = "array", + zero = "numeric" + ), + contains = c("modelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + over = numeric(), + factorial = array(), + zero = numeric() + ) ) ## Getters ## setMethod("getOver", "dmodelmoments", function(object) { - return(object@over) - } -) + return(object@over) +}) setMethod("getFactorial", "dmodelmoments", function(object) { - return(object@factorial) - } -) + return(object@factorial) +}) setMethod("getZero", "dmodelmoments", function(object) { - return(object@zero) - } -) + return(object@zero) +}) ## Setters ## ## No setters as users should not manipulate a 'dmodelmoments' object ## diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index a6cab40..0089054 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -16,95 +16,105 @@ # along with finmix. If not, see . .exponentialmodelmoments <- setClass("exponentialmodelmoments", - representation(B = "numeric", - W = "numeric", - R = "numeric"), - contains = c("cmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype(B = numeric(), - W = numeric(), - R = numeric() - ) + representation( + B = "numeric", + W = "numeric", + R = "numeric" + ), + contains = c("cmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + B = numeric(), + W = numeric(), + R = numeric() + ) ) -setMethod("initialize", "exponentialmodelmoments", - function(.Object, ..., model) - { - .Object <- callNextMethod(.Object, ..., model = model) - generateMoments(.Object) - } +setMethod( + "initialize", "exponentialmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + generateMoments(.Object) + } ) -setMethod("generateMoments", "exponentialmodelmoments", - function(object) - { - .generateMomentsExponential(object) - } +setMethod( + "generateMoments", "exponentialmodelmoments", + function(object) { + .generateMomentsExponential(object) + } ) -setMethod("show", "exponentialmodelmoments", - function(object) { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" higher :", - paste(dim(object@higher), collapse = "x"), - "\n") - cat(" skewness :", object@skewness, "\n") - cat(" kurtosis :", object@kurtosis, "\n") - cat(" B :", object@B, "\n") - cat(" W :", object@W, "\n") - cat(" R :", object@R, "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "exponentialmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " higher :", + paste(dim(object@higher), collapse = "x"), + "\n" + ) + cat(" skewness :", object@skewness, "\n") + cat(" kurtosis :", object@kurtosis, "\n") + cat(" B :", object@B, "\n") + cat(" W :", object@W, "\n") + cat(" R :", object@R, "\n") + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) -setMethod("getB", "exponentialmodelmoments", - function(object) - { - return(object@B) - } +setMethod( + "getB", "exponentialmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getW", "exponentialmodelmoments", - function(object) - { - return(object@W) - } +setMethod( + "getW", "exponentialmodelmoments", + function(object) { + return(object@W) + } ) -setMethod("getR", "exponentialmodelmoments", - function(object) - { - return(object@R) - } +setMethod( + "getR", "exponentialmodelmoments", + function(object) { + return(object@R) + } ) ## No setters as users are not intended to manipulate ## ## this object ## -### Private functions -### These functions are not exported -".generateMomentsExponential" <- function(object) -{ - lambda <- object@model@par$lambda - weight <- object@model@weight - object@mean <- sum(weight * 1/lambda) - highm <- .mixturemoments.exponential(object@model, 4, object@mean) - dimnames(highm) <- list(c("1st", "2nd", "3rd", "4th"), "") - object@higher <- highm - object@var <- array(object@higher[2], dim = c(1, 1)) - object@skewness <- object@higher[3]/object@higher[2]^1.5 - object@kurtosis <- object@higher[4]/object@higher[2]^2 - object@W <- sum(weight * 1/lambda^2) - object@B <- sum(weight * (1/lambda - object@mean)^2) - object@R <- 1 - object@W/object@var[1] - return(object) +### Private functions +### These functions are not exported +".generateMomentsExponential" <- function(object) { + lambda <- object@model@par$lambda + weight <- object@model@weight + object@mean <- sum(weight * 1 / lambda) + highm <- .mixturemoments.exponential(object@model, 4, object@mean) + dimnames(highm) <- list(c("1st", "2nd", "3rd", "4th"), "") + object@higher <- highm + object@var <- array(object@higher[2], dim = c(1, 1)) + object@skewness <- object@higher[3] / object@higher[2]^1.5 + object@kurtosis <- object@higher[4] / object@higher[2]^2 + object@W <- sum(weight * 1 / lambda^2) + object@B <- sum(weight * (1 / lambda - object@mean)^2) + object@R <- 1 - object@W / object@var[1] + return(object) } - diff --git a/R/fdata.R b/R/fdata.R index 87c1475..caca1fc 100644 --- a/R/fdata.R +++ b/R/fdata.R @@ -15,123 +15,136 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.fdata <- setClass("fdata", - representation (y = "matrix", - N = "integer", - r = "integer", - S = "matrix", - bycolumn = "logical", - name = "character", - type = "character", - sim = "logical", - exp = "matrix", - T = "matrix" - ), - validity = function (object) - { - .valid.Fdata(object) - ## else: ok - TRUE - }, - prototype(y = matrix(), - N = integer(), - r = integer(), - S = matrix(), - bycolumn = logical(), - name = character(), - type = "discrete", - sim = logical(), - exp = matrix(), - T = matrix() - ) +.fdata <- setClass("fdata", + representation( + y = "matrix", + N = "integer", + r = "integer", + S = "matrix", + bycolumn = "logical", + name = "character", + type = "character", + sim = "logical", + exp = "matrix", + T = "matrix" + ), + validity = function(object) { + .valid.Fdata(object) + ## else: ok + TRUE + }, + prototype( + y = matrix(), + N = integer(), + r = integer(), + S = matrix(), + bycolumn = logical(), + name = character(), + type = "discrete", + sim = logical(), + exp = matrix(), + T = matrix() + ) ) ## Constructor for the data class ## -"fdata" <- function(y = matrix(), N = 1, r = 1, S = matrix(), - bycolumn = TRUE, name = character(), - type = "discrete", sim = FALSE, - exp = matrix(), T = matrix()) -{ - y <- as.matrix(y) - .check.y.Fdata(y) - if(missing(type)) { - type <- .check.type.Fdata(y) - } - if (missing(bycolumn)) { - bycolumn <- .check.bycolumn.Fdata(y, S, exp, T) - } - if (missing(N)) { - N <- .check.N.Fdata(y, S, exp, T, bycolumn) - } else { - N <- as.integer(N) +"fdata" <- function(y = matrix(), N = 1, r = 1, S = matrix(), + bycolumn = TRUE, name = character(), + type = "discrete", sim = FALSE, + exp = matrix(), T = matrix()) { + y <- as.matrix(y) + .check.y.Fdata(y) + if (missing(type)) { + type <- .check.type.Fdata(y) + } + if (missing(bycolumn)) { + bycolumn <- .check.bycolumn.Fdata(y, S, exp, T) + } + if (missing(N)) { + N <- .check.N.Fdata(y, S, exp, T, bycolumn) + } else { + N <- as.integer(N) + } + if (missing(r)) { + r <- .check.r.Fdata(y, bycolumn) + } else { + r <- as.integer(r) + } + if (!all(is.na(S))) { + S <- .check.S.Fdata(S) + } else { + storage.mode(S) <- "integer" + } + if (!all(is.na(exp))) { + exp <- .check.exp.Fdata(exp) + } + if (!all(is.na(T))) { + T <- .check.T.Fdata(T) + } else { + storage.mode(T) <- "integer" + } + .fdata( + y = y, N = N, r = r, S = S, + bycolumn = bycolumn, name = name, + type = type, sim = sim, exp = exp, + T = T + ) +} + +setMethod( + "plot", signature( + x = "fdata", + y = "missing" + ), + function(x, y, dev = TRUE, ...) { + hasY(x, verbose = TRUE) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") } - if (missing(r)) { - r <- .check.r.Fdata(y, bycolumn) - } else { - r <- as.integer(r) + if (x@type == "discrete") { + .plot.discrete.Fdata(x) + } else { ## continuous + .plot.continuous.Fdata(x, dev) } - if (!all(is.na(S))) { - S <- .check.S.Fdata(S) - } else { - storage.mode(S) <- "integer" + } +) + +setMethod( + "show", "fdata", + function(object) { + name <- ifelse(length(object@name) == 0, "fdata", + object@name + ) + cat("Object '", name, "'\n", sep = "") + cat(" class :", class(object), "\n") + cat( + " y :", + paste(dim(object@y), collapse = "x"), "\n" + ) + cat(" bycolumn :", object@bycolumn, "\n") + cat(" N :", object@N, "\n") + cat(" r :", object@r, "\n") + if (hasS(object)) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) } - if (!all(is.na(exp))) { - exp <- .check.exp.Fdata(exp) + cat(" type :", object@type, "\n") + cat(" sim :", object@sim, "\n") + if (hasExp(object)) { + cat( + " exp :", + paste(dim(object@exp), collapse = "x"), "\n" + ) } - if (!all(is.na(T))) { - T <- .check.T.Fdata(T) - } else { - storage.mode(T) <- "integer" + if (hasT(object)) { + cat( + " T :", + paste(dim(object@T), collapse = "x"), "\n" + ) } - .fdata(y = y, N = N, r = r, S = S, - bycolumn = bycolumn, name = name, - type = type, sim = sim, exp = exp, - T = T) -} - -setMethod("plot", signature(x = "fdata", - y = "missing"), - function(x, y, dev = TRUE, ...) - { - hasY(x, verbose = TRUE) - if (.check.grDevice() && dev) { - dev.new(title = "Histograms") - } - if (x@type == "discrete") { - .plot.discrete.Fdata(x) - } else { ## continuous - .plot.continuous.Fdata(x, dev) - } - } -) - -setMethod("show", "fdata", - function(object) - { - name <- ifelse(length(object@name) == 0, 'fdata', - object@name) - cat("Object '", name, "'\n", sep = "") - cat(" class :", class(object), "\n") - cat(" y :", - paste(dim(object@y), collapse = "x"), "\n") - cat(" bycolumn :", object@bycolumn, "\n") - cat(" N :", object@N, "\n") - cat(" r :", object@r, "\n") - if (hasS(object)) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" type :", object@type, "\n") - cat(" sim :", object@sim, "\n") - if (hasExp(object)) { - cat(" exp :", - paste(dim(object@exp), collapse = "x"), "\n") - } - if (hasT(object)) { - cat(" T :", - paste(dim(object@T), collapse = "x"), "\n") - } - } + } ) ### Has @@ -139,784 +152,819 @@ setMethod("show", "fdata", ### TRUE if it is not NA and FALSE if it is NA. ### If argument 'verbose' is set to TRUE, an error is thrown, if ### the 'fdata' object has not the questioned slot filled. -setMethod("hasY", "fdata", - function(object, verbose = FALSE) { - if (!all(is.na(object@y))) { - return(TRUE) - } else { - if (verbose) { - stop(paste("Slot 'y' in 'fdata' object ", - "is empty.", sep = "")) - } else { - return(FALSE) - } - } - } +setMethod( + "hasY", "fdata", + function(object, verbose = FALSE) { + if (!all(is.na(object@y))) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Slot 'y' in 'fdata' object ", + "is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) -setMethod("hasS", "fdata", - function(object, verbose = FALSE) - { - if (!all(is.na(object@S))) { - return(TRUE) - } else { - if (verbose) { - stop(paste("Slot 'S' in 'fdata' object ", - "is empty.", sep = "")) - } else { - return(FALSE) - } - } - } +setMethod( + "hasS", "fdata", + function(object, verbose = FALSE) { + if (!all(is.na(object@S))) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Slot 'S' in 'fdata' object ", + "is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) -setMethod("hasExp", "fdata", - function(object, verbose = FALSE) - { - if (!all(is.na(object@exp))) { - return(TRUE) - } else { - if (verbose) { - stop(paste("Slot 'exp' in 'fdata' object ", - "is empty.", sep = "")) - } else { - return(FALSE) - } - } - } +setMethod( + "hasExp", "fdata", + function(object, verbose = FALSE) { + if (!all(is.na(object@exp))) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Slot 'exp' in 'fdata' object ", + "is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) -setMethod("hasT", "fdata", - function(object, verbose = FALSE) - { - if (!all(is.na(object@T))) { - return(TRUE) - } else { - if (verbose) { - stop(paste("Slot @T in 'fdata' object ", - "is empty.", sep = "")) - } else { - return(FALSE) - } - } - } +setMethod( + "hasT", "fdata", + function(object, verbose = FALSE) { + if (!all(is.na(object@T))) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Slot @T in 'fdata' object ", + "is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) ### getCol/getRow: These methods return the data in the slots @y, -### @S, @exp and @T either as column-ordered or ro-ordered matrix. -setMethod("getColY", "fdata", - function(object) - { - if (object@bycolumn) { - return(object@y) - } else { - return(t(object@y)) - } - } +### @S, @exp and @T either as column-ordered or ro-ordered matrix. +setMethod( + "getColY", "fdata", + function(object) { + if (object@bycolumn) { + return(object@y) + } else { + return(t(object@y)) + } + } ) -setMethod("getRowY", "fdata", - function(object) - { - if (object@bycolumn) { - return(t(object@y)) - } else { - return(object@y) - } - } +setMethod( + "getRowY", "fdata", + function(object) { + if (object@bycolumn) { + return(t(object@y)) + } else { + return(object@y) + } + } ) -setMethod("getColS", "fdata", - function(object) - { - if (object@bycolumn) { - return(object@S) - } else { - return(t(object@S)) - } - } +setMethod( + "getColS", "fdata", + function(object) { + if (object@bycolumn) { + return(object@S) + } else { + return(t(object@S)) + } + } ) -setMethod("getRowS", "fdata", - function(object) - { - if (object@bycolumn) { - return(t(object@S)) - } else { - return(object@S) - } - } +setMethod( + "getRowS", "fdata", + function(object) { + if (object@bycolumn) { + return(t(object@S)) + } else { + return(object@S) + } + } ) -setMethod("getColExp", "fdata", - function(object) - { - if (object@bycolumn) { - return(object@exp) - } else { - return(t(object@exp)) - } - } +setMethod( + "getColExp", "fdata", + function(object) { + if (object@bycolumn) { + return(object@exp) + } else { + return(t(object@exp)) + } + } ) -setMethod("getRowExp", "fdata", - function(object) - { - if (object@bycolumn) { - return(t(object@exp)) - } else { - return(object@exp) - } - } +setMethod( + "getRowExp", "fdata", + function(object) { + if (object@bycolumn) { + return(t(object@exp)) + } else { + return(object@exp) + } + } ) -setMethod("getColT", "fdata", - function(object) - { - if (object@bycolumn) { - return(object@T) - } else { - return(t(object@T)) - } - } +setMethod( + "getColT", "fdata", + function(object) { + if (object@bycolumn) { + return(object@T) + } else { + return(t(object@T)) + } + } ) -setMethod("getRowT", "fdata", - function(object) - { - if (object@bycolumn) { - return(t(object@T)) - } else { - return(object@T) - } - } +setMethod( + "getRowT", "fdata", + function(object) { + if (object@bycolumn) { + return(t(object@T)) + } else { + return(object@T) + } + } ) -## Setters and Getters as a user interface to manipulate the slots -## Combined Getter and Setter -setMethod("getY", "fdata", - function(object) - { - return(object@y) - } +## Setters and Getters as a user interface to manipulate the slots +## Combined Getter and Setter +setMethod( + "getY", "fdata", + function(object) { + return(object@y) + } ) - -setMethod("getN", "fdata", - function(object) - { - return(object@N) - } + +setMethod( + "getN", "fdata", + function(object) { + return(object@N) + } ) -setMethod("getR", "fdata", - function(object) - { - return(object@r) - } +setMethod( + "getR", "fdata", + function(object) { + return(object@r) + } ) -setMethod("getS", "fdata", - function(object) - { - return(object@S) - } +setMethod( + "getS", "fdata", + function(object) { + return(object@S) + } ) -setMethod("getBycolumn", "fdata", - function(object) - { - return(object@bycolumn) - } +setMethod( + "getBycolumn", "fdata", + function(object) { + return(object@bycolumn) + } ) -setMethod("getName", "fdata", - function(object) - { - return(object@name) - } +setMethod( + "getName", "fdata", + function(object) { + return(object@name) + } ) -setMethod("getType", "fdata", - function(object) - { - return(object@type) - } +setMethod( + "getType", "fdata", + function(object) { + return(object@type) + } ) -setMethod("getSim", "fdata", - function(object) - { - return(object@sim) - } +setMethod( + "getSim", "fdata", + function(object) { + return(object@sim) + } ) -setMethod("getExp", "fdata", - function(object) - { - return(object@exp) - } +setMethod( + "getExp", "fdata", + function(object) { + return(object@exp) + } ) -setMethod("getT", "fdata", - function(object) - { - return(object@T) - } +setMethod( + "getT", "fdata", + function(object) { + return(object@T) + } ) ## Setters ## -setReplaceMethod("setY", "fdata", - function(object, value) - { - value <- as.matrix(value) - .check.y.Fdata(value) - if(object@bycolumn && NROW(value) < NCOL(value)) { - object@y <- t(value) - } - else { - object@y <- value - } - if(object@bycolumn){ - object@N <- NROW(object@y) - object@r <- NCOL(object@y) - } - else { - object@N <- NCOL(object@y) - object@r <- NROW(object@y) - } - .init.valid.Fdata(object) - return(object) - } +setReplaceMethod( + "setY", "fdata", + function(object, value) { + value <- as.matrix(value) + .check.y.Fdata(value) + if (object@bycolumn && NROW(value) < NCOL(value)) { + object@y <- t(value) + } else { + object@y <- value + } + if (object@bycolumn) { + object@N <- NROW(object@y) + object@r <- NCOL(object@y) + } else { + object@N <- NCOL(object@y) + object@r <- NROW(object@y) + } + .init.valid.Fdata(object) + return(object) + } ) -setReplaceMethod("setN", "fdata", - function(object, value) - { - object@N <- as.integer(value) - init.valid.Fdata(object) - return(object) - } +setReplaceMethod( + "setN", "fdata", + function(object, value) { + object@N <- as.integer(value) + init.valid.Fdata(object) + return(object) + } ) -setReplaceMethod("setR", "fdata", - function(object, value) - { - object@r <- as.integer(value) - .init.valid.Fdata(object) - return(object) - } +setReplaceMethod( + "setR", "fdata", + function(object, value) { + object@r <- as.integer(value) + .init.valid.Fdata(object) + return(object) + } ) -setReplaceMethod("setS", "fdata", - function(object, value) - { - value <- .check.S.Fdata(value) - if (object@bycolumn && NROW(value) > NCOL(value)) { - object@S <- value - } else { - object@S <- t(value) - } - .init.valid.Fdata(object) - return(object) - } +setReplaceMethod( + "setS", "fdata", + function(object, value) { + value <- .check.S.Fdata(value) + if (object@bycolumn && NROW(value) > NCOL(value)) { + object@S <- value + } else { + object@S <- t(value) + } + .init.valid.Fdata(object) + return(object) + } ) -setReplaceMethod("setBycolumn", "fdata", - function(object, value) - { - .check.setBycolumn.Fdata(value) - tmp.bycolumn <- object@bycolumn - if (tmp.bycolumn != value) { - object@bycolumn <- value - if (!all(is.na(object@y))) { - object@y <- t(object@y) - } - if (!all(is.na(object@S))) { - object@S <- t(object@S) - } - if (!all(is.na(object@exp))) { - object@exp <- t(object@exp) - } - if (!all(is.na(object@T))) { - object@T <- t(object@T) - } - } - .init.valid.Fdata(object) - return(object) - } -) +setReplaceMethod( + "setBycolumn", "fdata", + function(object, value) { + .check.setBycolumn.Fdata(value) + tmp.bycolumn <- object@bycolumn + if (tmp.bycolumn != value) { + object@bycolumn <- value + if (!all(is.na(object@y))) { + object@y <- t(object@y) + } + if (!all(is.na(object@S))) { + object@S <- t(object@S) + } + if (!all(is.na(object@exp))) { + object@exp <- t(object@exp) + } + if (!all(is.na(object@T))) { + object@T <- t(object@T) + } + } + .init.valid.Fdata(object) + return(object) + } +) -setReplaceMethod("setName", "fdata", - function(object, value) - { - object@name <- as.character(value) - return(object) - } +setReplaceMethod( + "setName", "fdata", + function(object, value) { + object@name <- as.character(value) + return(object) + } ) -setReplaceMethod("setType", "fdata", - function(object, value) - { - object@type <- as.character(value) - .valid.type.Fdata(object) - return(object) - } +setReplaceMethod( + "setType", "fdata", + function(object, value) { + object@type <- as.character(value) + .valid.type.Fdata(object) + return(object) + } ) -setReplaceMethod("setSim", "fdata", - function(object, value) - { - .check.setSim.Fdata(value) - object@sim <- value - return(object) - } +setReplaceMethod( + "setSim", "fdata", + function(object, value) { + .check.setSim.Fdata(value) + object@sim <- value + return(object) + } ) -setReplaceMethod("setExp", "fdata", - function(object, value) - { - value <- matrix(value) - value <- .check.exp.Fdata(value) - if (object@bycolumn && NROW(value) > NCOL(value)) { - object@exp <- value - } else { - object@exp <- t(value) - } - .init.valid.Fdata(object) - return(object) - } +setReplaceMethod( + "setExp", "fdata", + function(object, value) { + value <- matrix(value) + value <- .check.exp.Fdata(value) + if (object@bycolumn && NROW(value) > NCOL(value)) { + object@exp <- value + } else { + object@exp <- t(value) + } + .init.valid.Fdata(object) + return(object) + } ) -setReplaceMethod("setT", "fdata", - function(object, value) - { - value <- matrix(value) - value <- .check.T.Fdata(value) - if (object@bycolumn && NROW(value) > NCOL(value)) { - object@T <- value - } else { - object@T <- t(value) - } - .init.valid.Fdata(object) - return(object) - } +setReplaceMethod( + "setT", "fdata", + function(object, value) { + value <- matrix(value) + value <- .check.T.Fdata(value) + if (object@bycolumn && NROW(value) > NCOL(value)) { + object@T <- value + } else { + object@T <- t(value) + } + .init.valid.Fdata(object) + return(object) + } ) ### Private functions. ### These functions are not exported. ### Checking. -### Check data: The data @y has to either of type 'integer' -### or of type 'numeric'. -".check.y.Fdata" <- function(y) -{ - if (!all(is.na(y))) { - ## Only data of type 'numeric' or - ## 'integer' is accepted. - if (!is.numeric(y) && !is.integer(y)) { - stop(paste("Argument 'y' must be of type ", - "'numeric' or 'integer'.", sep = "")) - } +### Check data: The data @y has to either of type 'integer' +### or of type 'numeric'. +".check.y.Fdata" <- function(y) { + if (!all(is.na(y))) { + ## Only data of type 'numeric' or + ## 'integer' is accepted. + if (!is.numeric(y) && !is.integer(y)) { + stop(paste("Argument 'y' must be of type ", + "'numeric' or 'integer'.", + sep = "" + )) } + } } -### Check type: The type @type has to be either 'discrete' or +### Check type: The type @type has to be either 'discrete' or ### 'continuous'. If @y is of storage mode 'integer' @type ### is set to 'discrete', else 'continuous'. ### If @y is NA for all entries, the type is the default: ### 'discrete'. -".check.type.Fdata" <- function(y) -{ - if(!all(is.na(y))) { - if (is.integer(y)) { - return("discrete") - } else { - return("continuous") - } +".check.type.Fdata" <- function(y) { + if (!all(is.na(y))) { + if (is.integer(y)) { + return("discrete") } else { - return("discrete") + return("continuous") } + } else { + return("discrete") + } } ### Check bycolumn: The data is stored either by row or by column. ### If the data in @y has more rows than columns, it is assumed, ### that it must be stored by column. Otherwise, it is assumed, -### that it must be stored by row. -### If rows are equal or less than columns, @bycolumn is set to +### that it must be stored by row. +### If rows are equal or less than columns, @bycolumn is set to ### FALSE. ### If the data in @y is empty, it is checked in the same way if ### bycolumn can be derived from @S, @exp or @T. If any data slot is ### emtpy the default is used: TRUE. -".check.bycolumn.Fdata" <- function(y, S, exp, T) -{ - if (!all(is.na(y))) { - if (NROW(y) > NCOL(y)) { - return(TRUE) +".check.bycolumn.Fdata" <- function(y, S, exp, T) { + if (!all(is.na(y))) { + if (NROW(y) > NCOL(y)) { + return(TRUE) + } else { + return(FALSE) + } + } else { + if (!all(is.na(S))) { + if (NROW(S) > NCOL(S)) { + return(TRUE) + } else { + return(FALSE) + } + } else { + if (!all(is.na(exp))) { + if (NROW(exp) > NCOL(exp)) { + return(TRUE) } else { - return(FALSE) + return(FALSE) } - } else { - if (!all(is.na(S))) { - if (NROW(S) > NCOL(S)) { - return(TRUE) - } else { - return(FALSE) - } + } else { + if (!all(is.na(T))) { + if (NROW(T) > NCOL(T)) { + return(TRUE) + } else { + return(FALSE) + } } else { - if (!all(is.na(exp))) { - if (NROW(exp) > NCOL(exp)) { - return(TRUE) - } else { - return(FALSE) - } - } else { - if (!all(is.na(T))) { - if (NROW(T) > NCOL(T)) { - return(TRUE) - } else { - return(FALSE) - } - } else { - return(TRUE) - } - } + return(TRUE) } + } } + } } ### Check N: The number of observations @N of the dataset @y is ### set after @bycolumn. So, if @bycolumn is TRUE, the rows are ### assumed to be the number of observations. Otherwise, columns ### of @y are assumed to define @N. -".check.N.Fdata" <- function(y, S, exp, T, bycolumn) -{ - if (!all(is.na(y))) { +".check.N.Fdata" <- function(y, S, exp, T, bycolumn) { + if (!all(is.na(y))) { + if (bycolumn) { + NROW(y) + } else { + NCOL(y) + } + } else { + if (!all(is.na(S))) { + if (bycolumn) { + NROW(S) + } else { + NCOL(S) + } + } else { + if (!all(is.na(exp))) { if (bycolumn) { - NROW(y) + NROW(exp) } else { - NCOL(y) + NCOL(exp) } - } else { - if (!all(is.na(S))) { - if (bycolumn) { - NROW(S) - } else { - NCOL(S) - } + } else { + if (!all(is.na(T))) { + if (bycolumn) { + NROW(T) + } else { + NCOL(T) + } } else { - if (!all(is.na(exp))) { - if (bycolumn) { - NROW(exp) - } else { - NCOL(exp) - } - } else { - if (!all(is.na(T))) { - if(bycolumn) { - NROW(T) - } else { - NCOL(T) - } - } else { - return(as.integer(1)) - } - } + return(as.integer(1)) } + } } + } } ### Check r: The number @r of variables in the dataset @y is set ### after @bycolumn. So, if @bycolum is TRUE, the columns are assumed ### to determine the number of variables. Otherwise, rows of @y are ### assumed to define @r. -".check.r.Fdata" <- function(y, bycolumn) -{ - if (!all(is.na(y))) { - if (bycolumn) { - NCOL(y) - } else { - NROW(y) - } +".check.r.Fdata" <- function(y, bycolumn) { + if (!all(is.na(y))) { + if (bycolumn) { + NCOL(y) } else { - return(as.integer(1)) + NROW(y) } + } else { + return(as.integer(1)) + } } ### Check S: Indicators must be of type 'integer'. If this is the case -### the indicators are turned into a matrix object with storage mode +### the indicators are turned into a matrix object with storage mode ### 'integer'. -".check.S.Fdata" <- function( S ) -{ - if ( !all( is.na( S ) ) ) { - if ( !is.numeric( S ) ) { - stop( paste( "Wrong type of slot 'S' in 'fdata' object. ", - "Indicators must be of type 'integer'.", - sep = "" ) ) - } else { - S <- as.matrix( S ) - storage.mode( S ) <- "integer" - return( S ) - } +".check.S.Fdata" <- function(S) { + if (!all(is.na(S))) { + if (!is.numeric(S)) { + stop(paste("Wrong type of slot 'S' in 'fdata' object. ", + "Indicators must be of type 'integer'.", + sep = "" + )) } else { - return ( S ) + S <- as.matrix(S) + storage.mode(S) <- "integer" + return(S) } + } else { + return(S) + } } ### Check T: Repetitions must be of type 'integer'. If this is the case -### the repetitions are turned into a matrix object with storage mode +### the repetitions are turned into a matrix object with storage mode ### 'integer'. -".check.T.Fdata" <- function(T) -{ - if (!all(is.na(T))) { - if (!is.numeric(T)) { - stop(paste("Wrong type of slot 'T' in 'fdata' object. ", - "Repetitions must be of type 'integer'.", - sep = "")) - } else { - T <- as.matrix(T) - storage.mode(T) <- "integer" - return(T) - } - } +".check.T.Fdata" <- function(T) { + if (!all(is.na(T))) { + if (!is.numeric(T)) { + stop(paste("Wrong type of slot 'T' in 'fdata' object. ", + "Repetitions must be of type 'integer'.", + sep = "" + )) + } else { + T <- as.matrix(T) + storage.mode(T) <- "integer" + return(T) + } + } } -### Check exp: Exposures must be of of type 'numeric'. If this is +### Check exp: Exposures must be of of type 'numeric'. If this is ### the case exposures are turned into a matrix. -".check.exp.Fdata" <- function(exp) -{ - if (!all(is.na(exp))) { - if (!is.numeric(exp)) { - stop(paste("Wrong type of slot 'exp' in 'fdata' object. ", - "Exposures must be of type 'numeric'.", - sep = "")) - } else { - exp <- as.matrix(exp) - return(exp) - } - } +".check.exp.Fdata" <- function(exp) { + if (!all(is.na(exp))) { + if (!is.numeric(exp)) { + stop(paste("Wrong type of slot 'exp' in 'fdata' object. ", + "Exposures must be of type 'numeric'.", + sep = "" + )) + } else { + exp <- as.matrix(exp) + return(exp) + } + } } ### Check bycolumn: @bycolumn has to be of type 'logical'. If this is not -### the case an error is thrown. -".check.setBycolumn.Fdata" <- function(value) -{ - if (!is.logical(value)) { - stop(paste("Wrong specification of value for slot 'bycolumn' ", - "in 'fdata' object. 'bycolumn' must be of type ", - "'logical'.", sep = "")) - } +### the case an error is thrown. +".check.setBycolumn.Fdata" <- function(value) { + if (!is.logical(value)) { + stop(paste("Wrong specification of value for slot 'bycolumn' ", + "in 'fdata' object. 'bycolumn' must be of type ", + "'logical'.", + sep = "" + )) + } } ### Check sim: @sim has to be of type 'logical'. If this is not -### the case an error is thrown. -".check.setSim.Fdata" <- function(value) -{ - if (!is.logical(value)) { - stop(paste("Wrong specification of value for slot 'sim' ", - "in 'fdata' object. 'sim' must be of type ", - "'logical'.", sep = "")) - } +### the case an error is thrown. +".check.setSim.Fdata" <- function(value) { + if (!is.logical(value)) { + stop(paste("Wrong specification of value for slot 'sim' ", + "in 'fdata' object. 'sim' must be of type ", + "'logical'.", + sep = "" + )) + } } ### Plot functions -### Discrete data: Only univariate discrete data is +### Discrete data: Only univariate discrete data is ### is implemented. The functions plots a barplot. -### If the data in @y has names given, these names +### If the data in @y has names given, these names ### are used in the plot. -".plot.discrete.Fdata" <- function(obj) -{ - if (has.Y(obj, verbose = TRUE)) { - datam <- getColY(obj) - } - if (has.Exp(obj)) { - exp <- getColExp(obj) - datam <- datam * exp - } - barplot(table(datam), col = "gray65", - border = "white", cex = 0.7, - cex.axis = 0.7, xlab = "", main = "", - cex.lab = 0.7) - if (!is.null(colnames(datam))) { - col.names <- colnames(datam) - } else { - col.names <- c("") - } - mtext(side = 1, col.names, cex = 0.7, - line = 3) +".plot.discrete.Fdata" <- function(obj) { + if (has.Y(obj, verbose = TRUE)) { + datam <- getColY(obj) + } + if (has.Exp(obj)) { + exp <- getColExp(obj) + datam <- datam * exp + } + barplot(table(datam), + col = "gray65", + border = "white", cex = 0.7, + cex.axis = 0.7, xlab = "", main = "", + cex.lab = 0.7 + ) + if (!is.null(colnames(datam))) { + col.names <- colnames(datam) + } else { + col.names <- c("") + } + mtext( + side = 1, col.names, cex = 0.7, + line = 3 + ) } ### Continuous data: Either the data is one-dimensional or -### multi-dimensional. +### multi-dimensional. ### In the one-dimensional case a histogram of the data is -### plotted. +### plotted. ### In the two-dimensional case a bivariate kernel density -### estimation is used to return a contour plot and a +### estimation is used to return a contour plot and a ### perspective plot of the density. ### In the case of higher-dimensional data, the functions ### returns histograms for all variables in @y and a pairs -### diagram: a matrix containing scatter plots for all +### diagram: a matrix containing scatter plots for all ### variables' combinations. -".plot.continuous.Fdata" <- function(obj, dev) -{ - datam <- getColY(obj) - if (obj@r == 1) { - .symmetric.Hist(datam, colnames(datam)) - } else if (x@r == 2) { ## 2-dimensional - .symmetric.Hist(datam, colnames(datam)) - if (.check.grDevice() && dev) { - dev.new(title = "Contour plot") - } - par(mfrow = c(1, 2), mar = c(2, 2, 2, 3), - oma = c(4, 5, 1, 5)) - plot(datam[, 1], datam[, 2], col = "gray47", - cex = 0.7, cex.axis = 0.7, - pch = 20, xlab = "", ylab = "", - main = "") - mtext(side = 1, colnames(datam)[1], - cex = 0.7, line = 3) - mtext(side = 2, colnames(datam)[2], - cex = 0.7, line = 3) - d <- bkde2D(datam, - bandwidth = c(sd(datam[, 1]), - sd(datam[, 2]))) - contour(d$x1, d$x2, d$fhat, col = "gray47", - cex = 0.7, cex.axis = 0.7, - xlab = "", ylab = "") - mtext(side = 1, colnames(datam)[1], - cex = 0.7, line = 3) - mtext(side = 2, colnames(datam)[2], - cex = 0.7, line = 3) - if (.check.grDevice() && dev) { - dev.new("Perspective plot") - } - if (!is.null(colnames(datam))) { - col.names <- colnames(datam) - } else { - col.names <- c("", "") - } - persp(d$x1, d$x2, d$fhat, main = "", - xlab = col.names[1], ylab = col.names[2], - zlab = "", col = "gray65", - border = "gray47", theta = 55, phi = 30, - expand = 0.5, lphi = 190, ltheta = 90, - r = 40, d = 0.1, cex = 0.7, cex.axis = 0.7, - cex.lab = 0.7, ticktype = "detailed") - } else { ## multivariate distribution - .symmetric.Hist(datam, colnames(datam)) - if (.check.grDevice() && dev) { - dev.new(title = "Pairs") - } - pairs(datam, col = "gray47", pch = 20, - cex = 0.7, cex.axis = 0.7, cex.labels = 1.3) +".plot.continuous.Fdata" <- function(obj, dev) { + datam <- getColY(obj) + if (obj@r == 1) { + .symmetric.Hist(datam, colnames(datam)) + } else if (x@r == 2) { ## 2-dimensional + .symmetric.Hist(datam, colnames(datam)) + if (.check.grDevice() && dev) { + dev.new(title = "Contour plot") + } + par( + mfrow = c(1, 2), mar = c(2, 2, 2, 3), + oma = c(4, 5, 1, 5) + ) + plot(datam[, 1], datam[, 2], + col = "gray47", + cex = 0.7, cex.axis = 0.7, + pch = 20, xlab = "", ylab = "", + main = "" + ) + mtext( + side = 1, colnames(datam)[1], + cex = 0.7, line = 3 + ) + mtext( + side = 2, colnames(datam)[2], + cex = 0.7, line = 3 + ) + d <- bkde2D(datam, + bandwidth = c( + sd(datam[, 1]), + sd(datam[, 2]) + ) + ) + contour(d$x1, d$x2, d$fhat, + col = "gray47", + cex = 0.7, cex.axis = 0.7, + xlab = "", ylab = "" + ) + mtext( + side = 1, colnames(datam)[1], + cex = 0.7, line = 3 + ) + mtext( + side = 2, colnames(datam)[2], + cex = 0.7, line = 3 + ) + if (.check.grDevice() && dev) { + dev.new("Perspective plot") + } + if (!is.null(colnames(datam))) { + col.names <- colnames(datam) + } else { + col.names <- c("", "") + } + persp(d$x1, d$x2, d$fhat, + main = "", + xlab = col.names[1], ylab = col.names[2], + zlab = "", col = "gray65", + border = "gray47", theta = 55, phi = 30, + expand = 0.5, lphi = 190, ltheta = 90, + r = 40, d = 0.1, cex = 0.7, cex.axis = 0.7, + cex.lab = 0.7, ticktype = "detailed" + ) + } else { ## multivariate distribution + .symmetric.Hist(datam, colnames(datam)) + if (.check.grDevice() && dev) { + dev.new(title = "Pairs") } + pairs(datam, + col = "gray47", pch = 20, + cex = 0.7, cex.axis = 0.7, cex.labels = 1.3 + ) + } } ### Validity -### Initial data: If the 'fdata' object is modified via setters, -### the user may define the slots step by step. -### 'fdata()'. To avoid cumbersome behavior of slot setting, +### Initial data: If the 'fdata' object is modified via setters, +### the user may define the slots step by step. +### 'fdata()'. To avoid cumbersome behavior of slot setting, ### only warnings are thrown. -".init.valid.Fdata" <- function(obj) -{ - .init.valid.y.Fdata(obj) - .init.valid.S.Fdata(obj) - .init.valid.exp.Fdata(obj) - .init.valid.T.Fdata(obj) - .valid.type.Fdata(obj) +".init.valid.Fdata" <- function(obj) { + .init.valid.y.Fdata(obj) + .init.valid.S.Fdata(obj) + .init.valid.exp.Fdata(obj) + .init.valid.T.Fdata(obj) + .valid.type.Fdata(obj) } ### Valid data: If later data objects are used in functions, the functions ### usually need fully specified and consistent slots of an 'fdata' ### object. For this case, the 'fdata' object can be checked with ### errors thrown in case of inconsistency of slots. -### Furthermore, the validity check during initialisation relies on fully +### Furthermore, the validity check during initialisation relies on fully ### specified 'fdata' objects and checks consistency of slots strongly. -".valid.Fdata" <- function(obj) -{ - .valid.y.Fdata(obj) - .valid.S.Fdata(obj) - .valid.exp.Fdata(obj) - .valid.T.Fdata(obj) - .valid.type.Fdata(obj) +".valid.Fdata" <- function(obj) { + .valid.y.Fdata(obj) + .valid.S.Fdata(obj) + .valid.exp.Fdata(obj) + .valid.T.Fdata(obj) + .valid.type.Fdata(obj) } ### Valid y: Data in @y must be of type 'integer' or 'numeric'. Further, -### the number of observations @N, the dimension of observations @r +### the number of observations @N, the dimension of observations @r ### and the ordering @bycolumn must be group-consistent. -".init.valid.y.Fdata" <- function(obj) -{ - if (!all(is.na(obj@y))) { - if (!is.numeric(obj@y) && !is.integer(obj@y)) { - stop(paste("Wrong type of slot 'y' in 'fdata' object. ", - "Data must be of type 'numeric' or 'integer'.", - sep = "")) - } - if (obj@bycolumn) { - if (obj@N != nrow(obj@y)) { - warning(paste("Slot 'N' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE", - sep = "")) - } - if (obj@r != ncol(obj@y)) { - warning(paste("Slot 'r' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE", - sep = "")) - } - } else { - if (obj@N != ncol(obj@y)) { - warning(paste("Slot 'N' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE", - sep = "")) - } - if (obj@r != nrow(obj@y)) { - warning(paste("Slot 'r' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE", - sep = "")) - } - } +".init.valid.y.Fdata" <- function(obj) { + if (!all(is.na(obj@y))) { + if (!is.numeric(obj@y) && !is.integer(obj@y)) { + stop(paste("Wrong type of slot 'y' in 'fdata' object. ", + "Data must be of type 'numeric' or 'integer'.", + sep = "" + )) } + if (obj@bycolumn) { + if (obj@N != nrow(obj@y)) { + warning(paste("Slot 'N' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE", + sep = "" + )) + } + if (obj@r != ncol(obj@y)) { + warning(paste("Slot 'r' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE", + sep = "" + )) + } + } else { + if (obj@N != ncol(obj@y)) { + warning(paste("Slot 'N' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE", + sep = "" + )) + } + if (obj@r != nrow(obj@y)) { + warning(paste("Slot 'r' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE", + sep = "" + )) + } + } + } } -".valid.y.Fdata" <- function(obj) -{ - if (!all(is.na(obj@y))) { - if (!is.numeric(obj@y) && !is.integer(obj@y)) { - stop(paste("Wrong type of slot 'y' in 'fdata' object. ", - "Data must be of type 'numeric' or 'integer'.", - sep = "")) - } - if (obj@bycolumn) { - if (obj@N != nrow(obj@y)) { - stop(paste("Slot 'N' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE", - sep = "")) - } - if (obj@r != ncol(obj@y)) { - stop(paste("Slot 'r' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE", - sep = "")) - } - } else { - if (obj@N != ncol(obj@y)) { - stop(paste("Slot 'N' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE", - sep = "")) - } - if (obj@r != nrow(obj@y)) { - stop(paste("Slot 'r' does not match the ", - "dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE", - sep = "")) - } - } +".valid.y.Fdata" <- function(obj) { + if (!all(is.na(obj@y))) { + if (!is.numeric(obj@y) && !is.integer(obj@y)) { + stop(paste("Wrong type of slot 'y' in 'fdata' object. ", + "Data must be of type 'numeric' or 'integer'.", + sep = "" + )) } + if (obj@bycolumn) { + if (obj@N != nrow(obj@y)) { + stop(paste("Slot 'N' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE", + sep = "" + )) + } + if (obj@r != ncol(obj@y)) { + stop(paste("Slot 'r' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE", + sep = "" + )) + } + } else { + if (obj@N != ncol(obj@y)) { + stop(paste("Slot 'N' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE", + sep = "" + )) + } + if (obj@r != nrow(obj@y)) { + stop(paste("Slot 'r' does not match the ", + "dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE", + sep = "" + )) + } + } + } } ### Valid S: Indicators in @S must be of type 'integer'. Further, @@ -925,304 +973,347 @@ setReplaceMethod("setT", "fdata", ### @bycolumn. ### Indicators must be positive integers. If any element of @S ### is smaller than one, an error is thrown. -".init.valid.S.Fdata" <- function(obj) -{ - if (!all(is.na(obj@S))) { - if (!is.integer(obj@S)) { - stop(paste("Wrong type of slot 'S' in 'fdata' object. ", - "Indicators must be of type 'integer'.", - sep = "")) - } - if (obj@bycolumn) { - if (!all(is.na(obj@y))) { - if (nrow(obj@S) != nrow(obj@y)) { - warning(paste("Dimension of slot 'S' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE.", - sep ="")) - } - } - if (ncol(obj@S) > 1) { - warning(paste("Wrong dimension of slot 'S' if ", - "slot 'bycolumn' is TRUE. Indicators ", - "can only be one-dimensional.", sep = "")) - } - } else { - if (!all(is.na(obj@y))) { - if (ncol(obj@S) != ncol(obj@y)) { - warning(paste("Dimension of slot 'S' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE.", - sep = "")) - } - } - if (nrow(obj@S) > 1) { - warning(paste("Wrong dimension of slot 'S' if ", - "slot 'bycolumn' is FALSE. Indicators ", - "can only be one-dimensional.", sep = "")) - } +".init.valid.S.Fdata" <- function(obj) { + if (!all(is.na(obj@S))) { + if (!is.integer(obj@S)) { + stop(paste("Wrong type of slot 'S' in 'fdata' object. ", + "Indicators must be of type 'integer'.", + sep = "" + )) + } + if (obj@bycolumn) { + if (!all(is.na(obj@y))) { + if (nrow(obj@S) != nrow(obj@y)) { + warning(paste("Dimension of slot 'S' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE.", + sep = "" + )) } - if (any(obj@S < 1)) { - stop(paste("Wrong speicification of slot 'S' in 'fdata' ", - "object. Indicators must be positive integers ", - "or NA.", sep = "")) + } + if (ncol(obj@S) > 1) { + warning(paste("Wrong dimension of slot 'S' if ", + "slot 'bycolumn' is TRUE. Indicators ", + "can only be one-dimensional.", + sep = "" + )) + } + } else { + if (!all(is.na(obj@y))) { + if (ncol(obj@S) != ncol(obj@y)) { + warning(paste("Dimension of slot 'S' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE.", + sep = "" + )) } + } + if (nrow(obj@S) > 1) { + warning(paste("Wrong dimension of slot 'S' if ", + "slot 'bycolumn' is FALSE. Indicators ", + "can only be one-dimensional.", + sep = "" + )) + } } + if (any(obj@S < 1)) { + stop(paste("Wrong speicification of slot 'S' in 'fdata' ", + "object. Indicators must be positive integers ", + "or NA.", + sep = "" + )) + } + } } -".valid.S.Fdata" <- function(obj) -{ - if (!all(is.na(obj@S))) { - if (!is.integer(obj@S)) { - stop(paste("Wrong type of slot 'S' in 'fdata' object. ", - "Indicators must be of type 'integer'.", - sep = "")) - } - if (obj@bycolumn) { - if (!all(is.na(obj@y))) { - if (nrow(obj@S) != nrow(obj@y)) { - stop(paste("Dimension of slot 'S' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE.", - sep ="")) - } - } - if (ncol(obj@S) > 1) { - stop(paste("Wrong dimension of slot 'S' if ", - "slot 'bycolumn' is TRUE. Indicators ", - "can only be one-dimensional.", sep = "")) - } - } else { - if (!all(is.na(obj@y))) { - if (ncol(obj@S) != ncol(obj@y)) { - stop(paste("Dimension of slot 'S' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE.", - sep = "")) - } - } - if (nrow(obj@S) > 1) { - stop(paste("Wrong dimension of slot 'S' if ", - "slot 'bycolumn' is FALSE. Indicators ", - "can only be one-dimensional.", sep = "")) - } +".valid.S.Fdata" <- function(obj) { + if (!all(is.na(obj@S))) { + if (!is.integer(obj@S)) { + stop(paste("Wrong type of slot 'S' in 'fdata' object. ", + "Indicators must be of type 'integer'.", + sep = "" + )) + } + if (obj@bycolumn) { + if (!all(is.na(obj@y))) { + if (nrow(obj@S) != nrow(obj@y)) { + stop(paste("Dimension of slot 'S' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE.", + sep = "" + )) } - if (any(obj@S < 1)) { - stop(paste("Wrong speicification of slot 'S' in 'fdata' ", - "object. Indicators must be positive integers ", - "or NA.", sep = "")) + } + if (ncol(obj@S) > 1) { + stop(paste("Wrong dimension of slot 'S' if ", + "slot 'bycolumn' is TRUE. Indicators ", + "can only be one-dimensional.", + sep = "" + )) + } + } else { + if (!all(is.na(obj@y))) { + if (ncol(obj@S) != ncol(obj@y)) { + stop(paste("Dimension of slot 'S' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE.", + sep = "" + )) } + } + if (nrow(obj@S) > 1) { + stop(paste("Wrong dimension of slot 'S' if ", + "slot 'bycolumn' is FALSE. Indicators ", + "can only be one-dimensional.", + sep = "" + )) + } } + if (any(obj@S < 1)) { + stop(paste("Wrong speicification of slot 'S' in 'fdata' ", + "object. Indicators must be positive integers ", + "or NA.", + sep = "" + )) + } + } } ### Valid exp: Exposures in @exp must be of type 'numeric' or 'integer'. ### Furthermore dimensions must be conform with dimensions of data in @y. ### Exposures can only be one-dimensional and must be positive. If not ### an error is thrown. -".init.valid.exp.Fdata" <- function(obj) -{ - if (!all(is.na(obj@exp))) { - if (!is.numeric(obj@exp) && !is.integer(obj@exp)) { - stop(paste("Wrong type of slot 'exp' in 'fdata' object. ", - "Exposures must be of type 'numeric' or 'integer'.", - sep = "")) +".init.valid.exp.Fdata" <- function(obj) { + if (!all(is.na(obj@exp))) { + if (!is.numeric(obj@exp) && !is.integer(obj@exp)) { + stop(paste("Wrong type of slot 'exp' in 'fdata' object. ", + "Exposures must be of type 'numeric' or 'integer'.", + sep = "" + )) + } + if (obj@bycolumn) { + if (!all(is.na(obj@y))) { + if (nrow(obj@exp) != nrow(obj@y)) { + warning(paste("Dimension of slot 'exp' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE", + sep = "" + )) } - if (obj@bycolumn) { - if (!all(is.na(obj@y))) { - if (nrow(obj@exp) != nrow(obj@y)) { - warning(paste("Dimension of slot 'exp' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE", - sep = "")) - } - } - if (ncol(obj@exp) > 1) { - warning(paste("Wrong dimension of slot 'exp' if ", - "slot 'bycolumn' is TRUE. Exposures ", - "can only be one-dimensional.", - sep = "")) - } - } else { - if (!all(is.na(obj@y))) { - if (ncol(obj@exp) != ncol(obj@y)) { - warning(paste("Dimension of slot 'exp' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE", - sep = "")) - } - } - if (nrow(obj@exp) > 1) { - warning(paste("Wrong dimension of slot 'exp' if ", - "slot 'bycolumn' is FALSE. Exposures ", - "can only be one-dimensional.", - sep = "")) - } - } - if (any(obj@exp <= 0)) { - stop(paste("Wrong specification of slot 'exp'. Exposures ", - "must be positive or NA.", sep ="")) + } + if (ncol(obj@exp) > 1) { + warning(paste("Wrong dimension of slot 'exp' if ", + "slot 'bycolumn' is TRUE. Exposures ", + "can only be one-dimensional.", + sep = "" + )) + } + } else { + if (!all(is.na(obj@y))) { + if (ncol(obj@exp) != ncol(obj@y)) { + warning(paste("Dimension of slot 'exp' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE", + sep = "" + )) } + } + if (nrow(obj@exp) > 1) { + warning(paste("Wrong dimension of slot 'exp' if ", + "slot 'bycolumn' is FALSE. Exposures ", + "can only be one-dimensional.", + sep = "" + )) + } + } + if (any(obj@exp <= 0)) { + stop(paste("Wrong specification of slot 'exp'. Exposures ", + "must be positive or NA.", + sep = "" + )) } + } } -".valid.exp.Fdata" <- function(obj) -{ - if (!all(is.na(obj@exp))) { - if (!is.numeric(obj@exp)) { - stop(paste("Wrong type of slot 'exp' in 'fdata' object. ", - "Exposures must be of type 'numeric' or 'integer'.", - sep = "")) +".valid.exp.Fdata" <- function(obj) { + if (!all(is.na(obj@exp))) { + if (!is.numeric(obj@exp)) { + stop(paste("Wrong type of slot 'exp' in 'fdata' object. ", + "Exposures must be of type 'numeric' or 'integer'.", + sep = "" + )) + } + if (obj@bycolumn) { + if (!all(is.na(obj@y))) { + if (nrow(obj@exp) != nrow(obj@y)) { + stop(paste("Dimension of slot 'exp' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE.", + sep = "" + )) } - if (obj@bycolumn) { - if (!all(is.na(obj@y))) { - if (nrow(obj@exp) != nrow(obj@y)) { - stop(paste("Dimension of slot 'exp' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE.", - sep = "")) - } - } - if (ncol(obj@exp) > 1) { - stop(paste("Wrong dimension of slot 'exp' if ", - "slot 'bycolumn' is TRUE. Exposures ", - "can only be one-dimensional.", - sep = "")) - } - } else { - if (!all(is.na(obj@y))) { - if (ncol(obj@exp) != ncol(obj@y)) { - stop(paste("Dimension of slot 'exp' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE.", - sep = "")) - } - } - if (nrow(obj@exp) > 1) { - stop(paste("Wrong dimension of slot 'exp' if ", - "slot 'bycolumn' is FALSE. Exposures ", - "can only be one-dimensional.", - sep = "")) - } - } - if (any(obj@exp <= 0)) { - stop(paste("Wrong specification of slot 'exp'. Exposures ", - "must be positive or NA.", sep ="")) + } + if (ncol(obj@exp) > 1) { + stop(paste("Wrong dimension of slot 'exp' if ", + "slot 'bycolumn' is TRUE. Exposures ", + "can only be one-dimensional.", + sep = "" + )) + } + } else { + if (!all(is.na(obj@y))) { + if (ncol(obj@exp) != ncol(obj@y)) { + stop(paste("Dimension of slot 'exp' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE.", + sep = "" + )) } + } + if (nrow(obj@exp) > 1) { + stop(paste("Wrong dimension of slot 'exp' if ", + "slot 'bycolumn' is FALSE. Exposures ", + "can only be one-dimensional.", + sep = "" + )) + } + } + if (any(obj@exp <= 0)) { + stop(paste("Wrong specification of slot 'exp'. Exposures ", + "must be positive or NA.", + sep = "" + )) } + } } -### Valid T: Repetitions in @T must be of type 'integer'. Further, -### dimensions of @T must be consistent with @y in regard to the +### Valid T: Repetitions in @T must be of type 'integer'. Further, +### dimensions of @T must be consistent with @y in regard to the ### ordering in @bycolumn. ### If any element in @T is smaller than one, an error is thrown. -".init.valid.T.Fdata" <- function(obj) -{ - if (!all(is.na(obj@T))) { - if (!is.integer(obj@T)) { - stop(paste("Wrong type of slot 'T' in 'fdata' object. ", - "Repetitions must be of type 'integer'.", - sep = "")) - } - if (obj@bycolumn) { - if (!all(is.na(obj@y))) { - if (nrow(obj@T) != nrow(obj@y)) { - warning(paste("Dimension of slot 'T' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE.", - sep ="")) - } - } - if (ncol(obj@T) > 1) { - warning(paste("Wrong dimension of slot 'T' if ", - "slot 'bycolumn' is TRUE. Repetitions ", - "can only be one-dimensional.", sep = "")) - } - } else { - if (!all(is.na(obj@y))) { - if (ncol(obj@T) != ncol(obj@y)) { - warning(paste("Dimension of slot 'T' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE.", - sep = "")) - } - } - if (nrow(obj@T) > 1) { - warning(paste("Wrong dimension of slot 'T' if ", - "slot 'bycolumn' is FALSE. Repetitions ", - "can only be one-dimensional.", sep = "")) - } +".init.valid.T.Fdata" <- function(obj) { + if (!all(is.na(obj@T))) { + if (!is.integer(obj@T)) { + stop(paste("Wrong type of slot 'T' in 'fdata' object. ", + "Repetitions must be of type 'integer'.", + sep = "" + )) + } + if (obj@bycolumn) { + if (!all(is.na(obj@y))) { + if (nrow(obj@T) != nrow(obj@y)) { + warning(paste("Dimension of slot 'T' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE.", + sep = "" + )) } - if (any(obj@T < 1)) { - stop(paste("Wrong specification of slot 'T'. Repetitions ", - "must be positive integers or NA.", sep = "")) + } + if (ncol(obj@T) > 1) { + warning(paste("Wrong dimension of slot 'T' if ", + "slot 'bycolumn' is TRUE. Repetitions ", + "can only be one-dimensional.", + sep = "" + )) + } + } else { + if (!all(is.na(obj@y))) { + if (ncol(obj@T) != ncol(obj@y)) { + warning(paste("Dimension of slot 'T' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE.", + sep = "" + )) } - + } + if (nrow(obj@T) > 1) { + warning(paste("Wrong dimension of slot 'T' if ", + "slot 'bycolumn' is FALSE. Repetitions ", + "can only be one-dimensional.", + sep = "" + )) + } + } + if (any(obj@T < 1)) { + stop(paste("Wrong specification of slot 'T'. Repetitions ", + "must be positive integers or NA.", + sep = "" + )) } + } } -".valid.T.Fdata" <- function(obj) -{ - if (!all(is.na(obj@T))) { - if (!is.integer(obj@T)) { - stop(paste("Wrong type of slot 'T' in 'fdata' object. ", - "Repetitions must be of type 'integer'.", - sep = "")) - } - if (obj@bycolumn) { - if (!all(is.na(obj@y))) { - if (nrow(obj@T) != nrow(obj@y)) { - stop(paste("Dimension of slot 'T' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is TRUE.", - sep ="")) - } - } - if (ncol(obj@T) > 1) { - stop(paste("Wrong dimension of slot 'T' if ", - "slot 'bycolumn' is TRUE. Repetitions ", - "can only be one-dimensional.", sep = "")) - } - } else { - if (!all(is.na(obj@y))) { - if (ncol(obj@T) != ncol(obj@y)) { - stop(paste("Dimension of slot 'T' does not ", - "match dimension of slot 'y' in 'fdata' ", - "object if slot 'bycolumn' is FALSE.", - sep = "")) - } - } - if (nrow(obj@T) > 1) { - stop(paste("Wrong dimension of slot 'T' if ", - "slot 'bycolumn' is FALSE. Repetitions ", - "can only be one-dimensional.", sep = "")) - } +".valid.T.Fdata" <- function(obj) { + if (!all(is.na(obj@T))) { + if (!is.integer(obj@T)) { + stop(paste("Wrong type of slot 'T' in 'fdata' object. ", + "Repetitions must be of type 'integer'.", + sep = "" + )) + } + if (obj@bycolumn) { + if (!all(is.na(obj@y))) { + if (nrow(obj@T) != nrow(obj@y)) { + stop(paste("Dimension of slot 'T' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is TRUE.", + sep = "" + )) } - if (any(obj@T < 1)) { - stop(paste("Wrong specification of slot 'T'. Repetitions ", - "must be positive integers or NA.", sep = "")) + } + if (ncol(obj@T) > 1) { + stop(paste("Wrong dimension of slot 'T' if ", + "slot 'bycolumn' is TRUE. Repetitions ", + "can only be one-dimensional.", + sep = "" + )) + } + } else { + if (!all(is.na(obj@y))) { + if (ncol(obj@T) != ncol(obj@y)) { + stop(paste("Dimension of slot 'T' does not ", + "match dimension of slot 'y' in 'fdata' ", + "object if slot 'bycolumn' is FALSE.", + sep = "" + )) } - + } + if (nrow(obj@T) > 1) { + stop(paste("Wrong dimension of slot 'T' if ", + "slot 'bycolumn' is FALSE. Repetitions ", + "can only be one-dimensional.", + sep = "" + )) + } } + if (any(obj@T < 1)) { + stop(paste("Wrong specification of slot 'T'. Repetitions ", + "must be positive integers or NA.", + sep = "" + )) + } + } } ### Valid type: The description of data type in @type must be either ### 'discrete' or 'continuous' with no exclusion. Any other choice ### throws an error. -".valid.type.Fdata" <- function(obj) -{ - if (!(obj@type %in% c("discrete", "continuous"))) { - stop(paste("Wrong choice for slot 'type'. Data can be only ", - "'discrete' or 'continuous'", sep ="")) - } +".valid.type.Fdata" <- function(obj) { + if (!(obj@type %in% c("discrete", "continuous"))) { + stop(paste("Wrong choice for slot 'type'. Data can be only ", + "'discrete' or 'continuous'", + sep = "" + )) + } } -### Valid r: The dimension of the data has tobe one for 'discrete' data +### Valid r: The dimension of the data has to be one for 'discrete' data ### and can be greater one for 'continuous' data. -#".valid.r.Fdata" <- function(obj) -#{ +# ".valid.r.Fdata" <- function(obj) +# { # if (obj@type == "discrete" && obj@r > 1) { # stop(paste("Wrong specification of slot 'type' or slot 'r' in ", # "'fdata' object. 'discrete' data can only be one-dimensional", # sep = "")) # } -#} +# } diff --git a/R/graphic_func.R b/R/graphic_func.R index fc06025..07a2839 100644 --- a/R/graphic_func.R +++ b/R/graphic_func.R @@ -16,228 +16,258 @@ # along with finmix. If not, see . ### Private functions. -### These functions are not exported. +### These functions are not exported. ### Checking -### This function checks, if an option 'title' for the +### This function checks, if an option 'title' for the ### graphical device used by R is available. If the answer ### is TRUE, the title can be set by a 'plot()' function. -".check.grDevice" <- function() -{ - ## title argument ## - any(names(formals(getOption("device"))) - == "title") +".check.grDevice" <- function() { + ## title argument ## + any(names(formals(getOption("device"))) + == "title") } -### Plotting +### Plotting ### This functions checks the dimension of a dataset 'y' ### an distributes histograms for each variable in the -### dataset symmetrically around the graphical grid. -".symmetric.Hist" <- function(y, lab.names) -{ - r <- NCOL(y) - if (r == 1) { - .comb.Hist(y, lab.names) - } else if (r == 2) { - par(mfrow = c(1, 2), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:2) { - .comb.Hist(y[, i], lab.names[i]) - } - } else if (r == 3) { - par(mfrow = c(1, 3), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:r) { - .comb.Hist(y[, i], lab.names[i]) +### dataset symmetrically around the graphical grid. +".symmetric.Hist" <- function(y, lab.names) { + r <- NCOL(y) + if (r == 1) { + .comb.Hist(y, lab.names) + } else if (r == 2) { + par( + mfrow = c(1, 2), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:2) { + .comb.Hist(y[, i], lab.names[i]) + } + } else if (r == 3) { + par( + mfrow = c(1, 3), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:r) { + .comb.Hist(y[, i], lab.names[i]) + } + } else if (r > 3 && r < 17 && sqrt(r) %% 1 == 0) { + par( + mfrow = c(sqrt(r), sqrt(r)), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:r) { + .comb.Hist(y[, i], lab.names[i]) + } + } else { + if (r == 5) { + par( + mfrow = c(2, 3), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:4) { + .comb.Hist(y[, i], lab.names[i]) + } + plot.new() + .comb.Hist(y[, r], lab.names[r]) + } else if (r == 6) { + par( + mfrow = c(2, 3), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:r) { + .comb.Hist(y[, i], lab.names[i]) + } + } else { + if (r %% 2 == 0) { + ## check how many rows can be completely + ## filled + n <- r %/% 4 + par( + mfrow = c(n, 4), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:(n * 4)) { + .comb.Hist(y[, i], lab.names[i]) } - } else if (r > 3 && r < 17 && sqrt(r) %% 1 == 0) { - par(mfrow = c(sqrt(r), sqrt(r)), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:r) { - .comb.Hist(y[, i], lab.names[i]) + ## if some rows cannot be completely + ## filled, fill them symmetrically + ## there can only be two left: + .comb.Hist(y[, r - 1], lab.names[r - 1]) + plot.new() + .comb.Hist(y[, r], lab.names[r]) + } else { + n <- r %/% 5 + par( + mfrow = c(n, 5), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:(n * 5)) { + .comb.Hist(y[, i], lab.names[i]) } - } else { - if (r == 5) { - par(mfrow = c(2, 3), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for(i in 1:4) { - .comb.Hist(y[, i], lab.names[i]) - } - plot.new() - .comb.Hist(y[, r], lab.names[r]) - } else if (r == 6) { - par(mfrow = c(2, 3), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:r) { - .comb.Hist(y[, i], lab.names[i]) - } + ## if some rows cannot be completely, + ## filled, fill them symmetrically + ## either there are two left or four + ## left + if (r %% 5 == 2) { + plot.new() + .comb.Hist(y[, r - 1], lab.names[r - 1]) + plot.new() + .comb.Hist(y[, r], lab.names[r]) + plot.new() } else { - if (r %% 2 == 0) { - ## check how many rows can be completely - ## filled - n <- r %/% 4 - par(mfrow = c(n, 4), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for(i in 1:(n * 4)) { - .comb.Hist(y[, i], lab.names[i]) - } - ## if some rows cannot be completely - ## filled, fill them symmetrically - ## there can only be two left: - .comb.Hist(y[, r - 1], lab.names[r - 1]) - plot.new() - .comb.Hist(y[, r], lab.names[r]) - } else { - n <- r %/% 5 - par(mfrow = c(n, 5), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for(i in 1:(n * 5)) { - .comb.Hist(y[, i], lab.names[i]) - } - ## if some rows cannot be completely, - ## filled, fill them symmetrically - ## either there are two left or four - ## left - if (r %% 5 == 2) { - plot.new() - .comb.Hist(y[, r - 1], lab.names[r - 1]) - plot.new() - .comb.Hist(y[, r], lab.names[r]) - plot.new() - } else { - .comb.Hist(y[, r - 3], lab.names[r - 3]) - .comb.Hist(y[, r - 2], lab.names[r - 2]) - plot.new() - .comb.Hist(y[, r - 1], lab.names[r - 1]) - .comb.Hist(y[, r], lab.names[r]) - } - } + .comb.Hist(y[, r - 3], lab.names[r - 3]) + .comb.Hist(y[, r - 2], lab.names[r - 2]) + plot.new() + .comb.Hist(y[, r - 1], lab.names[r - 1]) + .comb.Hist(y[, r], lab.names[r]) } + } } + } } ### This functions checks the dimension of a dataset 'y' ### an distributes Kernel densities for each variable in the -### dataset symmetrically around the graphical grid. -".symmetric.Dens" <- function(y, lab.names) -{ - r <- NCOL(y) - if (r == 1) { - .comb.Dens(y, lab.names) - } else if (r == 2) { - par(mfrow = c(1, 2), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:2) { - .comb.Dens(y[, i], lab.names[i]) - } - } else if (r == 3) { - par(mfrow = c(1, 3), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:r) { - .comb.Dens(y[, i], lab.names[i]) +### dataset symmetrically around the graphical grid. +".symmetric.Dens" <- function(y, lab.names) { + r <- NCOL(y) + if (r == 1) { + .comb.Dens(y, lab.names) + } else if (r == 2) { + par( + mfrow = c(1, 2), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:2) { + .comb.Dens(y[, i], lab.names[i]) + } + } else if (r == 3) { + par( + mfrow = c(1, 3), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:r) { + .comb.Dens(y[, i], lab.names[i]) + } + } else if (r > 3 && r < 17 && sqrt(r) %% 1 == 0) { + par( + mfrow = c(sqrt(r), sqrt(r)), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:r) { + .comb.Dens(y[, i], lab.names[i]) + } + } else { + if (r == 5) { + par( + mfrow = c(2, 3), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:4) { + .comb.Dens(y[, i], lab.names[i]) + } + plot.new() + .comb.Dens(y[, r], lab.names[r]) + } else if (r == 6) { + par( + mfrow = c(2, 3), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:r) { + .comb.Dens(y[, i], lab.names[i]) + } + } else { + if (r %% 2 == 0) { + ## check how many rows can be completely + ## filled + n <- r %/% 4 + par( + mfrow = c(n, 4), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:(n * 4)) { + .comb.Dens(y[, i], lab.names[i]) } - } else if (r > 3 && r < 17 && sqrt(r) %% 1 == 0) { - par(mfrow = c(sqrt(r), sqrt(r)), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:r) { - .comb.Dens(y[, i], lab.names[i]) + ## if some rows cannot be completely + ## filled, fill them symmetrically + ## there can only be two left: + .comb.Dens(y[, r - 1], lab.names[r - 1]) + plot.new() + .comb.Dens(y[, r], lab.names[r]) + } else { + n <- r %/% 5 + par( + mfrow = c(n, 5), + mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + for (i in 1:(n * 5)) { + .comb.Dens(y[, i], lab.names[i]) } - } else { - if (r == 5) { - par(mfrow = c(2, 3), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for(i in 1:4) { - .comb.Dens(y[, i], lab.names[i]) - } - plot.new() - .comb.Dens(y[, r], lab.names[r]) - } else if (r == 6) { - par(mfrow = c(2, 3), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for (i in 1:r) { - .comb.Dens(y[, i], lab.names[i]) - } + ## if some rows cannot be completely, + ## filled, fill them symmetrically + ## either there are two left or four + ## left + if (r %% 5 == 2) { + plot.new() + .comb.Dens(y[, r - 1], lab.names[r - 1]) + plot.new() + .comb.Dens(y[, r], lab.names[r]) + plot.new() } else { - if (r %% 2 == 0) { - ## check how many rows can be completely - ## filled - n <- r %/% 4 - par(mfrow = c(n, 4), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for(i in 1:(n * 4)) { - .comb.Dens(y[, i], lab.names[i]) - } - ## if some rows cannot be completely - ## filled, fill them symmetrically - ## there can only be two left: - .comb.Dens(y[, r - 1], lab.names[r - 1]) - plot.new() - .comb.Dens(y[, r], lab.names[r]) - } else { - n <- r %/% 5 - par(mfrow = c(n, 5), - mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - for(i in 1:(n * 5)) { - .comb.Dens(y[, i], lab.names[i]) - } - ## if some rows cannot be completely, - ## filled, fill them symmetrically - ## either there are two left or four - ## left - if (r %% 5 == 2) { - plot.new() - .comb.Dens(y[, r - 1], lab.names[r - 1]) - plot.new() - .comb.Dens(y[, r], lab.names[r]) - plot.new() - } else { - .comb.Dens(y[, r - 3], lab.names[r - 3]) - .comb.Dens(y[, r - 2], lab.names[r - 2]) - plot.new() - .comb.Dens(y[, r - 1], lab.names[r - 1]) - .comb.Dens(y[, r], lab.names[r]) - } - } + .comb.Dens(y[, r - 3], lab.names[r - 3]) + .comb.Dens(y[, r - 2], lab.names[r - 2]) + plot.new() + .comb.Dens(y[, r - 1], lab.names[r - 1]) + .comb.Dens(y[, r], lab.names[r]) } + } } + } } ### This function plots a histogram with 'finmix' specific -### settings. In addition it uses 'rug()' to plot the data +### settings. In addition it uses 'rug()' to plot the data ### points. -".comb.Hist" <- function(y, lab.name) -{ - hist(y, col = "gray65", - border = "white", cex = 0.7, - cex.axis = 0.7, freq = TRUE, - xlab = "", main = "", cex.lab = 0.7) - rug(y, col = "gray47") - mtext(side = 1, do.call(bquote,lab.name), - cex = 0.7, line = 3) +".comb.Hist" <- function(y, lab.name) { + hist(y, + col = "gray65", + border = "white", cex = 0.7, + cex.axis = 0.7, freq = TRUE, + xlab = "", main = "", cex.lab = 0.7 + ) + rug(y, col = "gray47") + mtext( + side = 1, do.call(bquote, lab.name), + cex = 0.7, line = 3 + ) } ### This function plots a Kernel density with 'finmix' specific -### settings. In addition it uses 'rug()' to plot the data +### settings. In addition it uses 'rug()' to plot the data ### points. -".comb.Dens" <- function(y, lab.name) -{ - dens <- bkde(y) - plot(dens$x, dens$y, col = "gray47", - cex.axis = .7, cex = .7, type = "l", - xlab = "", main = "", ylab = "Density", - cex.lab = .7) - rug(y, col = "gray47") - mtext(side = 1, do.call(bquote,lab.name), - cex = 0.7, line = 3) +".comb.Dens" <- function(y, lab.name) { + dens <- bkde(y) + plot(dens$x, dens$y, + col = "gray47", + cex.axis = .7, cex = .7, type = "l", + xlab = "", main = "", ylab = "Density", + cex.lab = .7 + ) + rug(y, col = "gray47") + mtext( + side = 1, do.call(bquote, lab.name), + cex = 0.7, line = 3 + ) } - diff --git a/R/groupmoments.R b/R/groupmoments.R index 5e5f059..6440982 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -15,151 +15,162 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.groupmoments <- setClass("groupmoments", - representation(NK = "array", - mean = "matrix", - WK = "array", - var = "array", - fdata = "fdata"), - validity = function(object) { - ## else: ok - TRUE - }, - prototype(NK = array(), - mean = matrix(), - WK = array(), - var = array(), - fdata = fdata() - ) +.groupmoments <- setClass("groupmoments", + representation( + NK = "array", + mean = "matrix", + WK = "array", + var = "array", + fdata = "fdata" + ), + validity = function(object) { + ## else: ok + TRUE + }, + prototype( + NK = array(), + mean = matrix(), + WK = array(), + var = array(), + fdata = fdata() + ) ) -"groupmoments" <- function(value = fdata()) -{ - hasY(value, verbose = TRUE) - hasS(value, verbose = TRUE) - .groupmoments(value = value) +"groupmoments" <- function(value = fdata()) { + hasY(value, verbose = TRUE) + hasS(value, verbose = TRUE) + .groupmoments(value = value) } ## initializes by immediately calling method ## ## 'generateMoments' ## -setMethod("initialize", "groupmoments", - function(.Object, ..., value) - { - .Object@fdata <- value - generateMoments(.Object) - } +setMethod( + "initialize", "groupmoments", + function(.Object, ..., value) { + .Object@fdata <- value + generateMoments(.Object) + } ) -setMethod("generateMoments", "groupmoments", - function(object) - { - .generateGroupMoments(object) - } +setMethod( + "generateMoments", "groupmoments", + function(object) { + .generateGroupMoments(object) + } ) ## R usual 'show' function ## -setMethod("show", "groupmoments", - function(object) - { - cat("Object 'groupmoments'\n") - cat(" NK : Vector of", - length(object@NK), "\n") - cat(" mean :", - paste(dim(object@mean), collapse = "x"), "\n") - cat(" WK :", - paste(dim(object@WK), collapse = "x"), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" fdata : Object of class", - class(object@fdata), "\n") - } +setMethod( + "show", "groupmoments", + function(object) { + cat("Object 'groupmoments'\n") + cat( + " NK : Vector of", + length(object@NK), "\n" + ) + cat( + " mean :", + paste(dim(object@mean), collapse = "x"), "\n" + ) + cat( + " WK :", + paste(dim(object@WK), collapse = "x"), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " fdata : Object of class", + class(object@fdata), "\n" + ) + } ) - + ## R usual Getters ## -setMethod("getNK", "groupmoments", - function(object) - { - return(object@NK) - } +setMethod( + "getNK", "groupmoments", + function(object) { + return(object@NK) + } ) -setMethod("getMean", "groupmoments", - function(object) - { - return(object@mean) - } +setMethod( + "getMean", "groupmoments", + function(object) { + return(object@mean) + } ) -setMethod("getWK", "groupmoments", - function(object) - { - return(object@WK) - } +setMethod( + "getWK", "groupmoments", + function(object) { + return(object@WK) + } ) -setMethod("getVar", "groupmoments", - function(object) - { - return(object@var) - } +setMethod( + "getVar", "groupmoments", + function(object) { + return(object@var) + } ) -setMethod("getFdata", "groupmoments", - function(object) - { - return(object@fdata) - } +setMethod( + "getFdata", "groupmoments", + function(object) { + return(object@fdata) + } ) ## No setters as user are not intended to manipulate this ## ## object ## ### Private functions ### These functions are not exported -".generateGroupMoments" <- function(object) -{ - if(!hasS(object@fdata)) { - return(object) - } +".generateGroupMoments" <- function(object) { + if (!hasS(object@fdata)) { + return(object) + } - ## Compute group sizes ## - ## enforce column-wise ordering ## + ## Compute group sizes ## + ## enforce column-wise ordering ## - datam <- getColY(object@fdata) - classm <- getColS(object@fdata) - ## Calculate group sizes and group means ## - ## 'NK' is an 1 x K vector ## - ## 'groupmean' is an r x K matrix ## - level.set <- as.numeric(levels(factor(classm))) - K <- length(level.set) - r <- ncol(datam) - comp <- matrix(rep(classm, K), ncol = K) == matrix(seq(1,K), - nrow = nrow(datam), - ncol = K, - byrow = TRUE) - names <- rep("", K) - for (k in seq(1, K)) { - names[k] <- paste("k=", k, sep = "") - } - object@NK <- as.array(apply(comp, 2, sum)) - dimnames(object@NK) <- list(names) - gmeans <- matrix(NA, nrow = r, ncol = K) - for (i in seq(1,r)) { - gmeans[i, ] <- (t(datam[,i]) %*% comp)/t(object@NK) - } - colnames(gmeans) <- names - rownames(gmeans) <- colnames(datam) - object@mean <- gmeans - wkm <- array(NA, dim = c(r, r, K)) - varm <- array(NA, dim = c(r, r, K)) - for (k in seq(1, K)) { - group.demeaned <- (datam - rep(gmeans[,k], each = nrow(datam))) * comp[, k] - wkm[,, k] <- t(group.demeaned) %*% group.demeaned - varm[,, k] <- wkm[,, k]/object@NK[k] - } - dimnames(wkm) <- list(colnames(datam), colnames(datam), names) - dimnames(varm) <- list(colnames(datam), colnames(datam), names) - object@WK <- wkm - object@var <- varm - return(object) + datam <- getColY(object@fdata) + classm <- getColS(object@fdata) + ## Calculate group sizes and group means ## + ## 'NK' is an 1 x K vector ## + ## 'groupmean' is an r x K matrix ## + level.set <- as.numeric(levels(factor(classm))) + K <- length(level.set) + r <- ncol(datam) + comp <- matrix(rep(classm, K), ncol = K) == matrix(seq(1, K), + nrow = nrow(datam), + ncol = K, + byrow = TRUE + ) + names <- rep("", K) + for (k in seq(1, K)) { + names[k] <- paste("k=", k, sep = "") + } + object@NK <- as.array(apply(comp, 2, sum)) + dimnames(object@NK) <- list(names) + gmeans <- matrix(NA, nrow = r, ncol = K) + for (i in seq(1, r)) { + gmeans[i, ] <- (t(datam[, i]) %*% comp) / t(object@NK) + } + colnames(gmeans) <- names + rownames(gmeans) <- colnames(datam) + object@mean <- gmeans + wkm <- array(NA, dim = c(r, r, K)) + varm <- array(NA, dim = c(r, r, K)) + for (k in seq(1, K)) { + group.demeaned <- (datam - rep(gmeans[, k], each = nrow(datam))) * comp[, k] + wkm[, , k] <- t(group.demeaned) %*% group.demeaned + varm[, , k] <- wkm[, , k] / object@NK[k] + } + dimnames(wkm) <- list(colnames(datam), colnames(datam), names) + dimnames(varm) <- list(colnames(datam), colnames(datam), names) + object@WK <- wkm + object@var <- varm + return(object) } - diff --git a/R/likelihood.R b/R/likelihood.R index 8252465..558dd40 100644 --- a/R/likelihood.R +++ b/R/likelihood.R @@ -15,156 +15,147 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -".likelihood.normal" <- function(y, mu, sigma){ - N <- nrow(y) - K <- ncol(mu) - y <- matrix(y, nrow = N, ncol = K) - - err <- t(apply(y, 1, "-", mu)) - err <- t(apply(err^2, 1, "/", sigma)) - - loglik <- -.5 * (log(2 * pi) + t(apply(err, 1, "+", log(sigma)))) - - if(K == 1) { - max.lik <- loglik - } - else { - max.lik <- apply(loglik, 1, max, na.rm = TRUE) - } - l.h <- exp(loglik - max.lik) - - result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) - return(result) +".likelihood.normal" <- function(y, mu, sigma) { + N <- nrow(y) + K <- ncol(mu) + y <- matrix(y, nrow = N, ncol = K) + + err <- t(apply(y, 1, "-", mu)) + err <- t(apply(err^2, 1, "/", sigma)) + + loglik <- -.5 * (log(2 * pi) + t(apply(err, 1, "+", log(sigma)))) + + if (K == 1) { + max.lik <- loglik + } else { + max.lik <- apply(loglik, 1, max, na.rm = TRUE) + } + l.h <- exp(loglik - max.lik) + + result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) + return(result) } ".likelihood.student" <- function(y, mu, sigma, df) { - N <- nrow(y) - K <- ncol(mu) - y <- matrix(y, nrow = N, ncol = K) - mu <- matrix(mu, nrow = N, ncol = K, byrow = TRUE) - sigma <- matrix(sigma, nrow = N, ncol = K, byrow = TRUE) - df <- matrix(df, nrow = N, ncol = K, byrow = TRUE) + N <- nrow(y) + K <- ncol(mu) + y <- matrix(y, nrow = N, ncol = K) + mu <- matrix(mu, nrow = N, ncol = K, byrow = TRUE) + sigma <- matrix(sigma, nrow = N, ncol = K, byrow = TRUE) + df <- matrix(df, nrow = N, ncol = K, byrow = TRUE) - err <- (y - mu)^2/sigma + err <- (y - mu)^2 / sigma - - loglik <- lgamma((df + 1)/2) - lgamma(df/2) - .5 * (log(df * pi) + log(sigma)) - (df + 1)/2 * log(1 + err/df) - if(K == 1) { - max.lik <- loglik - } - else { - max.lik <- apply(loglik, 1, max, na.rm = TRUE) - } - l.h <- exp(loglik - max.lik) + loglik <- lgamma((df + 1) / 2) - lgamma(df / 2) - .5 * (log(df * pi) + log(sigma)) - (df + 1) / 2 * log(1 + err / df) - result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) - return(result) + if (K == 1) { + max.lik <- loglik + } else { + max.lik <- apply(loglik, 1, max, na.rm = TRUE) + } + l.h <- exp(loglik - max.lik) + result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) + return(result) } ".likelihood.exponential" <- function(y, lambda) { - - N <- nrow(y) - K <- ncol(lambda) - y <- matrix(y, nrow = N, ncol = K) - - lambda <- matrix(lambda, nrow = N, ncol = K, byrow = TRUE) - - lambda <- apply(lambda, c(1,2), max, 0.0001) - loglik <- log(lambda) - y * lambda - max.lik <- apply(loglik, 1, max) - - l.h <- exp(loglik - max.lik) - - result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) - return(result) - + N <- nrow(y) + K <- ncol(lambda) + y <- matrix(y, nrow = N, ncol = K) + + lambda <- matrix(lambda, nrow = N, ncol = K, byrow = TRUE) + + lambda <- apply(lambda, c(1, 2), max, 0.0001) + loglik <- log(lambda) - y * lambda + max.lik <- apply(loglik, 1, max) + + l.h <- exp(loglik - max.lik) + + result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) + return(result) } ".likelihood.poisson" <- function(y, lambda) { + N <- nrow(y) + K <- ncol(lambda) + nst <- nrow(lambda) + + y <- matrix(y, nrow = N, ncol = K) - N <- nrow(y) - K <- ncol(lambda) - nst <- nrow(lambda) - - y <- matrix(y, nrow = N, ncol = K) + if (nst == 1) { + lambda <- matrix(lambda, nrow = N, ncol = K, byrow = TRUE) + } + lambda <- apply(lambda, c(1, 2), max, 10e-5, na.rm = TRUE) - if(nst == 1) { - lambda <- matrix(lambda, nrow = N, ncol = K, byrow = TRUE) - } - lambda <- apply(lambda, c(1, 2), max, 10e-5, na.rm = TRUE) + loglik <- y * log(lambda) - lambda - lgamma(y + 1) - loglik <- y * log(lambda) - lambda - lgamma(y + 1) + max.lik <- apply(loglik, 1, max, na.rm = TRUE) - max.lik <- apply(loglik, 1, max, na.rm = TRUE) + l.h <- exp(apply(loglik, 2, "-", max.lik)) - l.h <- exp(apply(loglik, 2, "-", max.lik)) - - result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) - return(result) + result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) + return(result) } ".likelihood.binomial" <- function(y, T, p) { + N <- nrow(y) + K <- length(p) + nst <- nrow(T) + + y <- matrix(y, nrow = N, ncol = K) + T <- matrix(T, nrow = N, ncol = K, byrow = TRUE) + + loglik <- lgamma(T + 1) - lgamma(T - y + 1) - lgamma(y + 1) + loglik <- loglik + t((apply(y, 1, "*", log(p)))) + t((apply(T - y, 1, "*", log(1 - p)))) - N <- nrow(y) - K <- length(p) - nst <- nrow(T) - - y <- matrix(y, nrow = N, ncol = K) - T <- matrix(T, nrow = N, ncol = K, byrow = TRUE) - - loglik <- lgamma(T + 1) - lgamma(T - y + 1) - lgamma(y + 1) - loglik <- loglik + t((apply(y, 1, "*", log(p)))) + t((apply(T - y, 1, "*", log(1 - p)))) - - max.lik <- apply(loglik, 1, max, na.rm = TRUE) - - l.h <- exp(apply(loglik, 2, "-", max.lik)) - - result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) - return(result) + max.lik <- apply(loglik, 1, max, na.rm = TRUE) + + l.h <- exp(apply(loglik, 2, "-", max.lik)) + + result <- list(lh = l.h, maxl = matrix(max.lik), llh = loglik) + return(result) } ".likelihood.normult" <- function(y, mu, sigmainv, logdet) { - - N <- nrow(y) - r <- ncol(y) - K <- dim(sigmainv)[3] - loglik <- matrix(0, nrow = N, ncol = K) - loglik1 <- -.5 * r * log(2*pi) - - for(k in 1:K) { - eps <- t(apply(y, 1, "-", t(matrix(mu[,k])))) - loglik[, k] <- loglik1 + .5 * logdet[k] - .5 * apply(eps %*% sigmainv[,,k] * eps, 1, sum) - } - - maxlik <- t(apply(loglik, 1, max)) - l.h <- exp(apply(loglik, 2, "-", maxlik)) - - results <- list(lh = l.h, maxl = matrix(maxlik), llh = loglik) - return(results) + N <- nrow(y) + r <- ncol(y) + K <- dim(sigmainv)[3] + loglik <- matrix(0, nrow = N, ncol = K) + loglik1 <- -.5 * r * log(2 * pi) + + for (k in 1:K) { + eps <- t(apply(y, 1, "-", t(matrix(mu[, k])))) + loglik[, k] <- loglik1 + .5 * logdet[k] - .5 * apply(eps %*% sigmainv[, , k] * eps, 1, sum) + } + + maxlik <- t(apply(loglik, 1, max)) + l.h <- exp(apply(loglik, 2, "-", maxlik)) + + results <- list(lh = l.h, maxl = matrix(maxlik), llh = loglik) + return(results) } ".likelihood.studmult" <- function(y, mu, sigmainv, logdet, df) { - - N <- nrow(y) - K <- ncol(mu) - r <- ncol(y) - - loglik <- matrix(0, nrow = N, ncol = K) - - for(k in 1:K) { - mum <- matrix(mu[,k], nrow = N, ncol = r, byrow = TRUE) - err <- y - mum - err <- err %*% sigmainv[,,k] * err - err <- apply(err, 1, sum) - loglik[, k] <- lgamma((df[k] + r)/2) - lgamma(df[k]/2) + .5 * logdet[k] - .5 * r * log(df[k] * pi) - loglik[, k] <- loglik[, k] - ((df[k] + r)/2) * log(1 + err/df[k]) - } - - maxlik <- t(apply(loglik, 1, max)) - l.h <- exp(apply(loglik, 2, "-", maxlik)) - - result <- list(lh = l.h, maxl = matrix(maxlik), llh = loglik) - return(result) + N <- nrow(y) + K <- ncol(mu) + r <- ncol(y) + + loglik <- matrix(0, nrow = N, ncol = K) + + for (k in 1:K) { + mum <- matrix(mu[, k], nrow = N, ncol = r, byrow = TRUE) + err <- y - mum + err <- err %*% sigmainv[, , k] * err + err <- apply(err, 1, sum) + loglik[, k] <- lgamma((df[k] + r) / 2) - lgamma(df[k] / 2) + .5 * logdet[k] - .5 * r * log(df[k] * pi) + loglik[, k] <- loglik[, k] - ((df[k] + r) / 2) * log(1 + err / df[k]) + } + + maxlik <- t(apply(loglik, 1, max)) + l.h <- exp(apply(loglik, 2, "-", maxlik)) + + result <- list(lh = l.h, maxl = matrix(maxlik), llh = loglik) + return(result) } diff --git a/R/mcmc.R b/R/mcmc.R index f72a2d3..323f5f8 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -15,174 +15,181 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmc <- setClass( "mcmc", - representation( burnin = "integer", - M = "integer", - startpar = "logical", - storeS = "integer", - storepost = "logical", - ranperm = "logical", - storeinv = "logical" ), - validity = function( object ) - { - .valid.MCMC(object) - ## else: OK - TRUE - }, - prototype( burnin = integer(), - M = integer(), - startpar = logical(), - storeS = integer(), - storepost = logical(), - ranperm = logical(), - storeinv = logical() - ) +.mcmc <- setClass("mcmc", + representation( + burnin = "integer", + M = "integer", + startpar = "logical", + storeS = "integer", + storepost = "logical", + ranperm = "logical", + storeinv = "logical" + ), + validity = function(object) { + .valid.MCMC(object) + ## else: OK + TRUE + }, + prototype( + burnin = integer(), + M = integer(), + startpar = logical(), + storeS = integer(), + storepost = logical(), + ranperm = logical(), + storeinv = logical() + ) ) -"mcmc" <- function( burnin = 0, M = 5000, - startpar = TRUE, storeS = 1000, - storepost = TRUE, ranperm = TRUE, - storeinv = TRUE ) -{ - .mcmc( burnin = as.integer( burnin ), - M = as.integer( M ), startpar = startpar, - storeS = as.integer( storeS ), storepost = storepost, - ranperm = ranperm, storeinv = storeinv ) +"mcmc" <- function(burnin = 0, M = 5000, + startpar = TRUE, storeS = 1000, + storepost = TRUE, ranperm = TRUE, + storeinv = TRUE) { + .mcmc( + burnin = as.integer(burnin), + M = as.integer(M), startpar = startpar, + storeS = as.integer(storeS), storepost = storepost, + ranperm = ranperm, storeinv = storeinv + ) } -setMethod( "show", "mcmc", - function( object ) { - cat( "Object 'mcmc'\n" ) - cat( " class :", class(object), "\n" ) - cat( " burnin :", object@burnin, "\n" ) - cat( " M :", object@M, "\n" ) - cat( " startpar :", object@startpar, "\n" ) - cat( " storeS :", object@storeS, "\n" ) - cat( " storepost :", object@storepost, "\n" ) - cat( " ranperm :", object@ranperm, "\n" ) - cat( " storeinv :", object@storeinv, "\n" ) - } +setMethod( + "show", "mcmc", + function(object) { + cat("Object 'mcmc'\n") + cat(" class :", class(object), "\n") + cat(" burnin :", object@burnin, "\n") + cat(" M :", object@M, "\n") + cat(" startpar :", object@startpar, "\n") + cat(" storeS :", object@storeS, "\n") + cat(" storepost :", object@storepost, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" storeinv :", object@storeinv, "\n") + } ) ## Getters ## -setMethod( "getBurnin", "mcmc", - function( object ) - { - return( object@burnin ) - } +setMethod( + "getBurnin", "mcmc", + function(object) { + return(object@burnin) + } ) -setMethod( "getM", "mcmc", - function( object ) - { - return( object@M ) - } +setMethod( + "getM", "mcmc", + function(object) { + return(object@M) + } ) -setMethod( "getStartpar", "mcmc", - function( object ) - { - return( object@startpar ) - } +setMethod( + "getStartpar", "mcmc", + function(object) { + return(object@startpar) + } ) -setMethod( "getStoreS", "mcmc", - function( object ) - { - return( object@storeS ) - } +setMethod( + "getStoreS", "mcmc", + function(object) { + return(object@storeS) + } ) -setMethod( "getStorepost", "mcmc", - function( object ) - { - return( object@storepost ) - } +setMethod( + "getStorepost", "mcmc", + function(object) { + return(object@storepost) + } ) -setMethod( "getRanperm", "mcmc", - function( object ) - { - return( object@ranperm ) - } +setMethod( + "getRanperm", "mcmc", + function(object) { + return(object@ranperm) + } ) ## Setters ## -setReplaceMethod( "setBurnin", "mcmc", - function( object, value ) - { - object@burnin <- as.integer( value ) - validObject( object ) - return( object ) - } +setReplaceMethod( + "setBurnin", "mcmc", + function(object, value) { + object@burnin <- as.integer(value) + validObject(object) + return(object) + } ) -setReplaceMethod( "setM", "mcmc", - function( object, value ) - { - object@M <- as.integer( value ) - validObject( object ) - return( object ) - } +setReplaceMethod( + "setM", "mcmc", + function(object, value) { + object@M <- as.integer(value) + validObject(object) + return(object) + } ) -setReplaceMethod( "setStartpar", "mcmc", - function( object, value ) - { - object@startpar <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setStartpar", "mcmc", + function(object, value) { + object@startpar <- value + validObject(object) + return(object) + } ) -setReplaceMethod( "setStoreS", "mcmc", - function( object, value ) - { - object@storeS <- as.integer( value ) - validObject( object ) - return( object ) - } +setReplaceMethod( + "setStoreS", "mcmc", + function(object, value) { + object@storeS <- as.integer(value) + validObject(object) + return(object) + } ) -setReplaceMethod( "setStorepost", "mcmc", - function( object, value ) - { - object@storepost <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setStorepost", "mcmc", + function(object, value) { + object@storepost <- value + validObject(object) + return(object) + } ) -setReplaceMethod( "setRanperm", "mcmc", - function( object, value ) - { - object@ranperm <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setRanperm", "mcmc", + function(object, value) { + object@ranperm <- value + validObject(object) + return(object) + } ) ### Private functions ### These functions are not exported -### Valid mcmc: The number of burnins @burnin and the number of +### Valid mcmc: The number of burnins @burnin and the number of ### last indicator vectors to store @storeS must be non-negative ### 'integers'. The number of MCMC draws @M must be a positive 'integer'. -".valid.MCMC" <- function( object ) -{ - if ( object@burnin < as.integer( 0 ) ) { - stop( paste( "Number of Burn-In draws in slot 'burnin' must be ", - "nonnegative.", sep = "" ) ) - } else if ( object@M <= as.integer( 0 ) ) { - stop( "Number of MCMC draws in slot 'M' must be positive. " ) - } else if ( object@storeS < as.integer( 0 ) ) { - stop( paste( "Number of indicators to store in slot 'storeS' must be ", - "nonnegative.", sep = "" ) ) - } - if ( object@storeS > object@M ) { - stop( paste( "Number of indicators to store in slot 'storeS' must be ", - "smaller or equal to the number of MCMC draws in slot 'M'.", - sep = "" ) ) - } +".valid.MCMC" <- function(object) { + if (object@burnin < as.integer(0)) { + stop(paste("Number of Burn-In draws in slot 'burnin' must be ", + "nonnegative.", + sep = "" + )) + } else if (object@M <= as.integer(0)) { + stop("Number of MCMC draws in slot 'M' must be positive. ") + } else if (object@storeS < as.integer(0)) { + stop(paste("Number of indicators to store in slot 'storeS' must be ", + "nonnegative.", + sep = "" + )) + } + if (object@storeS > object@M) { + stop(paste("Number of indicators to store in slot 'storeS' must be ", + "smaller or equal to the number of MCMC draws in slot 'M'.", + sep = "" + )) + } } - diff --git a/R/mcmcestfix.R b/R/mcmcestfix.R index 314efe3..6106d89 100644 --- a/R/mcmcestfix.R +++ b/R/mcmcestfix.R @@ -16,185 +16,201 @@ # along with finmix. If not, see . .mcmcestfix <- setClass("mcmcestfix", - representation(dist = "character", - K = "integer", - indicmod = "character", - burnin = "integer", - M = "integer", - ranperm = "logical", - relabel = "character", - map = "list", - bml = "list", - ieavg = "list", - sdpost = "list"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(dist = character(), - K = integer(), - indicmod = character(), - burnin = integer(), - M = integer(), - ranperm = logical(), - relabel = character(), - map = list(), - bml = list(), - ieavg = list(), - sdpost = list() - ) + representation( + dist = "character", + K = "integer", + indicmod = "character", + burnin = "integer", + M = "integer", + ranperm = "logical", + relabel = "character", + map = "list", + bml = "list", + ieavg = "list", + sdpost = "list" + ), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + dist = character(), + K = integer(), + indicmod = character(), + burnin = integer(), + M = integer(), + ranperm = logical(), + relabel = character(), + map = list(), + bml = list(), + ieavg = list(), + sdpost = list() + ) ) -setMethod("show", "mcmcestfix", - function(object) - { - cat("Object 'mcmcest'\n") - cat(" dist :", object@dist, "\n") - cat(" K :", object@K, "\n") - cat(" indicmod :", object@indicmod, - "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" relabel :", object@relabel, "\n") - cat(" map : List of", - length(object@map), "\n") - cat(" bml : List of", - length(object@bml), "\n") - cat(" ieavg : List of", - length(object@ieavg), "\n") - cat(" sdpost : List of", - length(object@sdpost), "\n") - } +setMethod( + "show", "mcmcestfix", + function(object) { + cat("Object 'mcmcest'\n") + cat(" dist :", object@dist, "\n") + cat(" K :", object@K, "\n") + cat( + " indicmod :", object@indicmod, + "\n" + ) + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" relabel :", object@relabel, "\n") + cat( + " map : List of", + length(object@map), "\n" + ) + cat( + " bml : List of", + length(object@bml), "\n" + ) + cat( + " ieavg : List of", + length(object@ieavg), "\n" + ) + cat( + " sdpost : List of", + length(object@sdpost), "\n" + ) + } ) -setMethod("Summary", "mcmcestfix", - function(x, ..., na.rm = FALSE) - { - dopt <- getOption("digits") - obj <- x - K <- obj@K - rnames <- .rownames.Mcmcestfix(obj) - cnames <- c("Estimates", "Std. Error") - cat("\n") - cat("Call: mcmcestimate\n") - cat("\n") - cat("Method: Gibbs Sampling with fixed indicators\n") - cat("\n") - cat(paste("Number of Iterations: ", obj@M, "\n", sep = "")) - cat(paste("Number of Burnin Iterations: ", obj@burnin, - "\n", sep = "")) - cat("\n") - cat("Parameters:\n") - cat("\n") - cat(paste("Component Parameters: ", - .parnames.Mcmcestfix(obj), "\n", sep = "")) - ## MAP ## - cat("Maximum A Posterior (MAP)\n") - parout <- .pars.map.Mcmcestfix(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("\n") - cat(paste("Log likelihood: ", sprintf("%.4f", obj@map$log), "\n", sep = "")) - cat("---\n") - ## BML ## - cat("Bayesian Maximum Likelihood (BML)\n") - parout <- .pars.bml.Mcmcestfix(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("\n") - cat(paste("Log likelihood: ", sprintf("%.4f", obj@bml$log), "\n", sep = "")) - cat("---\n") - ## IEAVG ## - cat("Identified Ergodic Average (IEAVG)\n") - parout <- .pars.ieavg.Mcmcestfix(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("---\n") - options(digits = dopt) - } +setMethod( + "Summary", "mcmcestfix", + function(x, ..., na.rm = FALSE) { + dopt <- getOption("digits") + obj <- x + K <- obj@K + rnames <- .rownames.Mcmcestfix(obj) + cnames <- c("Estimates", "Std. Error") + cat("\n") + cat("Call: mcmcestimate\n") + cat("\n") + cat("Method: Gibbs Sampling with fixed indicators\n") + cat("\n") + cat(paste("Number of Iterations: ", obj@M, "\n", sep = "")) + cat(paste("Number of Burnin Iterations: ", obj@burnin, + "\n", + sep = "" + )) + cat("\n") + cat("Parameters:\n") + cat("\n") + cat(paste("Component Parameters: ", + .parnames.Mcmcestfix(obj), "\n", + sep = "" + )) + ## MAP ## + cat("Maximum A Posterior (MAP)\n") + parout <- .pars.map.Mcmcestfix(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("\n") + cat(paste("Log likelihood: ", sprintf("%.4f", obj@map$log), "\n", sep = "")) + cat("---\n") + ## BML ## + cat("Bayesian Maximum Likelihood (BML)\n") + parout <- .pars.bml.Mcmcestfix(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("\n") + cat(paste("Log likelihood: ", sprintf("%.4f", obj@bml$log), "\n", sep = "")) + cat("---\n") + ## IEAVG ## + cat("Identified Ergodic Average (IEAVG)\n") + parout <- .pars.ieavg.Mcmcestfix(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("---\n") + options(digits = dopt) + } ) - + ## Getters ## -setMethod("getDist", "mcmcestfix", - function(object) - { - return(object@dist) - } +setMethod( + "getDist", "mcmcestfix", + function(object) { + return(object@dist) + } ) -setMethod("getK", "mcmcestfix", - function(object) - { - return(object@K) - } +setMethod( + "getK", "mcmcestfix", + function(object) { + return(object@K) + } ) -setMethod("getIndicmod", "mcmcestfix", - function(object) - { - return(object@indicmod) - } +setMethod( + "getIndicmod", "mcmcestfix", + function(object) { + return(object@indicmod) + } ) -setMethod("getBurnin", "mcmcestfix", - function(object) - { - return(object@burnin) - } +setMethod( + "getBurnin", "mcmcestfix", + function(object) { + return(object@burnin) + } ) -setMethod("getM", "mcmcestfix", - function(object) - { - return(object@M) - } +setMethod( + "getM", "mcmcestfix", + function(object) { + return(object@M) + } ) -setMethod("getRanperm", "mcmcestfix", - function(object) - { - return(object) - } +setMethod( + "getRanperm", "mcmcestfix", + function(object) { + return(object) + } ) -setMethod("getRelabel", "mcmcestfix", - function(object) - { - return(object@relabel) - } +setMethod( + "getRelabel", "mcmcestfix", + function(object) { + return(object@relabel) + } ) -setMethod("getMap", "mcmcestfix", - function(object) - { - return(object@map) - } +setMethod( + "getMap", "mcmcestfix", + function(object) { + return(object@map) + } ) -setMethod("getBml", "mcmcestfix", - function(object) - { - return(object@bml) - } +setMethod( + "getBml", "mcmcestfix", + function(object) { + return(object@bml) + } ) -setMethod("getIeavg", "mcmcestfix", - function(object) - { - return(object@ieavg) - } +setMethod( + "getIeavg", "mcmcestfix", + function(object) { + return(object@ieavg) + } ) -setMethod("getSdpost", "mcmcestfix", - function(object) - { - return(object@sdpost) - } +setMethod( + "getSdpost", "mcmcestfix", + function(object) { + return(object@sdpost) + } ) ## No setters as users are not intended to manipulate @@ -206,92 +222,83 @@ setMethod("getSdpost", "mcmcestfix", ### Summary ### Summary Map estimates: Creates a matrix with Map ### estimates. -".pars.map.Mcmcestfix" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.map.poisson.Mcmcestfix(obj) - } +".pars.map.Mcmcestfix" <- function(obj) { + if (obj@dist == "poisson") { + .pars.map.poisson.Mcmcestfix(obj) + } } ### Summary Map estimates Poisson: Creates a matrix ### with Map estimates for Poisson parameters. -".pars.map.poisson.Mcmcestfix" <- function(obj) -{ - parout <- matrix(0, nrow = obj@K, ncol = 2) - for (k in seq(1, obj@K)) { - parout[k, 1] <- obj@map$par$lambda[k] - parout[k, 2] <- obj@sdpost$identified$par$lambda[k] - } - return(parout) +".pars.map.poisson.Mcmcestfix" <- function(obj) { + parout <- matrix(0, nrow = obj@K, ncol = 2) + for (k in seq(1, obj@K)) { + parout[k, 1] <- obj@map$par$lambda[k] + parout[k, 2] <- obj@sdpost$identified$par$lambda[k] + } + return(parout) } ### Summary Bml estimates: Creates a matrix with Bml ### estimates. -".pars.bml.Mcmcestfix" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.bml.poisson.Mcmcestfix(obj) - } +".pars.bml.Mcmcestfix" <- function(obj) { + if (obj@dist == "poisson") { + .pars.bml.poisson.Mcmcestfix(obj) + } } ### Summary Bml estimates Poisson: Creates a matrix ### with Bml estimates for Poisson parameters. -".pars.bml.poisson.Mcmcestfix" <- function(obj) -{ - parout <- matrix(0, nrow = obj@K, ncol = 2) - for (k in seq(1, obj@K)) { - parout[k, 1] <- obj@bml$par$lambda[k] - parout[k, 2] <- obj@sdpost$identified$par$lambda[k] - } - return(parout) +".pars.bml.poisson.Mcmcestfix" <- function(obj) { + parout <- matrix(0, nrow = obj@K, ncol = 2) + for (k in seq(1, obj@K)) { + parout[k, 1] <- obj@bml$par$lambda[k] + parout[k, 2] <- obj@sdpost$identified$par$lambda[k] + } + return(parout) } ### Summary Ieavg estimates: Creates a matrix with Ieavg ### estimates. -".pars.ieavg.Mcmcestfix" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.ieavg.poisson.Mcmcestfix(obj) - } +".pars.ieavg.Mcmcestfix" <- function(obj) { + if (obj@dist == "poisson") { + .pars.ieavg.poisson.Mcmcestfix(obj) + } } ### Summary Bml estimates Poisson: Creates a matrix ### with Bml estimates for Poisson parameters. -".pars.ieavg.poisson.Mcmcestfix" <- function(obj) -{ - parout <- matrix(0, nrow = obj@K, ncol = 2) - for (k in seq(1, obj@K)) { - parout[k, 1] <- obj@ieavg$par$lambda[k] - parout[k, 2] <- obj@sdpost$identified$par$lambda[k] - } - return(parout) +".pars.ieavg.poisson.Mcmcestfix" <- function(obj) { + parout <- matrix(0, nrow = obj@K, ncol = 2) + for (k in seq(1, obj@K)) { + parout[k, 1] <- obj@ieavg$par$lambda[k] + parout[k, 2] <- obj@sdpost$identified$par$lambda[k] + } + return(parout) } ### Summary rownames: Creates rownames for the summary. -".rownames.Mcmcestfix" <- function(obj) -{ - if (obj@dist == "poisson") { - .rownames.poisson.Mcmcestfix(obj) - } +".rownames.Mcmcestfix" <- function(obj) { + if (obj@dist == "poisson") { + .rownames.poisson.Mcmcestfix(obj) + } } ### Summary rownames Poisson: Creates the row names ### for the summary of Poisson estimates. -".rownames.poisson.Mcmcestfix" <- function(obj) -{ - rnames <- rep("", obj@K) - for (k in seq(1, obj@K)) { - rnames[k] <- paste("lambda ", k, sep = "") - } - return(rnames) +".rownames.poisson.Mcmcestfix" <- function(obj) { + rnames <- rep("", obj@K) + for (k in seq(1, obj@K)) { + rnames[k] <- paste("lambda ", k, sep = "") + } + return(rnames) } ### Summary parameter names: Creates parameter ### names for the components. -".parnames.Mcmcestfix" <- function(obj) -{ - if (obj@dist == "poisson") { - parnames <- c("lambda") - } - return(parnames) +".parnames.Mcmcestfix" <- function(obj) { + if (obj@dist == "poisson") { + parnames <- c("lambda") + } + return(parnames) } diff --git a/R/mcmcestimate.R b/R/mcmcestimate.R index 4246691..37853c9 100644 --- a/R/mcmcestimate.R +++ b/R/mcmcestimate.R @@ -15,128 +15,148 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -"mcmcestimate" <- function(mcmcout, method = "kmeans", fdata = NULL, - permOut = FALSE, opt_ctrl=list(max_iter=200L)) { - ## Check input ## - .check.args.Mcmcestimate(mcmcout, method, fdata, permOut, opt_ctrl) - ## Constants - K <- mcmcout@model@K - M <- mcmcout@M - dist <- mcmcout@model@dist - indicmod <- mcmcout@model@indicmod - ranperm <- mcmcout@ranperm +"mcmcestimate" <- function(mcmcout, method = "kmeans", fdata = NULL, + permOut = FALSE, opt_ctrl = list(max_iter = 200L)) { + ## Check input ## + .check.args.Mcmcestimate(mcmcout, method, fdata, permOut, opt_ctrl) + ## Constants + K <- mcmcout@model@K + M <- mcmcout@M + dist <- mcmcout@model@dist + indicmod <- mcmcout@model@indicmod + ranperm <- mcmcout@ranperm - ## If it inherits from 'mcmcoutputbase' indicators - ## must be simulated. - indicfix <- mcmcout@model@indicfix + ## If it inherits from 'mcmcoutputbase' indicators + ## must be simulated. + indicfix <- mcmcout@model@indicfix - ## If it inherits from 'mcmcoutputperm' it has already - ## identified samples - perm <- inherits( mcmcout, what = "mcmcoutputperm" ) - - ## Posterior Mode (MAP) - map.index <- .map.Mcmcestimate( mcmcout ) - map <- .extract.Mcmcestimate( mcmcout, map.index ) - - ## Bayesian Maximum Likelihood (BML) - bml.index <- .bml.Mcmcestimate( mcmcout ) - bml <- .extract.Mcmcestimate( mcmcout, bml.index ) + ## If it inherits from 'mcmcoutputperm' it has already + ## identified samples + perm <- inherits(mcmcout, what = "mcmcoutputperm") - ## Ergodic average (EAVG) - eavg <- .eavg.Mcmcestimate( mcmcout ) - - if ( indicfix ) { - ## Ergodic average is identified - ## 'avg.id' - ## Posterior Std. Error. - sdpost <- .sdpost.Mcmcestimate( mcmcout, perm ) + ## Posterior Mode (MAP) + map.index <- .map.Mcmcestimate(mcmcout) + map <- .extract.Mcmcestimate(mcmcout, map.index) - .mcmcestfix( dist = dist, K = K, M = mcmcout@M, burnin = mcmcout@burnin, - ranperm = mcmcout@ranperm, relabel = "none", - indicmod = indicmod, map = map, bml = bml, ieavg = eavg, - sdpost = sdpost ) - } else { - if ( ranperm ) { - ## Ergodic average is invariant - ## 'inv' - ## Check if already identification has been made - if ( perm ) { - if ( mcmcout@Mperm > 0 ) { - ## Use ergodic average function on 'mcmcoutputperm' - ## object - ieavg <- .eavg.Mcmcestimate( mcmcout ) - ## Posterior Std. Error. - sdpost <- .sdpost.Mcmcestimate( mcmcout, perm ) - .mcmcestfix( dist = dist, K = K, - indicmod = indicmod, M = mcmcout@Mperm, - burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, - relabel = mcmcout@relabel, map = map, bml = bml, - ieavg = ieavg, sdpost = sdpost ) - } else { - warning( paste( "No identification possible. Not a single ", - "draw is a permutation", sep = "" ) ) - sdpost <- .sdpost.unidentified.Mcmcestimate( mcmcout ) - .mcmcestfix( dist = dist, K = K, - indicmod = indicmod, M = mcmcout@M, - burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, - relabel = method, map = map, bml = bml, - eavg = eavg, sdpost = sdpost ) - } - } else { - ## Use function 'mcmcpermute' to permute the sample - mcmcoutperm <- mcmcpermute( mcmcout, method = method, fdata = fdata, opt_ctrl=opt_ctrl ) - perm <- TRUE - if ( mcmcoutperm@Mperm > 0 ) { - ## Use ergodic average function on 'mcmcoutputperm' - ## object - ## Build 'avg.id' - ieavg <- .eavg.Mcmcestimate( mcmcoutperm ) - ## Posterior Std. Error - sdpost <- .sdpost.Mcmcestimate( mcmcoutperm, perm ) - mcmcest <- .mcmcestind( dist = dist, K = K, - indicmod = indicmod, M = mcmcoutperm@Mperm, - burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, - relabel = method, map = map, bml = bml, - ieavg = ieavg, eavg = eavg, sdpost = sdpost ) - if ( permOut ) { - return.list <- list( mcmcest = mcmcest, - mcmcoutputperm = mcmcoutperm ) - return( return.list ) - } else { - return( mcmcest ) - } - } else { - warning( paste( "No identification possible. Not a single ", - "draw is a permutation", sep = "" ) ) - sdpost <- .sdpost.unidentified.Mcmcestimate( mcmcout ) - mcmcest <- .mcmcestind( dist = dist, K = K, - indicmod = indicmod, M = mcmcout@M, - burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, - relabel = method, map = map, bml = bml, - ieavg = list(), eavg = eavg, sdpost = sdpost ) - if ( permOut ) { - return.list <- list( mcmcest = mcmcest, - mcmcoutputperm = mcmcoutperm ) - return( return.list ) - } else { - return( mcmcest ) - } - } - } - } else { - ## 'eavg' - ## Posterior Std. Error - sdpost <- .sdpost.Mcmcestimate( mcmcout, perm ) - .mcmcestfix( dist = dist, K = K, indicmod = indicmod, - M = mcmcout@M, burnin = mcmcout@burnin, - ranperm = mcmcout@ranperm, relabel = "none", - map = map, bml = bml, ieavg = eavg, sdpost = sdpost ) + ## Bayesian Maximum Likelihood (BML) + bml.index <- .bml.Mcmcestimate(mcmcout) + bml <- .extract.Mcmcestimate(mcmcout, bml.index) + + ## Ergodic average (EAVG) + eavg <- .eavg.Mcmcestimate(mcmcout) + + if (indicfix) { + ## Ergodic average is identified + ## 'avg.id' + ## Posterior Std. Error. + sdpost <- .sdpost.Mcmcestimate(mcmcout, perm) + + .mcmcestfix( + dist = dist, K = K, M = mcmcout@M, burnin = mcmcout@burnin, + ranperm = mcmcout@ranperm, relabel = "none", + indicmod = indicmod, map = map, bml = bml, ieavg = eavg, + sdpost = sdpost + ) + } else { + if (ranperm) { + ## Ergodic average is invariant + ## 'inv' + ## Check if already identification has been made + if (perm) { + if (mcmcout@Mperm > 0) { + ## Use ergodic average function on 'mcmcoutputperm' + ## object + ieavg <- .eavg.Mcmcestimate(mcmcout) + ## Posterior Std. Error. + sdpost <- .sdpost.Mcmcestimate(mcmcout, perm) + .mcmcestfix( + dist = dist, K = K, + indicmod = indicmod, M = mcmcout@Mperm, + burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, + relabel = mcmcout@relabel, map = map, bml = bml, + ieavg = ieavg, sdpost = sdpost + ) + } else { + warning(paste("No identification possible. Not a single ", + "draw is a permutation", + sep = "" + )) + sdpost <- .sdpost.unidentified.Mcmcestimate(mcmcout) + .mcmcestfix( + dist = dist, K = K, + indicmod = indicmod, M = mcmcout@M, + burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, + relabel = method, map = map, bml = bml, + eavg = eavg, sdpost = sdpost + ) + } + } else { + ## Use function 'mcmcpermute' to permute the sample + mcmcoutperm <- mcmcpermute(mcmcout, method = method, fdata = fdata, opt_ctrl = opt_ctrl) + perm <- TRUE + if (mcmcoutperm@Mperm > 0) { + ## Use ergodic average function on 'mcmcoutputperm' + ## object + ## Build 'avg.id' + ieavg <- .eavg.Mcmcestimate(mcmcoutperm) + ## Posterior Std. Error + sdpost <- .sdpost.Mcmcestimate(mcmcoutperm, perm) + mcmcest <- .mcmcestind( + dist = dist, K = K, + indicmod = indicmod, M = mcmcoutperm@Mperm, + burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, + relabel = method, map = map, bml = bml, + ieavg = ieavg, eavg = eavg, sdpost = sdpost + ) + if (permOut) { + return.list <- list( + mcmcest = mcmcest, + mcmcoutputperm = mcmcoutperm + ) + return(return.list) + } else { + return(mcmcest) + } + } else { + warning(paste("No identification possible. Not a single ", + "draw is a permutation", + sep = "" + )) + sdpost <- .sdpost.unidentified.Mcmcestimate(mcmcout) + mcmcest <- .mcmcestind( + dist = dist, K = K, + indicmod = indicmod, M = mcmcout@M, + burnin = mcmcout@burnin, ranperm = mcmcout@ranperm, + relabel = method, map = map, bml = bml, + ieavg = list(), eavg = eavg, sdpost = sdpost + ) + if (permOut) { + return.list <- list( + mcmcest = mcmcest, + mcmcoutputperm = mcmcoutperm + ) + return(return.list) + } else { + return(mcmcest) + } } + } + } else { + ## 'eavg' + ## Posterior Std. Error + sdpost <- .sdpost.Mcmcestimate(mcmcout, perm) + .mcmcestfix( + dist = dist, K = K, indicmod = indicmod, + M = mcmcout@M, burnin = mcmcout@burnin, + ranperm = mcmcout@ranperm, relabel = "none", + map = map, bml = bml, ieavg = eavg, sdpost = sdpost + ) } - ## New 'mcmcestimate' object. - - ## In case the permOut = TRUE the mcmcout object is - ## returned as well in a list + } + ## New 'mcmcestimate' object. + + ## In case the permOut = TRUE the mcmcout object is + ## returned as well in a list } ### Private functions @@ -146,458 +166,605 @@ ### Check arguments: The 'mcmcout' object must inherit from ### 'mcmcoutput' or 'mcmcoutputperm'. Argument 2 must match one ### of three permutation algorithms in 'mcmcpermute()'. -### Argument 3 must be of type logical. If any case is not true +### Argument 3 must be of type logical. If any case is not true ### an error is thrown. -".check.args.Mcmcestimate" <- function( obj, arg2, arg3, arg4, arg5 ) -{ - if ( !inherits( obj, c( "mcmcoutput", "mcmcoutputperm" ) ) ) { - stop( paste( "Wrong argument: Argument 1 must be an object ", - "either of class 'mcmcoutput' or of type ", - "'mcmcoutputperm'.", sep = "" ) ) - } - match.arg( arg2, c( "kmeans", "Stephens1997a", "Stephens1997b" ) ) - if ( !inherits( arg3, "fdata" ) && !is.null( arg3 ) ) { - stop( paste( "Wrong argument: Argument 3 must be an object ", - "of class 'fdata'.", sep = "" ) ) - } - if ( !is.logical( arg4 ) ) { - stop( "Wrong argument: Argument 4 must be of type 'logical'." ) +".check.args.Mcmcestimate" <- function(obj, arg2, arg3, arg4, arg5) { + if (!inherits(obj, c("mcmcoutput", "mcmcoutputperm"))) { + stop(paste("Wrong argument: Argument 1 must be an object ", + "either of class 'mcmcoutput' or of type ", + "'mcmcoutputperm'.", + sep = "" + )) + } + match.arg(arg2, c("kmeans", "Stephens1997a", "Stephens1997b")) + if (!inherits(arg3, "fdata") && !is.null(arg3)) { + stop(paste("Wrong argument: Argument 3 must be an object ", + "of class 'fdata'.", + sep = "" + )) + } + if (!is.logical(arg4)) { + stop("Wrong argument: Argument 4 must be of type 'logical'.") + } + if (length(arg5) != 0) { + if ("max_iter" %in% names(arg5)) { + if (!is.numeric(arg5$max_iter)) { + stop(paste0( + "Wrong argument: In argument 5 'max_iter' ", + "has to be of type integer." + )) + } + } else { + stop(paste0( + "Wrong argument: Argument 5 must contain a variable ", + "'max_iter' of type integer." + )) } - if (length(arg5) != 0){ - if("max_iter" %in% names(arg5)) { - if(!is.numeric(arg5$max_iter)) { - stop(paste0("Wrong argument: In argument 5 'max_iter' ", - "has to be of type integer.")) - } - } else { - stop(paste0("Wrong argument: Argument 5 must contain a variable ", - "'max_iter' of type integer.")) - } - } + } } -".map.Mcmcestimate" <- function( obj ) { - ## Take the value with the highest posterior log - ## likelihood - mixpost <- obj@log$mixlik + obj@log$mixprior - mixpost.sort <- sort.int( mixpost, index.return = TRUE ) - map.index <- tail( mixpost.sort$ix, 1 ) - return( as.integer( map.index ) ) +".map.Mcmcestimate" <- function(obj) { + ## Take the value with the highest posterior log + ## likelihood + mixpost <- obj@log$mixlik + obj@log$mixprior + mixpost.sort <- sort.int(mixpost, index.return = TRUE) + map.index <- tail(mixpost.sort$ix, 1) + return(as.integer(map.index)) } -".bml.Mcmcestimate" <- function( obj ) { - ## Take the value with the highest log likelihood - mixlik <- obj@log$mixlik - mixlik.sort <- sort.int( mixlik, index.return = TRUE ) - bml.index <- tail( mixlik.sort$ix, 1 ) - return( bml.index ) +".bml.Mcmcestimate" <- function(obj) { + ## Take the value with the highest log likelihood + mixlik <- obj@log$mixlik + mixlik.sort <- sort.int(mixlik, index.return = TRUE) + bml.index <- tail(mixlik.sort$ix, 1) + return(bml.index) } - -".extract.Mcmcestimate" <- function( obj, m ) { - ## Extract the 'm'th row in each slot of an mcmcout - ## object - K <- obj@model@K - dist <- obj@model@dist - indicfix <- !inherits( obj, what = "mcmcoutputbase" ) - if ( dist %in% c( "poisson", "cond.poisson", "exponential" ) ) { - par.est <- list( lambda = as.array( obj@par$lambda[m, ] ) ) - } else if ( dist == "binomial" ) { - par.est <- list( p = as.array( obj@par$p[m, ] ) ) - } else if ( dist == "normal" ) { - par.est <- list( mu = as.array( obj@par$mu[m, ] ), - sigma = as.array( obj@par$sigma[m, ] ) ) - } else if ( dist == "student" ) { - par.est <- list( mu = as.array( obj@par$mu[m, ] ), - sigma = as.array( obj@par$sigma[m, ] ), - df = as.array( obj@par$df[m, ] ) ) - } else if ( dist == "normult" ) { - par.est <- list( mu = as.array( obj@par$mu[m, , ] ), - sigma = qinmatrmult( obj@par$sigma[m, , ] ), - sigmainv = qinmatrmult( obj@par$sigmainv[m, , ] ) ) - } else if ( dist == "studmult" ) { - par.est <- list( mu = as.array( obj@par$mu[m, , ]), - sigma = qinmatrmult( obj@par$sigma[m, , ] ), - sigmainv = qinmatrmult( obj@par$sigmainv[m, , ] ), - df = as.array( obj@par$df[m, ] ) ) - } - if( !indicfix && K > 1 ) { - weight.est <- as.array( obj@weight[m, ] ) - est.list <- list( par = par.est, weight = weight.est, - log = obj@log$mixlik[m] ) - return( est.list ) - } - est.list <- list( par = par.est, log = obj@log$mixlik[m] ) - return( est.list ) + +".extract.Mcmcestimate" <- function(obj, m) { + ## Extract the 'm'th row in each slot of an mcmcout + ## object + K <- obj@model@K + dist <- obj@model@dist + indicfix <- !inherits(obj, what = "mcmcoutputbase") + if (dist %in% c("poisson", "cond.poisson", "exponential")) { + par.est <- list(lambda = as.array(obj@par$lambda[m, ])) + } else if (dist == "binomial") { + par.est <- list(p = as.array(obj@par$p[m, ])) + } else if (dist == "normal") { + par.est <- list( + mu = as.array(obj@par$mu[m, ]), + sigma = as.array(obj@par$sigma[m, ]) + ) + } else if (dist == "student") { + par.est <- list( + mu = as.array(obj@par$mu[m, ]), + sigma = as.array(obj@par$sigma[m, ]), + df = as.array(obj@par$df[m, ]) + ) + } else if (dist == "normult") { + par.est <- list( + mu = as.array(obj@par$mu[m, , ]), + sigma = qinmatrmult(obj@par$sigma[m, , ]), + sigmainv = qinmatrmult(obj@par$sigmainv[m, , ]) + ) + } else if (dist == "studmult") { + par.est <- list( + mu = as.array(obj@par$mu[m, , ]), + sigma = qinmatrmult(obj@par$sigma[m, , ]), + sigmainv = qinmatrmult(obj@par$sigmainv[m, , ]), + df = as.array(obj@par$df[m, ]) + ) + } + if (!indicfix && K > 1) { + weight.est <- as.array(obj@weight[m, ]) + est.list <- list( + par = par.est, weight = weight.est, + log = obj@log$mixlik[m] + ) + return(est.list) + } + est.list <- list(par = par.est, log = obj@log$mixlik[m]) + return(est.list) } -".eavg.Mcmcestimate" <- function( obj ) { - ## Check arguments ## - dist <- obj@model@dist - indicfix <- !inherits( obj, what = "mcmcoutputbase" ) - perm <- inherits( obj, what = "mcmcoutputperm" ) - if ( dist %in% c( "poisson", "cond.poisson" , "exponential" ) ) { - if( !perm ) { - par.eavg <- list( lambda = as.array( apply( obj@par$lambda, - 2, mean, na.rm = TRUE ) ) ) - } else { - par.eavg <- list( lambda = as.array( apply( obj@parperm$lambda, - 2, mean, na.rm = TRUE ) ) ) - } - } else if ( dist == "binomial" ) { - if ( !perm ) { - par.eavg <- list( p = as.array( apply( obj@par$p, 2, mean, - na.rm = TRUE ) ) ) - } else { - par.eavg <- list(p = as.array(apply(obj@parperm$p, 2, mean, - na.rm = TRUE ) ) ) - } - } else if ( dist == "normal" ) { - if ( !perm ) { - par.eavg <- list( mu = as.array( apply( obj@par$mu, 2, - mean, na.rm = TRUE ) ), - sigma = as.array( apply( obj@par$sigma, 2, - mean, na.rm = TRUE ) ) ) - } else { - par.eavg <- list( mu = as.array( apply( obj@parperm$mu, 2, - mean, na.rm = TRUE ) ), - sigma = as.array( apply( obj@parperm$sigma, 2, - mean, na.rm = TRUE ) ) ) - } - } else if ( dist == "student" ) { - if ( !perm ) { - par.eavg <- list( mu = as.array( apply( obj@par$mu, 2, - mean, na.rm = TRUE ) ), - sigma = as.array( apply( obj@par$sigma, 2, - mean, na.rm = TRUE) ), - df = as.array( apply( obj@par$df, 2, - mean, na.rm = TRUE ) ) ) - } else { - par.eavg <- list( mu = as.array( apply( obj@parperm$mu, 2, - mean, na.rm = TRUE ) ), - sigma = as.array( apply( obj@parperm$sigma, 2, - mean, na.rm = TRUE ) ), - df = as.array( apply( obj@parperm$df, 2, - mean, na.rm = TRUE ) ) ) - } - } else if ( dist == "normult" ) { - if ( !perm ) { - par.eavg <- list( mu = as.array( apply( obj@par$mu, c( 2, 3 ), - mean, na.rm = TRUE ) ), - sigma = as.array( t( apply( obj@par$sigma, c(2, 3), - mean, na.rm = TRUE ) ) ), - sigmainv = as.array( t( apply( obj@par$sigmainv, c(2, 3), - mean, na.rm = TRUE ) ) ) ) - } else { - par.eavg <- list( mu = as.array( apply( obj@parperm$mu, c( 2, 3 ), - mean, na.rm = TRUE ) ), - sigma = as.array( t( apply( obj@parperm$sigma, c(2, 3), - mean, na.rm = TRUE ) ) ), - sigmainv = as.array( t( apply( obj@parperm$sigmainv, c(2, 3), - mean, na.rm = TRUE ) ) ) ) - } - } else if ( dist == "studmult" ) { - if ( !perm ) { - par.eavg <- list( mu = as.array( apply( obj@par$mu, c( 2, 3 ), - mean, na.rm = TRUE ) ), - sigma = as.array( t( apply( obj@par$sigma, c(2, 3), - mean, na.rm = TRUE ) ) ), - sigmainv = as.array( t( apply( obj@par$sigmainv, c(2, 3), - mean, na.rm = TRUE ) ) ), - df = as.array( apply( obj@par$df, 2, - mean, na.rm = TRUE ) ) ) - } else { - par.eavg <- list( mu = as.array( apply( obj@parperm$mu, c( 2, 3 ), - mean, na.rm = TRUE ) ), - sigma = as.array( t( apply( obj@parperm$sigma, c(2, 3), - mean, na.rm = TRUE ) ) ), - sigmainv = as.array( t( apply( obj@parperm$sigmainv, c(2, 3), - mean, na.rm = TRUE ) ) ), - df = as.array( apply( obj@parperm$df, 2, - mean, na = TRUE ) ) ) - } +".eavg.Mcmcestimate" <- function(obj) { + ## Check arguments ## + dist <- obj@model@dist + indicfix <- !inherits(obj, what = "mcmcoutputbase") + perm <- inherits(obj, what = "mcmcoutputperm") + if (dist %in% c("poisson", "cond.poisson", "exponential")) { + if (!perm) { + par.eavg <- list(lambda = as.array(apply(obj@par$lambda, + 2, mean, + na.rm = TRUE + ))) + } else { + par.eavg <- list(lambda = as.array(apply(obj@parperm$lambda, + 2, mean, + na.rm = TRUE + ))) } - if ( indicfix ) { - eavg.list <- list( par = par.eavg ) - return( eavg.list ) + } else if (dist == "binomial") { + if (!perm) { + par.eavg <- list(p = as.array(apply(obj@par$p, 2, mean, + na.rm = TRUE + ))) } else { - if ( perm ) { - weight.eavg <- as.array( apply( obj@weightperm, - 2, mean, na.rm = TRUE ) ) - eavg.list <- list( par = par.eavg, weight = weight.eavg ) - return( eavg.list ) - } else { - weight.eavg = as.array( apply( obj@weight, 2, mean, - na.rm = TRUE ) ) - eavg.list <- list( par = par.eavg, weight = weight.eavg ) - return( eavg.list ) - } + par.eavg <- list(p = as.array(apply(obj@parperm$p, 2, mean, + na.rm = TRUE + ))) } + } else if (dist == "normal") { + if (!perm) { + par.eavg <- list( + mu = as.array(apply(obj@par$mu, 2, + mean, + na.rm = TRUE + )), + sigma = as.array(apply(obj@par$sigma, 2, + mean, + na.rm = TRUE + )) + ) + } else { + par.eavg <- list( + mu = as.array(apply(obj@parperm$mu, 2, + mean, + na.rm = TRUE + )), + sigma = as.array(apply(obj@parperm$sigma, 2, + mean, + na.rm = TRUE + )) + ) + } + } else if (dist == "student") { + if (!perm) { + par.eavg <- list( + mu = as.array(apply(obj@par$mu, 2, + mean, + na.rm = TRUE + )), + sigma = as.array(apply(obj@par$sigma, 2, + mean, + na.rm = TRUE + )), + df = as.array(apply(obj@par$df, 2, + mean, + na.rm = TRUE + )) + ) + } else { + par.eavg <- list( + mu = as.array(apply(obj@parperm$mu, 2, + mean, + na.rm = TRUE + )), + sigma = as.array(apply(obj@parperm$sigma, 2, + mean, + na.rm = TRUE + )), + df = as.array(apply(obj@parperm$df, 2, + mean, + na.rm = TRUE + )) + ) + } + } else if (dist == "normult") { + if (!perm) { + par.eavg <- list( + mu = as.array(apply(obj@par$mu, c(2, 3), + mean, + na.rm = TRUE + )), + sigma = as.array(t(apply(obj@par$sigma, c(2, 3), + mean, + na.rm = TRUE + ))), + sigmainv = as.array(t(apply(obj@par$sigmainv, c(2, 3), + mean, + na.rm = TRUE + ))) + ) + } else { + par.eavg <- list( + mu = as.array(apply(obj@parperm$mu, c(2, 3), + mean, + na.rm = TRUE + )), + sigma = as.array(t(apply(obj@parperm$sigma, c(2, 3), + mean, + na.rm = TRUE + ))), + sigmainv = as.array(t(apply(obj@parperm$sigmainv, c(2, 3), + mean, + na.rm = TRUE + ))) + ) + } + } else if (dist == "studmult") { + if (!perm) { + par.eavg <- list( + mu = as.array(apply(obj@par$mu, c(2, 3), + mean, + na.rm = TRUE + )), + sigma = as.array(t(apply(obj@par$sigma, c(2, 3), + mean, + na.rm = TRUE + ))), + sigmainv = as.array(t(apply(obj@par$sigmainv, c(2, 3), + mean, + na.rm = TRUE + ))), + df = as.array(apply(obj@par$df, 2, + mean, + na.rm = TRUE + )) + ) + } else { + par.eavg <- list( + mu = as.array(apply(obj@parperm$mu, c(2, 3), + mean, + na.rm = TRUE + )), + sigma = as.array(t(apply(obj@parperm$sigma, c(2, 3), + mean, + na.rm = TRUE + ))), + sigmainv = as.array(t(apply(obj@parperm$sigmainv, c(2, 3), + mean, + na.rm = TRUE + ))), + df = as.array(apply(obj@parperm$df, 2, + mean, + na = TRUE + )) + ) + } + } + if (indicfix) { + eavg.list <- list(par = par.eavg) + return(eavg.list) + } else { + if (perm) { + weight.eavg <- as.array(apply(obj@weightperm, + 2, mean, + na.rm = TRUE + )) + eavg.list <- list(par = par.eavg, weight = weight.eavg) + return(eavg.list) + } else { + weight.eavg <- as.array(apply(obj@weight, 2, mean, + na.rm = TRUE + )) + eavg.list <- list(par = par.eavg, weight = weight.eavg) + return(eavg.list) + } + } } -".sdpost.Mcmcestimate" <- function( obj, perm ) -{ - dist <- obj@model@dist - if ( dist %in% c( "poisson", "cond.poisson", "exponential" ) ) { - .sdpost.poisson.Mcmcestimate( obj, perm ) - } else if ( dist == "binomial" ) { - .sdpost.binomial.Mcmcestimate( obj, perm ) - } else if ( dist == "normal" ) { - .sdpost.normal.Mcmcestimate( obj, perm ) - } else if ( dist == "student" ) { - .sdpost.student.Mcmcestimate( obj, perm ) - } else if ( dist == "normult" ) { - .sdpost.normult.Mcmcestimate( obj, perm ) - } else if ( dist == "studmult" ) { - .sdpost.studmult.Mcmcestimate( obj, perm ) - } +".sdpost.Mcmcestimate" <- function(obj, perm) { + dist <- obj@model@dist + if (dist %in% c("poisson", "cond.poisson", "exponential")) { + .sdpost.poisson.Mcmcestimate(obj, perm) + } else if (dist == "binomial") { + .sdpost.binomial.Mcmcestimate(obj, perm) + } else if (dist == "normal") { + .sdpost.normal.Mcmcestimate(obj, perm) + } else if (dist == "student") { + .sdpost.student.Mcmcestimate(obj, perm) + } else if (dist == "normult") { + .sdpost.normult.Mcmcestimate(obj, perm) + } else if (dist == "studmult") { + .sdpost.studmult.Mcmcestimate(obj, perm) + } } -".sdpost.poisson.Mcmcestimate" <- function(obj, perm) -{ - if ( perm ) { - sdpar <- apply( obj@parperm$lambda, 2, sd, na.rm = TRUE ) - sdparpre <- apply( obj@par$lambda, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weightperm, 2, sd, na.rm = TRUE ) - sdweightpre <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( lambda = sdpar ), - weight = sdweight ) - unidentified <- list( par = list( lambda = sdparpre ), - weight = sdweightpre ) - sdlist <- list( identified = identified, - unidentified = unidentified ) - } else { - sdpar <- apply( obj@par$lambda, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( lambda = sdpar), weight = sdweight ) - sdlist <- list( identified = identified ) - } - return( sdlist ) +".sdpost.poisson.Mcmcestimate" <- function(obj, perm) { + if (perm) { + sdpar <- apply(obj@parperm$lambda, 2, sd, na.rm = TRUE) + sdparpre <- apply(obj@par$lambda, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weightperm, 2, sd, na.rm = TRUE) + sdweightpre <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list(lambda = sdpar), + weight = sdweight + ) + unidentified <- list( + par = list(lambda = sdparpre), + weight = sdweightpre + ) + sdlist <- list( + identified = identified, + unidentified = unidentified + ) + } else { + sdpar <- apply(obj@par$lambda, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list(par = list(lambda = sdpar), weight = sdweight) + sdlist <- list(identified = identified) + } + return(sdlist) } -".sdpost.binomial.Mcmcestimate" <- function( obj, perm ) -{ - if ( perm ) { - sdpar <- apply( obj@parperm$p, 2, sd, na.rm = TRUE ) - sdparpre <- apply( obj@par$p, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weightperm, 2, sd, na.rm = TRUE ) - sdweightpre <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( p = sdpar ), - weight = sdweight ) - unidentified <- list( par = list( p = sdparpre ), - weight = sdweightpre ) - sdlist <- list( identified = identified, - unidentified = unidentified ) - } else { - sdpar <- apply( obj@par$p, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( p = sdpar ), - weight = sdweight ) - sdlist <- list( identified = identified ) - } - return( sdlist ) +".sdpost.binomial.Mcmcestimate" <- function(obj, perm) { + if (perm) { + sdpar <- apply(obj@parperm$p, 2, sd, na.rm = TRUE) + sdparpre <- apply(obj@par$p, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weightperm, 2, sd, na.rm = TRUE) + sdweightpre <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list(p = sdpar), + weight = sdweight + ) + unidentified <- list( + par = list(p = sdparpre), + weight = sdweightpre + ) + sdlist <- list( + identified = identified, + unidentified = unidentified + ) + } else { + sdpar <- apply(obj@par$p, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list(p = sdpar), + weight = sdweight + ) + sdlist <- list(identified = identified) + } + return(sdlist) } -".sdpost.normal.Mcmcestimate" <- function( obj, perm ) -{ - if ( perm ) { - sdmu <- apply( obj@parperm$mu, 2, sd, na.rm = TRUE ) - sdmupre <- apply( obj@par$mu, 2, sd, na.rm = TRUE ) - sdsigma <- apply( obj@parperm$sigma, 2, sd, na.rm = TRUE ) - sdsigmapre <- apply( obj@par$sigma, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weightperm, 2, sd, na.rm = TRUE ) - sdweightpre <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma ), - weight = sdweight ) - unidentified <- list( par = list( mu = sdmupre, sigma = sdsigmapre ), - weight = sdweightpre ) - sdlist <- list( identified = identified, - unidentified = unidentified ) - } else { - sdmu <- apply( obj@par$mu, 2, sd, na.rm = TRUE ) - sdsigma <- apply( obj@par$sigma, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma ), - weight = sdweight ) - sdlist <- list( identified = identified ) - } - return( sdlist ) +".sdpost.normal.Mcmcestimate" <- function(obj, perm) { + if (perm) { + sdmu <- apply(obj@parperm$mu, 2, sd, na.rm = TRUE) + sdmupre <- apply(obj@par$mu, 2, sd, na.rm = TRUE) + sdsigma <- apply(obj@parperm$sigma, 2, sd, na.rm = TRUE) + sdsigmapre <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weightperm, 2, sd, na.rm = TRUE) + sdweightpre <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list(mu = sdmu, sigma = sdsigma), + weight = sdweight + ) + unidentified <- list( + par = list(mu = sdmupre, sigma = sdsigmapre), + weight = sdweightpre + ) + sdlist <- list( + identified = identified, + unidentified = unidentified + ) + } else { + sdmu <- apply(obj@par$mu, 2, sd, na.rm = TRUE) + sdsigma <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list(mu = sdmu, sigma = sdsigma), + weight = sdweight + ) + sdlist <- list(identified = identified) + } + return(sdlist) } -".sdpost.student.Mcmcestimate" <- function( obj, perm ) -{ - if ( perm ) { - sdmu <- apply( obj@parperm$mu, 2, sd, na.rm = TRUE ) - sdmupre <- apply( obj@par$mu, 2, sd, na.rm = TRUE ) - sdsigma <- apply( obj@parperm$sigma, 2, sd, na.rm = TRUE ) - sdsigmapre <- apply( obj@par$sigma, 2, sd, na.rm = TRUE ) - sddf <- apply( obj@parperm$df, 2, sd, na.rm = TRUE ) - sddfpre <- apply( obj@parperm$df, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weightperm, 2, sd, na.rm = TRUE ) - sdweightpre <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma, - df = sddf ), - weight = sdweight ) - unidentified <- list( par = list( mu = sdmupre, sigma = sdsigmapre, - df = sddfpre ), - weight = sdweightpre ) - sdlist <- list( identified = identified, - unidentified = unidentified ) - } else { - sdmu <- apply( obj@par$mu, 2, sd, na.rm = TRUE ) - sdsigma <- apply( obj@par$sigma, 2, sd, na.rm = TRUE ) - sddf <- apply( obj@par$sigma, 2, sd, na.rm = TRUE ) - sdweight <- apply( obj@weight, 2, sd, na.rm = TRUE ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma, - df = sddf ), - weight = sdweight ) - sdlist <- list( identified = identified ) - } - return( sdlist ) +".sdpost.student.Mcmcestimate" <- function(obj, perm) { + if (perm) { + sdmu <- apply(obj@parperm$mu, 2, sd, na.rm = TRUE) + sdmupre <- apply(obj@par$mu, 2, sd, na.rm = TRUE) + sdsigma <- apply(obj@parperm$sigma, 2, sd, na.rm = TRUE) + sdsigmapre <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) + sddf <- apply(obj@parperm$df, 2, sd, na.rm = TRUE) + sddfpre <- apply(obj@parperm$df, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weightperm, 2, sd, na.rm = TRUE) + sdweightpre <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list( + mu = sdmu, sigma = sdsigma, + df = sddf + ), + weight = sdweight + ) + unidentified <- list( + par = list( + mu = sdmupre, sigma = sdsigmapre, + df = sddfpre + ), + weight = sdweightpre + ) + sdlist <- list( + identified = identified, + unidentified = unidentified + ) + } else { + sdmu <- apply(obj@par$mu, 2, sd, na.rm = TRUE) + sdsigma <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) + sddf <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) + sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list( + par = list( + mu = sdmu, sigma = sdsigma, + df = sddf + ), + weight = sdweight + ) + sdlist <- list(identified = identified) + } + return(sdlist) } -".sdpost.normult.Mcmcestimate" <- function( obj, perm ) -{ - r <- obj@model@r - K <- obj@model@K - s <- r * (r + 1) / 2 - if ( perm ) { - if ( K == 1 ) { - sdmu <- cov( obj@parperm$mu ) - sdmupre <- cov( obj@par$mu ) - sdsigma <- cov( obj@parperm$sigma ) - sdsigmapre <- cov( obj@par$sigma ) - sdsigmainv <- cov( obj@parperm$sigmainv ) - sdsigmainvpre <- cov( obj@par$sigmainv ) - } else { - sdmu <- array( numeric(), dim = c( r, r, K ) ) - sdsigma <- array( numeric(), dim = c( s, s, K ) ) - sdsigmainv <- array( numeric(), dim = c( s, s, K ) ) - sdmupre <- array( numeric(), dim = c( r, r, K ) ) - sdsigmapre <- array( numeric(), dim = c( s, s, K ) ) - sdsigmainvpre <- array( numeric(), dim = c( s, s, K ) ) - for (k in 1:K) { - sdmu[,,k] <- cov( obj@parperm$mu[,,k] ) - sdsigma[,,k] <- cov( obj@parperm$sigma[,,k] ) - sdsigmainv[,,k] <- cov( obj@parperm$sigmainv[,,k] ) - sdmupre[,,k] <- cov( obj@par$mu[,,k] ) - sdsigmapre[,,k] <- cov( obj@par$sigma[,,k] ) - sdsigmainvpre[,,k] <- cov( obj@par$sigmainv[,,k] ) - } - } - sdweight <- apply( obj@weightperm, 2, sd ) - sdweightpre <- apply( obj@weight, 2, sd ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma, - sigmainv = sdsigmainv ), - weight = sdweight ) - unidentified <- list( par = list( mu = sdmupre, sigma = sdsigmapre, - sigmainv = sdsigmainvpre ), - weight = sdweightpre ) - sdlist <- list( identified = identified, - unidentified = unidentified ) +".sdpost.normult.Mcmcestimate" <- function(obj, perm) { + r <- obj@model@r + K <- obj@model@K + s <- r * (r + 1) / 2 + if (perm) { + if (K == 1) { + sdmu <- cov(obj@parperm$mu) + sdmupre <- cov(obj@par$mu) + sdsigma <- cov(obj@parperm$sigma) + sdsigmapre <- cov(obj@par$sigma) + sdsigmainv <- cov(obj@parperm$sigmainv) + sdsigmainvpre <- cov(obj@par$sigmainv) } else { - if ( K == 1 ) { - sdmu <- cov( obj@par$mu ) - sdsigma <- cov( obj@par$sigma ) - sdsigmainv <- cov( obj@par$sigmainv ) - } else { - sdmu <- array( numeric(), dim = c( r, r, K ) ) - sdsigma <- array( numeric(), dim = c( s, s, K ) ) - sdsigmainv <- array( numeric(), dim = c( s, s, K ) ) - for (k in 1:K) { - sdmu[,,k] <- cov( obj@par$mu[,,k] ) - sdsigma[,,k] <- cov( obj@par$sigma[,,k] ) - sdsigmainv[,,k] <- cov( obj@par$sigmainv[,,k] ) - } - } - sdweight <- apply( obj@weight, 2, sd ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma, - sigmainv = sdsigmainv ), - weight = sdweight ) - sdlist <- list( identified = identified ) + sdmu <- array(numeric(), dim = c(r, r, K)) + sdsigma <- array(numeric(), dim = c(s, s, K)) + sdsigmainv <- array(numeric(), dim = c(s, s, K)) + sdmupre <- array(numeric(), dim = c(r, r, K)) + sdsigmapre <- array(numeric(), dim = c(s, s, K)) + sdsigmainvpre <- array(numeric(), dim = c(s, s, K)) + for (k in 1:K) { + sdmu[, , k] <- cov(obj@parperm$mu[, , k]) + sdsigma[, , k] <- cov(obj@parperm$sigma[, , k]) + sdsigmainv[, , k] <- cov(obj@parperm$sigmainv[, , k]) + sdmupre[, , k] <- cov(obj@par$mu[, , k]) + sdsigmapre[, , k] <- cov(obj@par$sigma[, , k]) + sdsigmainvpre[, , k] <- cov(obj@par$sigmainv[, , k]) + } } - return( sdlist ) + sdweight <- apply(obj@weightperm, 2, sd) + sdweightpre <- apply(obj@weight, 2, sd) + identified <- list( + par = list( + mu = sdmu, sigma = sdsigma, + sigmainv = sdsigmainv + ), + weight = sdweight + ) + unidentified <- list( + par = list( + mu = sdmupre, sigma = sdsigmapre, + sigmainv = sdsigmainvpre + ), + weight = sdweightpre + ) + sdlist <- list( + identified = identified, + unidentified = unidentified + ) + } else { + if (K == 1) { + sdmu <- cov(obj@par$mu) + sdsigma <- cov(obj@par$sigma) + sdsigmainv <- cov(obj@par$sigmainv) + } else { + sdmu <- array(numeric(), dim = c(r, r, K)) + sdsigma <- array(numeric(), dim = c(s, s, K)) + sdsigmainv <- array(numeric(), dim = c(s, s, K)) + for (k in 1:K) { + sdmu[, , k] <- cov(obj@par$mu[, , k]) + sdsigma[, , k] <- cov(obj@par$sigma[, , k]) + sdsigmainv[, , k] <- cov(obj@par$sigmainv[, , k]) + } + } + sdweight <- apply(obj@weight, 2, sd) + identified <- list( + par = list( + mu = sdmu, sigma = sdsigma, + sigmainv = sdsigmainv + ), + weight = sdweight + ) + sdlist <- list(identified = identified) + } + return(sdlist) } -".sdpost.studmult.Mcmcestimate" <- function( obj, perm ) -{ - r <- obj@model@r - K <- obj@model@K - s <- r * (r + 1) / 2 - if ( perm ) { - if ( K == 1 ) { - sdmu <- cov( obj@parperm$mu ) - sdmupre <- cov( obj@par$mu ) - sdsigma <- cov( obj@parperm$sigma ) - sdsigmapre <- cov( obj@par$sigma ) - sdsigmainv <- cov( obj@parperm$sigmainv ) - sdsigmainvpre <- cov( obj@par$sigmainv ) - } else { - sdmu <- array( numeric(), dim = c( r, r, K ) ) - sdsigma <- array( numeric(), dim = c( s, s, K ) ) - sdsigmainv <- array( numeric(), dim = c( s, s, K ) ) - sdmupre <- array( numeric(), dim = c( r, r, K ) ) - sdsigmapre <- array( numeric(), dim = c( s, s, K ) ) - sdsigmainvpre <- array( numeric(), dim = c( s, s, K ) ) - for (k in 1:K) { - sdmu[,,k] <- cov( obj@parperm$mu[,,k] ) - sdsigma[,,k] <- cov( obj@parperm$sigma[,,k] ) - sdsigmainv[,,k] <- cov( obj@parperm$sigmainv[,,k] ) - sdmupre[,,k] <- cov( obj@par$mu[,,k] ) - sdsigmapre[,,k] <- cov( obj@par$sigma[,,k] ) - sdsigmainvpre[,,k] <- cov( obj@par$sigmainv[,,k] ) - } - } - sdweight <- apply( obj@weightperm, 2, sd ) - sdweightpre <- apply( obj@weight, 2, sd )# - sddf <- apply( obj@parperm$df, 2, sd ) - sddfpre <- apply( obj@par$df, 2, sd ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma, - sigmainv = sdsigmainv, - df = sddf ), - weight = sdweight ) - unidentified <- list( par = list( mu = sdmupre, sigma = sdsigmapre, - sigmainv = sdsigmainvpre, - df = sddfpre ), - weight = sdweightpre ) - sdlist <- list( identified = identified, - unidentified = unidentified ) +".sdpost.studmult.Mcmcestimate" <- function(obj, perm) { + r <- obj@model@r + K <- obj@model@K + s <- r * (r + 1) / 2 + if (perm) { + if (K == 1) { + sdmu <- cov(obj@parperm$mu) + sdmupre <- cov(obj@par$mu) + sdsigma <- cov(obj@parperm$sigma) + sdsigmapre <- cov(obj@par$sigma) + sdsigmainv <- cov(obj@parperm$sigmainv) + sdsigmainvpre <- cov(obj@par$sigmainv) } else { - if ( K == 1 ) { - sdmu <- cov( obj@par$mu ) - sdsigma <- cov( obj@par$sigma ) - sdsigmainv <- cov( obj@par$sigmainv ) - } else { - sdmu <- array( numeric(), dim = c( r, r, K ) ) - sdsigma <- array( numeric(), dim = c( s, s, K ) ) - sdsigmainv <- array( numeric(), dim = c( s, s, K ) ) - for (k in 1:K) { - sdmu[,,k] <- cov( obj@par$mu[,,k] ) - sdsigma[,,k] <- cov( obj@par$sigma[,,k] ) - sdsigmainv[,,k] <- cov( obj@par$sigmainv[,,k] ) - } - } - sdweight <- apply( obj@weight, 2, sd ) - sddf <- apply( obj@par$df, 2, sd ) - identified <- list( par = list( mu = sdmu, sigma = sdsigma, - sigmainv = sdsigmainv, - df = sddf ), - weight = sdweight ) - sdlist <- list( identified = identified ) + sdmu <- array(numeric(), dim = c(r, r, K)) + sdsigma <- array(numeric(), dim = c(s, s, K)) + sdsigmainv <- array(numeric(), dim = c(s, s, K)) + sdmupre <- array(numeric(), dim = c(r, r, K)) + sdsigmapre <- array(numeric(), dim = c(s, s, K)) + sdsigmainvpre <- array(numeric(), dim = c(s, s, K)) + for (k in 1:K) { + sdmu[, , k] <- cov(obj@parperm$mu[, , k]) + sdsigma[, , k] <- cov(obj@parperm$sigma[, , k]) + sdsigmainv[, , k] <- cov(obj@parperm$sigmainv[, , k]) + sdmupre[, , k] <- cov(obj@par$mu[, , k]) + sdsigmapre[, , k] <- cov(obj@par$sigma[, , k]) + sdsigmainvpre[, , k] <- cov(obj@par$sigmainv[, , k]) + } + } + sdweight <- apply(obj@weightperm, 2, sd) + sdweightpre <- apply(obj@weight, 2, sd) # + sddf <- apply(obj@parperm$df, 2, sd) + sddfpre <- apply(obj@par$df, 2, sd) + identified <- list( + par = list( + mu = sdmu, sigma = sdsigma, + sigmainv = sdsigmainv, + df = sddf + ), + weight = sdweight + ) + unidentified <- list( + par = list( + mu = sdmupre, sigma = sdsigmapre, + sigmainv = sdsigmainvpre, + df = sddfpre + ), + weight = sdweightpre + ) + sdlist <- list( + identified = identified, + unidentified = unidentified + ) + } else { + if (K == 1) { + sdmu <- cov(obj@par$mu) + sdsigma <- cov(obj@par$sigma) + sdsigmainv <- cov(obj@par$sigmainv) + } else { + sdmu <- array(numeric(), dim = c(r, r, K)) + sdsigma <- array(numeric(), dim = c(s, s, K)) + sdsigmainv <- array(numeric(), dim = c(s, s, K)) + for (k in 1:K) { + sdmu[, , k] <- cov(obj@par$mu[, , k]) + sdsigma[, , k] <- cov(obj@par$sigma[, , k]) + sdsigmainv[, , k] <- cov(obj@par$sigmainv[, , k]) + } } - return( sdlist ) + sdweight <- apply(obj@weight, 2, sd) + sddf <- apply(obj@par$df, 2, sd) + identified <- list( + par = list( + mu = sdmu, sigma = sdsigma, + sigmainv = sdsigmainv, + df = sddf + ), + weight = sdweight + ) + sdlist <- list(identified = identified) + } + return(sdlist) } -".sdpost.unidentified.Mcmcestimate" <- function( obj ) -{ - .sdpost.unidentified.poisson.Mcmcestimate( obj ) +".sdpost.unidentified.Mcmcestimate" <- function(obj) { + .sdpost.unidentified.poisson.Mcmcestimate(obj) } -".sdpost.unidentified.poisson.Mcmcestimate" <- function( obj ) -{ - sdpar <- apply( obj@par$lambda, 2, sd ) - sdweight <- apply( obj@weight, 2, sd ) - unidentified <- list( par = list( lambda = sdpar ), - weight = sdweight ) - sdlist <- list( unidentified = unidentified ) - return( sdlist ) +".sdpost.unidentified.poisson.Mcmcestimate" <- function(obj) { + sdpar <- apply(obj@par$lambda, 2, sd) + sdweight <- apply(obj@weight, 2, sd) + unidentified <- list( + par = list(lambda = sdpar), + weight = sdweight + ) + sdlist <- list(unidentified = unidentified) + return(sdlist) } diff --git a/R/mcmcestind.R b/R/mcmcestind.R index 61e2fee..fb8e18c 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -16,120 +16,139 @@ # along with finmix. If not, see . .mcmcestind <- setClass("mcmcestind", - representation(eavg = "list"), - contains = c("mcmcestfix"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(eavg = list()) + representation(eavg = "list"), + contains = c("mcmcestfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(eavg = list()) ) -setClassUnion("mcmcest", - c("mcmcestfix", - "mcmcestind") +setClassUnion( + "mcmcest", + c( + "mcmcestfix", + "mcmcestind" + ) ) -setMethod("show", "mcmcestind", - function(object) - { - cat("Object 'mcmcest'\n") - cat(" dist :", object@dist, "\n") - cat(" K :", object@K, "\n") - cat(" indicmod :", object@indicmod, - "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" relabel :", object@relabel, "\n") - cat(" map : List of", - length(object@map), "\n") - cat(" bml : List of", - length(object@bml), "\n") - cat(" ieavg : List of", - length(object@ieavg), "\n") - cat(" eavg : List of", - length(object@eavg), "\n") - cat(" sdpost : List of", - length(object@sdpost), "\n") - } +setMethod( + "show", "mcmcestind", + function(object) { + cat("Object 'mcmcest'\n") + cat(" dist :", object@dist, "\n") + cat(" K :", object@K, "\n") + cat( + " indicmod :", object@indicmod, + "\n" + ) + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" relabel :", object@relabel, "\n") + cat( + " map : List of", + length(object@map), "\n" + ) + cat( + " bml : List of", + length(object@bml), "\n" + ) + cat( + " ieavg : List of", + length(object@ieavg), "\n" + ) + cat( + " eavg : List of", + length(object@eavg), "\n" + ) + cat( + " sdpost : List of", + length(object@sdpost), "\n" + ) + } ) -setMethod("Summary", "mcmcestind", - function(x, ..., na.rm = FALSE) - { - dopt <- getOption("digits") - options(digits = 4) - obj <- x - K <- obj@K - rnames <- .rownames.Mcmcestind(obj) - cnames <- c("Estimates", "Std. Error") - cat("\n") - cat("Call: mcmcestimate\n") - cat("\n") - if (obj@ranperm) { - cat("Method: Random Permutation Gibbs Sampling\n") - } else { - cat("Method: Gibbs Sampling\n") - } - cat("\n") - cat(paste("Number of Iterations: ", obj@M, "\n", sep = "")) - cat(paste("Number of Burnin Iterations: ", obj@burnin, - "\n", sep = "")) - cat(paste("Relabeling algorithm used: ", obj@relabel, "\n", - sep = "")) - cat("\n") - cat("Parameters:\n") - cat("\n") - cat(paste("Component Parameters: ", - .parnames.Mcmcestfix(obj), "\n", sep = "")) - cat("Weights: eta\n") - ## MAP ## - cat("Maximum A Posterior (MAP)\n") - parout <- .pars.map.Mcmcestind(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("\n") - cat(paste("Log likelihood: ", sprintf("%.4f", obj@map$log), "\n", sep = "")) - cat("---\n") - ## BML ## - cat("Bayesian Maximum Likelihood (BML)\n") - parout <- .pars.bml.Mcmcestind(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("\n") - cat(paste("Log likelihood: ", sprintf("%.4f", obj@bml$log), "\n", sep = "")) - cat("---\n") - ## IEAVG ## - cat("Identified Ergodic Average (IEAVG)\n") - parout <- .pars.ieavg.Mcmcestind(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("---\n") - ## EAVG ## - cat("Ergodic Average (EAVG)\n") - parout <- .pars.eavg.Mcmcestind(obj) - rownames(parout) <- rnames - colnames(parout) <- cnames - print(parout) - cat("---\n") - options(digits = dopt) - } +setMethod( + "Summary", "mcmcestind", + function(x, ..., na.rm = FALSE) { + dopt <- getOption("digits") + options(digits = 4) + obj <- x + K <- obj@K + rnames <- .rownames.Mcmcestind(obj) + cnames <- c("Estimates", "Std. Error") + cat("\n") + cat("Call: mcmcestimate\n") + cat("\n") + if (obj@ranperm) { + cat("Method: Random Permutation Gibbs Sampling\n") + } else { + cat("Method: Gibbs Sampling\n") + } + cat("\n") + cat(paste("Number of Iterations: ", obj@M, "\n", sep = "")) + cat(paste("Number of Burnin Iterations: ", obj@burnin, + "\n", + sep = "" + )) + cat(paste("Relabeling algorithm used: ", obj@relabel, "\n", + sep = "" + )) + cat("\n") + cat("Parameters:\n") + cat("\n") + cat(paste("Component Parameters: ", + .parnames.Mcmcestfix(obj), "\n", + sep = "" + )) + cat("Weights: eta\n") + ## MAP ## + cat("Maximum A Posterior (MAP)\n") + parout <- .pars.map.Mcmcestind(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("\n") + cat(paste("Log likelihood: ", sprintf("%.4f", obj@map$log), "\n", sep = "")) + cat("---\n") + ## BML ## + cat("Bayesian Maximum Likelihood (BML)\n") + parout <- .pars.bml.Mcmcestind(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("\n") + cat(paste("Log likelihood: ", sprintf("%.4f", obj@bml$log), "\n", sep = "")) + cat("---\n") + ## IEAVG ## + cat("Identified Ergodic Average (IEAVG)\n") + parout <- .pars.ieavg.Mcmcestind(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("---\n") + ## EAVG ## + cat("Ergodic Average (EAVG)\n") + parout <- .pars.eavg.Mcmcestind(obj) + rownames(parout) <- rnames + colnames(parout) <- cnames + print(parout) + cat("---\n") + options(digits = dopt) + } ) ## Getters ## -setMethod("getEavg", "mcmcestind", - function(object) - { - return(object@eavg) - } +setMethod( + "getEavg", "mcmcestind", + function(object) { + return(object@eavg) + } ) -## No setters as users are not intended to manipulate +## No setters as users are not intended to manipulate ## this object. ### Private functions. @@ -138,128 +157,118 @@ setMethod("getEavg", "mcmcestind", ### Summary ### Summary Map estimates: Creates a matrix with Map ### estimates. -".pars.map.Mcmcestind" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.map.poisson.Mcmcestind(obj) - } +".pars.map.Mcmcestind" <- function(obj) { + if (obj@dist == "poisson") { + .pars.map.poisson.Mcmcestind(obj) + } } ### Summary Map estimates Poisson: Creates a matrix ### with Map estimates for Poisson parameters. -".pars.map.poisson.Mcmcestind" <- function(obj) -{ - K <- obj@K - parout <- matrix(0, nrow = 2 * K, ncol = 2) - for (k in seq(1, K)) { - parout[k, 1] <- obj@map$par$lambda[k] - parout[k, 2] <- obj@sdpost$identified$par$lambda[k] - } - for (k in seq(1, K)) { - parout[k + K, 1] <- obj@map$weight[k] - parout[k + K, 2] <- obj@sdpost$identified$weight[k] - } - return(parout) +".pars.map.poisson.Mcmcestind" <- function(obj) { + K <- obj@K + parout <- matrix(0, nrow = 2 * K, ncol = 2) + for (k in seq(1, K)) { + parout[k, 1] <- obj@map$par$lambda[k] + parout[k, 2] <- obj@sdpost$identified$par$lambda[k] + } + for (k in seq(1, K)) { + parout[k + K, 1] <- obj@map$weight[k] + parout[k + K, 2] <- obj@sdpost$identified$weight[k] + } + return(parout) } ### Summary Bml estimates: Creates a matrix with Bml ### estimates. -".pars.bml.Mcmcestind" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.bml.poisson.Mcmcestind(obj) - } +".pars.bml.Mcmcestind" <- function(obj) { + if (obj@dist == "poisson") { + .pars.bml.poisson.Mcmcestind(obj) + } } ### Summary Bml estimates Poisson: Creates a matrix ### with Bml estimates for Poisson parameters. -".pars.bml.poisson.Mcmcestind" <- function(obj) -{ - K <- obj@K - parout <- matrix(0, nrow = 2 * K, ncol = 2) - for (k in seq(1, K)) { - parout[k, 1] <- obj@bml$par$lambda[k] - parout[k, 2] <- obj@sdpost$identified$par$lambda[k] - } - for (k in seq(1, K)) { - parout[k + K, 1] <- obj@bml$weight[k] - parout[k + K, 2] <- obj@sdpost$identified$weight[k] - } - return(parout) +".pars.bml.poisson.Mcmcestind" <- function(obj) { + K <- obj@K + parout <- matrix(0, nrow = 2 * K, ncol = 2) + for (k in seq(1, K)) { + parout[k, 1] <- obj@bml$par$lambda[k] + parout[k, 2] <- obj@sdpost$identified$par$lambda[k] + } + for (k in seq(1, K)) { + parout[k + K, 1] <- obj@bml$weight[k] + parout[k + K, 2] <- obj@sdpost$identified$weight[k] + } + return(parout) } ### Summary Ieavg estimates: Creates a matrix with Ieavg ### estimates. -".pars.ieavg.Mcmcestind" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.ieavg.poisson.Mcmcestind(obj) - } +".pars.ieavg.Mcmcestind" <- function(obj) { + if (obj@dist == "poisson") { + .pars.ieavg.poisson.Mcmcestind(obj) + } } ### Summary Bml estimates Poisson: Creates a matrix ### with Bml estimates for Poisson parameters. -".pars.ieavg.poisson.Mcmcestind" <- function(obj) -{ - K <- obj@K - parout <- matrix(0, nrow = 2 * K, ncol = 2) - for (k in seq(1, K)) { - parout[k, 1] <- obj@ieavg$par$lambda[k] - parout[k, 2] <- obj@sdpost$identified$par$lambda[k] - } - for (k in seq(1, K)) { - parout[k + K, 1] <- obj@ieavg$weight[k] - parout[k + K, 2] <- obj@sdpost$identified$weight[k] - } - return(parout) +".pars.ieavg.poisson.Mcmcestind" <- function(obj) { + K <- obj@K + parout <- matrix(0, nrow = 2 * K, ncol = 2) + for (k in seq(1, K)) { + parout[k, 1] <- obj@ieavg$par$lambda[k] + parout[k, 2] <- obj@sdpost$identified$par$lambda[k] + } + for (k in seq(1, K)) { + parout[k + K, 1] <- obj@ieavg$weight[k] + parout[k + K, 2] <- obj@sdpost$identified$weight[k] + } + return(parout) } ### Summary Eavg estimates: Creates a matrix with Eavg ### estimates. -".pars.eavg.Mcmcestind" <- function(obj) -{ - if (obj@dist == "poisson") { - .pars.eavg.poisson.Mcmcestind(obj) - } +".pars.eavg.Mcmcestind" <- function(obj) { + if (obj@dist == "poisson") { + .pars.eavg.poisson.Mcmcestind(obj) + } } ### Summary Bml estimates Poisson: Creates a matrix ### with Bml estimates for Poisson parameters. -".pars.eavg.poisson.Mcmcestind" <- function(obj) -{ - K <- obj@K - parout <- matrix(0, nrow = 2 * K, ncol = 2) - for (k in seq(1, K)) { - parout[k, 1] <- obj@eavg$par$lambda[k] - parout[k, 2] <- obj@sdpost$unidentified$par$lambda[k] - } - for (k in seq(1, K)) { - parout[k + K, 1] <- obj@eavg$weight[k] - parout[k + K, 2] <- obj@sdpost$unidentified$weight[k] - } +".pars.eavg.poisson.Mcmcestind" <- function(obj) { + K <- obj@K + parout <- matrix(0, nrow = 2 * K, ncol = 2) + for (k in seq(1, K)) { + parout[k, 1] <- obj@eavg$par$lambda[k] + parout[k, 2] <- obj@sdpost$unidentified$par$lambda[k] + } + for (k in seq(1, K)) { + parout[k + K, 1] <- obj@eavg$weight[k] + parout[k + K, 2] <- obj@sdpost$unidentified$weight[k] + } - return(parout) + return(parout) } -### Summary rownames: Creates row names for all +### Summary rownames: Creates row names for all ### parameters. -".rownames.Mcmcestind" <- function(obj) -{ - if (obj@dist == "poisson") { - .rownames.poisson.Mcmcestind(obj) - } +".rownames.Mcmcestind" <- function(obj) { + if (obj@dist == "poisson") { + .rownames.poisson.Mcmcestind(obj) + } } -### Summary rownames: Creates row names for -### each model. -".rownames.poisson.Mcmcestind" <- function(obj) -{ - rnames <- rep("", 2 * obj@K) - for (k in seq(1, obj@K)) { - rnames[k] <- paste("lambda ", k, sep = "") - } - for(k in seq(obj@K + 1, 2 * obj@K)) { - rnames[k] <- paste("eta ", k - obj@K, sep = "") - } - return(rnames) +### Summary rownames: Creates row names for +### each model. +".rownames.poisson.Mcmcestind" <- function(obj) { + rnames <- rep("", 2 * obj@K) + for (k in seq(1, obj@K)) { + rnames[k] <- paste("lambda ", k, sep = "") + } + for (k in seq(obj@K + 1, 2 * obj@K)) { + rnames[k] <- paste("eta ", k - obj@K, sep = "") + } + return(rnames) } diff --git a/R/mcmcextract.R b/R/mcmcextract.R index a6ee89b..7360343 100644 --- a/R/mcmcextract.R +++ b/R/mcmcextract.R @@ -1,78 +1,85 @@ -.mcmcextract <- setClass( "mcmcextract", - representation( dist = "character", - K = "integer", - r = "integer", - par = "list", - weight = "array" - ), - validity = function( object ) { - ## else: OK ## - TRUE - }, - prototype( dist = character(), - K = integer(), - r = integer(), - par = list(), - weight = array() - ) +.mcmcextract <- setClass("mcmcextract", + representation( + dist = "character", + K = "integer", + r = "integer", + par = "list", + weight = "array" + ), + validity = function(object) { + ## else: OK ## + TRUE + }, + prototype( + dist = character(), + K = integer(), + r = integer(), + par = list(), + weight = array() + ) ) -setMethod( "moments", signature( object = "mcmcextract" ), - function( object ) - { - dist <- object@dist - if ( dist == "normult" ) { - .moments.Normult.Mcmcextract( object ) - } - } +setMethod( + "moments", signature(object = "mcmcextract"), + function(object) { + dist <- object@dist + if (dist == "normult") { + .moments.Normult.Mcmcextract(object) + } + } ) ### -------------------------------------------------------------- ### Moments ### -------------------------------------------------------------- -".moments.Normult.Mcmcextract" <- function( obj ) -{ - K <- obj@K - r <- obj@r - moments.means <- apply( sapply( seq( length = r ), - function( i ) obj@par$mu[i,] * obj@weight ), - 2, sum, na.rm = TRUE ) - moments.var <- matrix( 0.0, nrow = r, ncol = r ) - moments.W <- matrix( 0.0, nrow = r, ncol = r ) - moments.B <- matrix( 0.0, nrow = r, ncol = r ) - for ( k in 1:K ) { - moments.var <- moments.var + outer( obj@par$mu[, k], obj@par$mu[, k] ) + - qinmatr( obj@par$sigma[, k] ) * obj@weight[k] - moments.W <- moments.W + qinmatr( obj@par$sigma[, k] ) * obj@weight[k] - d <- obj@par$mu[, k] - moments.means - moments.B <- moments.B + outer( d, d ) * obj@weight[k] - } - moments.var <- moments.var - outer( moments.means, moments.means ) - cd <- diag( 1 / diag( moments.var )^0.5 ) - moments.corr <- cd %*% moments.var %*% cd - moments.Rtr <- 1 - sum( diag ( moments.W ) ) / sum( diag( moments.var ) ) - moments.Rdet <- 1 - det( moments.W ) / det( moments.var ) - zm <- vector( "numeric", r ) - zm[seq(2, 4, by = 2)] <- exp( cumsum( log( seq( 1, 4, by = 2 ) ) ) ) - moments.higher <- matrix( 0.0, nrow = r, ncol = 4 ) - for ( m in 1:4 ) { - for ( rr in 1:r ) { - sigma <- simplify2array( sapply( seq( 1, K ), function(i) qinmatr( obj@par$sigma[,i] ), - simplify = FALSE ) ) [rr, rr,] - moments.higher[rr, m] <- sum( obj@weight * ( obj@par$mu[rr,] - moments.means[rr] )^m ) - for ( n in 1:m ){ - cm <- ( obj@par$mu[rr,] - moments.means[rr] )^( m - n ) * sigma^( n / 2 ) * zm[n] - print( choose(m,n) * sum(obj@weight * cm)) - moments.higher[rr, m] <- moments.higher[rr, m] + choose( m, n ) * sum( obj@weight * cm ) - } - } +".moments.Normult.Mcmcextract" <- function(obj) { + K <- obj@K + r <- obj@r + moments.means <- apply(sapply( + seq(length = r), + function(i) obj@par$mu[i, ] * obj@weight + ), + 2, sum, + na.rm = TRUE + ) + moments.var <- matrix(0.0, nrow = r, ncol = r) + moments.W <- matrix(0.0, nrow = r, ncol = r) + moments.B <- matrix(0.0, nrow = r, ncol = r) + for (k in 1:K) { + moments.var <- moments.var + outer(obj@par$mu[, k], obj@par$mu[, k]) + + qinmatr(obj@par$sigma[, k]) * obj@weight[k] + moments.W <- moments.W + qinmatr(obj@par$sigma[, k]) * obj@weight[k] + d <- obj@par$mu[, k] - moments.means + moments.B <- moments.B + outer(d, d) * obj@weight[k] + } + moments.var <- moments.var - outer(moments.means, moments.means) + cd <- diag(1 / diag(moments.var)^0.5) + moments.corr <- cd %*% moments.var %*% cd + moments.Rtr <- 1 - sum(diag(moments.W)) / sum(diag(moments.var)) + moments.Rdet <- 1 - det(moments.W) / det(moments.var) + zm <- vector("numeric", r) + zm[seq(2, 4, by = 2)] <- exp(cumsum(log(seq(1, 4, by = 2)))) + moments.higher <- matrix(0.0, nrow = r, ncol = 4) + for (m in 1:4) { + for (rr in 1:r) { + sigma <- simplify2array(sapply(seq(1, K), function(i) qinmatr(obj@par$sigma[, i]), + simplify = FALSE + ))[rr, rr, ] + moments.higher[rr, m] <- sum(obj@weight * (obj@par$mu[rr, ] - moments.means[rr])^m) + for (n in 1:m) { + cm <- (obj@par$mu[rr, ] - moments.means[rr])^(m - n) * sigma^(n / 2) * zm[n] + print(choose(m, n) * sum(obj@weight * cm)) + moments.higher[rr, m] <- moments.higher[rr, m] + choose(m, n) * sum(obj@weight * cm) + } } - moments.skewness <- moments.higher[, 3] / moments.higher[, 2]^1.5 - moments.kurtosis <- moments.higher[, 4] / moments.higher[, 2]^2 - moments <- list( mean = moments.means, var = moments.var, W = moments.W, - B = moments.B, corr = moments.corr, Rtr = moments.Rtr, - Rdet = moments.Rdet, skewness = moments.skewness, - kurtosis = moments.kurtosis ) - return( moments ) + } + moments.skewness <- moments.higher[, 3] / moments.higher[, 2]^1.5 + moments.kurtosis <- moments.higher[, 4] / moments.higher[, 2]^2 + moments <- list( + mean = moments.means, var = moments.var, W = moments.W, + B = moments.B, corr = moments.corr, Rtr = moments.Rtr, + Rdet = moments.Rdet, skewness = moments.skewness, + kurtosis = moments.kurtosis + ) + return(moments) } - diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index a13514a..ee87dbf 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -15,211 +15,245 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputbase <- setClass( "mcmcoutputbase", - representation( weight = "array", - entropy = "array", - ST = "array", - S = "array", - NK = "array", - clust = "array" ), - contains = c( "mcmcoutputfix" ), - validity = function( object ) - { - ## else: OK - TRUE - }, - prototype( weight = array(), - entropy = array(), - ST = array(), - S = array(), - NK = array(), - clust = array() - ) +.mcmcoutputbase <- setClass("mcmcoutputbase", + representation( + weight = "array", + entropy = "array", + ST = "array", + S = "array", + NK = "array", + clust = "array" + ), + contains = c("mcmcoutputfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + weight = array(), + entropy = array(), + ST = array(), + S = array(), + NK = array(), + clust = array() + ) ) -setMethod("show", "mcmcoutputbase", - function(object) - { - cat("Object 'mcmcoutput'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputbase", + function(object) { + cat("Object 'mcmcoutput'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputbase", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE , ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" || dist == "cond.poisson" ) { - .traces.Poisson.Base( x, dev ) - } else if ( dist == "binomial" ) { - .traces.Binomial.Base( x, dev ) - } else if ( dist == "exponential" ) { - .traces.Exponential.Base( x, dev ) - } else if ( dist == "normal" ) { - .traces.Normal( x, dev ) - .traces.Weights.Base( x, dev, col ) - } else if ( dist == "student" ) { - .traces.Student( x, dev ) - .traces.Weights.Base( x, dev, col ) - } else if ( dist == "normult" ) { - .traces.Normult( x, dev, col ) - .traces.Weights.Base( x, dev, col ) - } else if ( dist == "studmult" ) { - .traces.Studmult( x, dev, col ) - .traces.Weights.Base(x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .traces.Log.Base( x, dev, col ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputbase", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson" || dist == "cond.poisson") { + .traces.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .traces.Binomial.Base(x, dev) + } else if (dist == "exponential") { + .traces.Exponential.Base(x, dev) + } else if (dist == "normal") { + .traces.Normal(x, dev) + .traces.Weights.Base(x, dev, col) + } else if (dist == "student") { + .traces.Student(x, dev) + .traces.Weights.Base(x, dev, col) + } else if (dist == "normult") { + .traces.Normult(x, dev, col) + .traces.Weights.Base(x, dev, col) + } else if (dist == "studmult") { + .traces.Studmult(x, dev, col) + .traces.Weights.Base(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .traces.Log.Base(x, dev, col) + } + } ) -setMethod( "plotHist", signature( x = "mcmcoutputbase", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - dist <- x@model@dist - if ( dist == "poisson" ) { - .hist.Poisson.Base( x, dev ) - } else if ( dist == "binomial" ) { - .hist.Binomial.Base( x, dev ) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .hist.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .hist.Binomial.Base(x, dev) + } + } ) -setMethod( "plotDens", signature( x = "mcmcoutputbase", - dev = "ANY" ), - function(x, dev = TRUE, ... ) - { - dist <- x@model@dist - if ( dist == "poisson" ) { - .dens.Poisson.Base( x, dev ) - } else if (dist == "binomial" ) { - .dens.Binomial.Base( x, dev ) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .dens.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .dens.Binomial.Base(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens' from 'mcmcoutputfixhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens' from 'mcmcoutputfixhier' + callNextMethod(x, dev, ...) + } ) -setMethod("subseq", signature(object = "mcmcoutputbase", - index = "array"), - function(object, index) - { - ## Call 'subseq()' method from 'mcmcoutputfix' - as(object, "mcmcoutputfix") <- callNextMethod(object, index) - ## Change owned slots ## - .subseq.Base(object, index) - } +setMethod( + "subseq", signature( + object = "mcmcoutputbase", + index = "array" + ), + function(object, index) { + ## Call 'subseq()' method from 'mcmcoutputfix' + as(object, "mcmcoutputfix") <- callNextMethod(object, index) + ## Change owned slots ## + .subseq.Base(object, index) + } ) -setMethod( "swapElements", signature( object = "mcmcoutputbase", - index = "array"), - function( object, index ) - { - if ( object@model@K == 1 ) { - return( object ) - } else { - ## Call method 'swapElements()' from 'mcmcoutputfix' - as( object, "mcmcoutputfix" ) <- callNextMethod( object, index ) - .swapElements.Base( object, index ) - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputbase", + index = "array" + ), + function(object, index) { + if (object@model@K == 1) { + return(object) + } else { + ## Call method 'swapElements()' from 'mcmcoutputfix' + as(object, "mcmcoutputfix") <- callNextMethod(object, index) + .swapElements.Base(object, index) + } + } ) -setMethod("getWeight", "mcmcoutputbase", - function(object) - { - return(object@weight) - } +setMethod( + "getWeight", "mcmcoutputbase", + function(object) { + return(object@weight) + } ) -setMethod("getEntropy", "mcmcoutputbase", - function(object) - { - return(object@entropy) - } +setMethod( + "getEntropy", "mcmcoutputbase", + function(object) { + return(object@entropy) + } ) -setMethod("getST", "mcmcoutputbase", - function(object) - { - return(object@ST) - } +setMethod( + "getST", "mcmcoutputbase", + function(object) { + return(object@ST) + } ) -setMethod("getS", "mcmcoutputbase", - function(object) - { - return(object@S) - } +setMethod( + "getS", "mcmcoutputbase", + function(object) { + return(object@S) + } ) -setMethod("getNK", "mcmcoutputbase", - function(object) - { - return(object@NK) - } +setMethod( + "getNK", "mcmcoutputbase", + function(object) { + return(object@NK) + } ) -setMethod("getClust", "mcmcoutputbase", - function(object) - { - return(object@clust) - } +setMethod( + "getClust", "mcmcoutputbase", + function(object) { + return(object@clust) + } ) ## No setters as users are not intended to manipulate ## @@ -230,472 +264,505 @@ setMethod("getClust", "mcmcoutputbase", ### Plot ### Plot traces -### Plot traces Poisson: Plots the traces for the sampled +### Plot traces Poisson: Plots the traces for the sampled ### Poisson parameters and the weights. -".traces.Poisson.Base" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K * 2 - 1 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@par$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = .7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = .6, line = 3) - } - weight <- x@weight - for (k in 1:(K - 1)) { - plot(weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = .7) - mtext(side = 2, las = 2, bquote(eta[k = .(k)]), - cex = .6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = .7, line = 3) +".traces.Poisson.Base" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 - 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@par$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = .6, line = 3 + ) + } + weight <- x@weight + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".traces.Binomial.Base" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K * 2 - 1 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - p <- x@par$p - for (k in 1:K) { - plot(p[, k], type = "l", axes = F, col = "gray20", - xlab = "", ylab = "") - axis(2, las = 2, cex.axis = .7) - mtext(sid = 2, las = 2, bquote(p[k = .(k)]), - cex = .6, line = 3) - } - weight <- x@weight - for (k in 1:(K - 1)) { - plot(weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = .7) - mtext(side = 2, las = 2, bquote(eta[k = .(k)]), - cex = .6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = .7, line = 3) +".traces.Binomial.Base" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 - 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + p <- x@par$p + for (k in 1:K) { + plot(p[, k], + type = "l", axes = F, col = "gray20", + xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + sid = 2, las = 2, bquote(p[k = .(k)]), + cex = .6, line = 3 + ) + } + weight <- x@weight + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".traces.Exponential.Base" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- K * 2 - 1 - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - lambda <- x@par$lambda - for ( k in 1:K ) { - plot( lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( lambda[k = .( k )] ), - cex = .6, line = 3 ) - } - weight <- x@weight - for ( k in 1:( K - 1 ) ) { - plot( weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote(eta[k = .(k)]), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Exponential.Base" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 - 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@par$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = .6, line = 3 + ) + } + weight <- x@weight + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".traces.Weights.Base" <- function( x, dev, col ) -{ - weight <- x@weight - K <- x@model@K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Weights" ) - } - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - - plot( weight[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", ylim = c( 0, 1.2 ) ) - for( k in 2:K ) { - lines( weight[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( eta ), - cex = .6, line = 3 ) - name <- vector( "character", K ) - for( k in 1:K ) { - name[k] <- paste( "k = ", k, sep = "" ) - } - legend( "top", legend = name, col = cscale, lty = 1, - horiz = TRUE, cex = .7 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Weights.Base" <- function(x, dev, col) { + weight <- x@weight + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Weights") + } + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + + plot(weight[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", ylim = c(0, 1.2) + ) + for (k in 2:K) { + lines(weight[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(eta), + cex = .6, line = 3 + ) + name <- vector("character", K) + for (k in 1:K) { + name[k] <- paste("k = ", k, sep = "") + } + legend("top", + legend = name, col = cscale, lty = 1, + horiz = TRUE, cex = .7 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### ----------------------------------------------------------------- ### .traces.Log.Base -### @description Plots the log likelihoods for a finite mixture +### @description Plots the log likelihoods for a finite mixture ### model with sampled indicators ### @par x an mcmcoutput object ### dev a logical ### col a logical ### @return a graphical device with the traceplots of the -### mixture likelihood, the prior likelihood and +### mixture likelihood, the prior likelihood and ### the complete data likelihood -### @detail If 'dev' is FALSE, the output can be sent to a -### file. If 'col' is TRUE the output is given in +### @detail If 'dev' is FALSE, the output can be sent to a +### file. If 'col' is TRUE the output is given in ### rainbow colors, otherwise gray.colors is used. ### @see ?plotTraces, ?rainbow, ?gray.colors ### @author Lars Simon Zehnder ### ------------------------------------------------------------------ -".traces.Log.Base" <- function( x, dev, col=FALSE ) -{ - if ( .check.grDevice() && dev ) { - dev.new( title = "Log Likelihood Traceplots" ) - } - if ( col ) { - cscale <- rainbow( 3, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( 3, start = 0.5, end = 0.15 ) - } - par( mfrow = c( 3, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mixlik <- x@log$mixlik - plot( mixlik, type = "l", axes = F, - col = cscale[3], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixlik", cex = 0.6, - line = 3 ) - mixprior <- x@log$mixprior - plot( mixprior, type = "l", axes = F, - col = cscale[2], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixprior", cex = 0.6, - line = 3 ) - cdpost <- x@log$cdpost - plot( cdpost, type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "cdpost", cex = 0.6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = 0.7, line = 3 ) +".traces.Log.Base" <- function(x, dev, col = FALSE) { + if (.check.grDevice() && dev) { + dev.new(title = "Log Likelihood Traceplots") + } + if (col) { + cscale <- rainbow(3, start = 0.5, end = 0) + } else { + cscale <- gray.colors(3, start = 0.5, end = 0.15) + } + par( + mfrow = c(3, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mixlik <- x@log$mixlik + plot(mixlik, + type = "l", axes = F, + col = cscale[3], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixlik", cex = 0.6, + line = 3 + ) + mixprior <- x@log$mixprior + plot(mixprior, + type = "l", axes = F, + col = cscale[2], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixprior", cex = 0.6, + line = 3 + ) + cdpost <- x@log$cdpost + plot(cdpost, + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "cdpost", cex = 0.6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### Histograms ### Histograms Poisson: Plots the histograms for the Poisson -### parameters and the weights. -".hist.Poisson.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms") - } - lambda <- x@par$lambda - weight <- x@weight - vars <- cbind(lambda, weight[, seq(1, K - 1)]) - lab.names <- vector("list", 2 * K - 1) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in seq(K + 1, 2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Hist(vars, lab.names) +### parameters and the weights. +".hist.Poisson.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + lambda <- x@par$lambda + weight <- x@weight + vars <- cbind(lambda, weight[, seq(1, K - 1)]) + lab.names <- vector("list", 2 * K - 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Hist(vars, lab.names) } -".hist.Binomial.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms") - } - p <- x@par$p - weight <- x@weight - vars <- cbind(p, weight[, seq(1, K - 1)]) - lab.names <- vector("list", 2 * K - 1) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(p[.(k)]) - } - for (k in seq(K + 1, 2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Hist(vars, lab.names) +".hist.Binomial.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + p <- x@par$p + weight <- x@weight + vars <- cbind(p, weight[, seq(1, K - 1)]) + lab.names <- vector("list", 2 * K - 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(p[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Hist(vars, lab.names) } -".hist.Exponential.Base" <- function( x, dev ) -{ - K <- x@model@K - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms" ) - } - lambda <- x@par$lambda - weight <- x@weight - vars <- cbind( lambda, weight[, seq( 1, K - 1 )] ) - lab.names <- vector( "list", 2 * K - 1 ) - for ( k in seq( 1, K ) ) { - lab.names[[k]] <- bquote( lambda[.( k )] ) - } - for ( k in seq( K + 1, 2 * K - 1 ) ) { - lab.names[[k]] <- bquote( eta[.( k - K )] ) - } - .symmetric.Hist( vars, lab.names ) +".hist.Exponential.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + lambda <- x@par$lambda + weight <- x@weight + vars <- cbind(lambda, weight[, seq(1, K - 1)]) + lab.names <- vector("list", 2 * K - 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Hist(vars, lab.names) } -".hist.Normal.Base" <- function( x, dev ) -{ - .hist.Normal( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weights.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weights.lab.names[[k]] <- bquote( eta[.( k )] ) - } - if ( K > 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Weights" ) - } - .symmetric.Hist( weight, weights.lab.names ) - } +".hist.Normal.Base" <- function(x, dev) { + .hist.Normal(x, dev) + if (K > 1) { + weight <- x@weight + weights.lab.names <- vector("list", K) + for (k in 1:K) { + weights.lab.names[[k]] <- bquote(eta[.(k)]) + } + if (K > 1) { + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Weights") + } + .symmetric.Hist(weight, weights.lab.names) } + } } -".hist.Student.Base" <- function( x, dev ) -{ - .hist.Student( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weight.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weight.lab.names[[k]] <- bquote( eta[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Weights" ) - } - .symmetric.Hist( weight, weight.lab.names ) +".hist.Student.Base" <- function(x, dev) { + .hist.Student(x, dev) + if (K > 1) { + weight <- x@weight + weight.lab.names <- vector("list", K) + for (k in 1:K) { + weight.lab.names[[k]] <- bquote(eta[.(k)]) } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Weights") + } + .symmetric.Hist(weight, weight.lab.names) + } } -".hist.Normult.Base" <- function( x, dev ) -{ - .hist.Normult( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weight.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weight.lab.names[[k]] <- bquote( eta[.( k ) ] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Weights" ) - } - .symmetric.Hist( weight, weight.lab.names ) +".hist.Normult.Base" <- function(x, dev) { + .hist.Normult(x, dev) + if (K > 1) { + weight <- x@weight + weight.lab.names <- vector("list", K) + for (k in 1:K) { + weight.lab.names[[k]] <- bquote(eta[.(k)]) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Weights") } + .symmetric.Hist(weight, weight.lab.names) + } } -".hist.Studmult.Base" <- function( x, dev ) -{ - .hist.Studmult( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weight.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weight.lab.names[[k]] <- bquote( eta[.( k )] ) - } - .symmetric.Hist( weight, weight.lab.names ) +".hist.Studmult.Base" <- function(x, dev) { + .hist.Studmult(x, dev) + if (K > 1) { + weight <- x@weight + weight.lab.names <- vector("list", K) + for (k in 1:K) { + weight.lab.names[[k]] <- bquote(eta[.(k)]) } + .symmetric.Hist(weight, weight.lab.names) + } } ### Densities ### Densities Poisson: Plots Kernel densities for the Poisson ### parameters and the weights. -".dens.Poisson.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Densities") - } - lambda <- x@par$lambda - weight <- x@weight - vars <- cbind(lambda, weight[, seq(1, K - 1)]) - lab.names <- vector("list", 2 * K - 1) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in seq(K + 1, 2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Dens(vars, lab.names) +".dens.Poisson.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + lambda <- x@par$lambda + weight <- x@weight + vars <- cbind(lambda, weight[, seq(1, K - 1)]) + lab.names <- vector("list", 2 * K - 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Dens(vars, lab.names) } -".dens.Binomial.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Densities") - } - p <- x@par$p - weight <- x@weight - vars <- cbind(p, weight[, seq(1, K - 1)]) - lab.names <- vector("list", 2 * K - 1) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(p[.(k)]) - } - for (k in seq(K + 1, 2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Dens(vars, lab.names) +".dens.Binomial.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + p <- x@par$p + weight <- x@weight + vars <- cbind(p, weight[, seq(1, K - 1)]) + lab.names <- vector("list", 2 * K - 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(p[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Dens(vars, lab.names) } -".dens.Exponential.Base" <- function( x, dev ) -{ - K <- x@model@K - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities" ) - } - lambda <- x@par$lambda - weight <- x@weight - vars <- cbind( lambda, weight[, seq( 1, K - 1 )] ) - lab.names <- vector( "list", 2 * K - 1 ) - for ( k in seq( 1, K ) ) { - lab.names[[k]] <- bquote( lambda[.( k )] ) - } - for ( k in seq( K + 1, 2 * K - 1 ) ) { - lab.names[[k]] <- bquote( eta[.( k - K )] ) - } - .symmetric.Dens( vars, lab.names ) +".dens.Exponential.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + lambda <- x@par$lambda + weight <- x@weight + vars <- cbind(lambda, weight[, seq(1, K - 1)]) + lab.names <- vector("list", 2 * K - 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Dens(vars, lab.names) } -".dens.Normal.Base" <- function( x, dev ) -{ - .dens.Normal( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weights.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weights.lab.names[[k]] <- bquote( eta[.( k )] ) - } - if ( K > 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Weights" ) - } - .symmetric.Dens( weight, weights.lab.names ) - } +".dens.Normal.Base" <- function(x, dev) { + .dens.Normal(x, dev) + if (K > 1) { + weight <- x@weight + weights.lab.names <- vector("list", K) + for (k in 1:K) { + weights.lab.names[[k]] <- bquote(eta[.(k)]) + } + if (K > 1) { + if (.check.grDevice() && dev) { + dev.new(title = "Densities Weights") + } + .symmetric.Dens(weight, weights.lab.names) } + } } -".dens.Student.Base" <- function( x, dev ) -{ - .dens.Student( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weight.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weight.lab.names[[k]] <- bquote( eta[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Weights" ) - } - .symmetric.Dens( weight, weight.lab.names ) +".dens.Student.Base" <- function(x, dev) { + .dens.Student(x, dev) + if (K > 1) { + weight <- x@weight + weight.lab.names <- vector("list", K) + for (k in 1:K) { + weight.lab.names[[k]] <- bquote(eta[.(k)]) } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Weights") + } + .symmetric.Dens(weight, weight.lab.names) + } } -".dens.Normult.Base" <- function( x, dev ) -{ - .dnes.Normult( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weight.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weight.lab.names[[k]] <- bquote( eta[.( k ) ] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Weights" ) - } - .symmetric.Dens( weight, weight.lab.names ) +".dens.Normult.Base" <- function(x, dev) { + .dnes.Normult(x, dev) + if (K > 1) { + weight <- x@weight + weight.lab.names <- vector("list", K) + for (k in 1:K) { + weight.lab.names[[k]] <- bquote(eta[.(k)]) + } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Weights") } + .symmetric.Dens(weight, weight.lab.names) + } } -".dens.Studmult.Base" <- function( x, dev ) -{ - .dens.Studmult( x, dev ) - if ( K > 1 ) { - weight <- x@weight - weight.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - weight.lab.names[[k]] <- bquote( eta[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Weights" ) - } - .symmetric.Dens( weight, weight.lab.names ) +".dens.Studmult.Base" <- function(x, dev) { + .dens.Studmult(x, dev) + if (K > 1) { + weight <- x@weight + weight.lab.names <- vector("list", K) + for (k in 1:K) { + weight.lab.names[[k]] <- bquote(eta[.(k)]) } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Weights") + } + .symmetric.Dens(weight, weight.lab.names) + } } ### Subseq: Creates a subsequence of an MCMC sample. -".subseq.Base" <- function( obj, index ) -{ - M <- dim( obj@weight )[1] - K <- dim( obj@weight )[2] - newM <- sum( index ) - obj@log$cdpost <- array( obj@log$cdpost[index], - dim = c( newM, 1 ) ) - obj@weight <- obj@weight[index, ] - obj@entropy <- array( obj@entropy[index], - dim = c( newM, 1 ) ) - obj@ST <- array( obj@ST[index], - dim = c( newM, 1 ) ) - ## Check which S stay ## - storeS <- ifelse( !all( is.na( obj@S ) ), dim( obj@S )[2], 0 ) - if ( storeS != 0 ) { - ms <- M - storeS - index.S <- index[( ms + 1 ):M] - N <- dim( obj@S )[1] - if ( any( index.S ) ) { - obj@S <- array( obj@S[,index.S], dim = c( N, storeS ) ) - } else { - obj@S <- as.array( NA ) - } +".subseq.Base" <- function(obj, index) { + M <- dim(obj@weight)[1] + K <- dim(obj@weight)[2] + newM <- sum(index) + obj@log$cdpost <- array(obj@log$cdpost[index], + dim = c(newM, 1) + ) + obj@weight <- obj@weight[index, ] + obj@entropy <- array(obj@entropy[index], + dim = c(newM, 1) + ) + obj@ST <- array(obj@ST[index], + dim = c(newM, 1) + ) + ## Check which S stay ## + storeS <- ifelse(!all(is.na(obj@S)), dim(obj@S)[2], 0) + if (storeS != 0) { + ms <- M - storeS + index.S <- index[(ms + 1):M] + N <- dim(obj@S)[1] + if (any(index.S)) { + obj@S <- array(obj@S[, index.S], dim = c(N, storeS)) + } else { + obj@S <- as.array(NA) } - obj@NK <- obj@NK[index, ] - return( obj ) + } + obj@NK <- obj@NK[index, ] + return(obj) } ### swapElements: Permutes the elements in an MCMC sample ### for each row. -".swapElements.Base" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc()' - obj@weight <- swap_cc( obj@weight, index ) - ## Rcpp::export 'swapInd_cc()' - M <- obj@M - K <- ncol( index ) - storeS <- ifelse( !all( is.na( obj@S ) ), dim( obj@S )[2], 0 ) - if ( storeS != 0 ) { - index.S <- matrix( index[( M - storeS + 1 ):M, ], - ncol = K, byrow = TRUE ) - obj@S <- swapInd_cc( obj@S, index.S ) - } - ## Rcpp::export 'swapST_cc()' - obj@ST <- swapST_cc( obj@ST, index ) - ## Rcpp::export 'swap_cc()' - obj@NK <- swapInteger_cc( obj@NK, index ) - return( obj ) +".swapElements.Base" <- function(obj, index) { + ## Rcpp::export 'swap_cc()' + obj@weight <- swap_cc(obj@weight, index) + ## Rcpp::export 'swapInd_cc()' + M <- obj@M + K <- ncol(index) + storeS <- ifelse(!all(is.na(obj@S)), dim(obj@S)[2], 0) + if (storeS != 0) { + index.S <- matrix(index[(M - storeS + 1):M, ], + ncol = K, byrow = TRUE + ) + obj@S <- swapInd_cc(obj@S, index.S) + } + ## Rcpp::export 'swapST_cc()' + obj@ST <- swapST_cc(obj@ST, index) + ## Rcpp::export 'swap_cc()' + obj@NK <- swapInteger_cc(obj@NK, index) + return(obj) } diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index d226b6f..581f261 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -16,286 +16,315 @@ # along with finmix. If not, see . .mcmcoutputfix <- setClass("mcmcoutputfix", - representation(M = "integer", - burnin = "integer", - ranperm = "logical", - par = "list", - log = "list", - model = "model", - prior = "prior"), - validity = function(object) - { - ##else: OK - TRUE - }, - prototype(M = integer(), - burnin = integer(), - ranperm = logical(), - par = list(), - log = list(), - model = model(), - prior = prior() - ) + representation( + M = "integer", + burnin = "integer", + ranperm = "logical", + par = "list", + log = "list", + model = "model", + prior = "prior" + ), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + M = integer(), + burnin = integer(), + ranperm = logical(), + par = list(), + log = list(), + model = model(), + prior = prior() + ) ) -setMethod("show", "mcmcoutputfix", - function(object) { - cat("Object 'mcmcoutputfix'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputfix", + function(object) { + cat("Object 'mcmcoutputfix'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature(x = "mcmcoutputfix", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if( dist == "poisson" ) { - .traces.Poisson( x, dev ) - } else if ( dist == "binomial" ) { - .traces.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .traces.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .traces.Normal( x , dev ) - } else if ( dist == "student" ) { - .traces.Student( x, dev ) - } else if ( dist == "normult" ) { - .traces.Normult( x, dev, col ) - } else if ( dist == "studmult" ) { - .traces.Studmult( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .traces.Log( x, dev, col ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputfix", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .traces.Poisson(x, dev) + } else if (dist == "binomial") { + .traces.Binomial(x, dev) + } else if (dist == "exponential") { + .traces.Exponential(x, dev) + } else if (dist == "normal") { + .traces.Normal(x, dev) + } else if (dist == "student") { + .traces.Student(x, dev) + } else if (dist == "normult") { + .traces.Normult(x, dev, col) + } else if (dist == "studmult") { + .traces.Studmult(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .traces.Log(x, dev, col) + } + } ) -setMethod( "plotHist", signature( x = "mcmcoutputfix", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - dist <- x@model@dist - if( dist == "poisson" ) { - .hist.Poisson( x, dev ) - } else if ( dist == "binomial" ) { - .hist.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .hist.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .hist.Normal( x, dev ) - } else if ( dist == "student" ) { - .hist.Student( x, dev ) - } else if ( dist == "normult" ) { - .hist.Normult( x, dev ) - } else if ( dist == "studmult" ) { - .hist.Studmult( x, dev ) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .hist.Poisson(x, dev) + } else if (dist == "binomial") { + .hist.Binomial(x, dev) + } else if (dist == "exponential") { + .hist.Exponential(x, dev) + } else if (dist == "normal") { + .hist.Normal(x, dev) + } else if (dist == "student") { + .hist.Student(x, dev) + } else if (dist == "normult") { + .hist.Normult(x, dev) + } else if (dist == "studmult") { + .hist.Studmult(x, dev) + } + } ) -setMethod( "plotDens", signature( x = "mcmcoutputfix", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - dist <- x@model@dist - if ( dist == "poisson" ) { - .dens.Poisson( x, dev ) - } else if ( dist == "binomial" ) { - .dens.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .dens.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .dens.Normal( x, dev ) - } else if ( dist == "student" ) { - .dens.Student( x, dev ) - } else if ( dist == "normult" ) { - .dens.Normult( x, dev ) - } else if ( dist == "studmult" ) { - .dens.Studmult( x, dev ) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .dens.Poisson(x, dev) + } else if (dist == "binomial") { + .dens.Binomial(x, dev) + } else if (dist == "exponential") { + .dens.Exponential(x, dev) + } else if (dist == "normal") { + .dens.Normal(x, dev) + } else if (dist == "student") { + .dens.Student(x, dev) + } else if (dist == "normult") { + .dens.Normult(x, dev) + } else if (dist == "studmult") { + .dens.Studmult(x, dev) + } + } ) -setMethod("plotPointProc", signature( x = "mcmcoutputfix", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .pointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .pointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .pointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .pointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputfix", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .samprep.Poisson(x, dev) - } else if (dist == "binomial") { - .samprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputfix", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .samprep.Poisson(x, dev) + } else if (dist == "binomial") { + .samprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputfix", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .postdens.Poisson(x, dev) - } else if (dist == "binomial") { - .postdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .postdens.Poisson(x, dev) + } else if (dist == "binomial") { + .postdens.Binomial(x, dev) + } + } ) -setMethod( "subseq", signature( object = "mcmcoutputfix", - index = "array" ), - function( object, index ) - { - .subseq.valid.Arg( object, index ) - dist <- object@model@dist - object@M <- sum( index ) - ## log ## - object <- .subseq.Log.Fix( object, index ) - ## par ## - if ( dist == "poisson" ) { - .subseq.Poisson( object, index ) - } else if ( dist == "binomial" ) { - .subseq.Binomial( object, index ) - } else if ( dist == "exponential" ) { - .subseq.Exponential ( object, index ) - } else if ( dist == "normal" ) { - .subseq.Normal( object, index ) - } else if ( dist == "student" ) { - .subseq.Student( object, index ) - } else if ( dist == "normult" ) { - .subseq.Normult( object, index ) - } else if ( dist == "studmult" ) { - .subseq.Studmult( object, index ) - } - } +setMethod( + "subseq", signature( + object = "mcmcoutputfix", + index = "array" + ), + function(object, index) { + .subseq.valid.Arg(object, index) + dist <- object@model@dist + object@M <- sum(index) + ## log ## + object <- .subseq.Log.Fix(object, index) + ## par ## + if (dist == "poisson") { + .subseq.Poisson(object, index) + } else if (dist == "binomial") { + .subseq.Binomial(object, index) + } else if (dist == "exponential") { + .subseq.Exponential(object, index) + } else if (dist == "normal") { + .subseq.Normal(object, index) + } else if (dist == "student") { + .subseq.Student(object, index) + } else if (dist == "normult") { + .subseq.Normult(object, index) + } else if (dist == "studmult") { + .subseq.Studmult(object, index) + } + } ) -setMethod( "swapElements", signature( object = "mcmcoutputfix", - index = "array" ), - function( object, index ) - { ## Check arguments, TODO: .validObject ## - .swapElements.valid.Arg( object, index ) - if ( object@model@K == 1 ) { - return( object ) - } else { - dist <- object@model@dist - if ( dist == "poisson" ) { - .swapElements.Poisson( object, index ) - } else if ( dist == "binomial" ) { - .swapElements.Binomial( object, index ) - } else if ( dist == "exponential" ) { - .swapElements.Exponential( object, index ) - } else if ( dist == "normal" ) { - .swapElements.Normal( object, index ) - } else if ( dist == "student" ) { - .swapElements.Student( object, index ) - } else if ( dist == "normult" ) { - .swapElements.Normult( object, index ) - } else if ( dist == "studmult" ) { - .swapElements.Studmult( object, index ) - } - } - } -) - -setMethod( "extract", signature( object = "mcmcoutputfix", - index = "numeric" ), - function( object, index ) - { - dist <- object@model@dist - if ( dist == "normult" ) { - .extract.Normult( object, as.integer( index ) ) - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputfix", + index = "array" + ), + function(object, index) { ## Check arguments, TODO: .validObject ## + .swapElements.valid.Arg(object, index) + if (object@model@K == 1) { + return(object) + } else { + dist <- object@model@dist + if (dist == "poisson") { + .swapElements.Poisson(object, index) + } else if (dist == "binomial") { + .swapElements.Binomial(object, index) + } else if (dist == "exponential") { + .swapElements.Exponential(object, index) + } else if (dist == "normal") { + .swapElements.Normal(object, index) + } else if (dist == "student") { + .swapElements.Student(object, index) + } else if (dist == "normult") { + .swapElements.Normult(object, index) + } else if (dist == "studmult") { + .swapElements.Studmult(object, index) + } + } + } +) + +setMethod( + "extract", signature( + object = "mcmcoutputfix", + index = "numeric" + ), + function(object, index) { + dist <- object@model@dist + if (dist == "normult") { + .extract.Normult(object, as.integer(index)) + } + } ) -setMethod( "moments", signature( object = "mcmcoutputfix" ), - function( object ) - { - dist <- objject@model@dist - if ( dist == "normult" ) { - .moments.Normult.Mcmcoutput( object ) - } - } +setMethod( + "moments", signature(object = "mcmcoutputfix"), + function(object) { + dist <- objject@model@dist + if (dist == "normult") { + .moments.Normult.Mcmcoutput(object) + } + } ) ## Getters ## -setMethod( "getM", "mcmcoutputfix", - function( object ) - { - return( object@M ) - } +setMethod( + "getM", "mcmcoutputfix", + function(object) { + return(object@M) + } ) -setMethod("getBurnin", "mcmcoutputfix", - function(object) - { - return(object@burnin) - } +setMethod( + "getBurnin", "mcmcoutputfix", + function(object) { + return(object@burnin) + } ) -setMethod("getRanperm", "mcmcoutputfix", - function(object) - { - return(object@ranperm) - } +setMethod( + "getRanperm", "mcmcoutputfix", + function(object) { + return(object@ranperm) + } ) -setMethod("getPar", "mcmcoutputfix", - function(object) - { - return(object@par) - } +setMethod( + "getPar", "mcmcoutputfix", + function(object) { + return(object@par) + } ) -setMethod("getLog", "mcmcoutputfix", - function(object) - { - return(object@log) - } +setMethod( + "getLog", "mcmcoutputfix", + function(object) { + return(object@log) + } ) -setMethod("getModel", "mcmcoutputfix", - function(object) - { - return(object@model) - } +setMethod( + "getModel", "mcmcoutputfix", + function(object) { + return(object@model) + } ) -setMethod("getPrior", "mcmcoutputfix", - function(object) - { - return(object@prior) - } +setMethod( + "getPrior", "mcmcoutputfix", + function(object) { + return(object@prior) + } ) ## No setters as users are not intended to manipulate ## @@ -309,171 +338,208 @@ setMethod("getPrior", "mcmcoutputfix", ### for Poisson mixture. If dev = FALSE, no graphical ### device is started, instead it is assumed that the ### user wants to save the graphic to a file. -".traces.Poisson" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@par$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = .7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = .6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = .7, line = 3) +".traces.Poisson" <- function(x, dev) { + K <- x@model@K + trace.n <- K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@par$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".traces.Binomial" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - p <- x@par$p - for (k in 1:K) { - plot(p[, k], type = "l", axes = F, col = "gray20", - xlab = "", ylab = "") - axis(2, las = 2, cex.axis = .7) - mtext(side = 2, las = 2, bquote(p[k = .(k)]), - cex = .6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = .7, line = 3) +".traces.Binomial" <- function(x, dev) { + K <- x@model@K + trace.n <- K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + p <- x@par$p + for (k in 1:K) { + plot(p[, k], + type = "l", axes = F, col = "gray20", + xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(p[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .traces.Exponential ### @description Plots traces for parameters of Exponential mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Exponential mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Exponential mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".traces.Exponential" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - lambda <- x@par$lambda - for ( k in 1:K ) { - plot( lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( lambda[k = .( k )] ), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Exponential" <- function(x, dev) { + K <- x@model@K + trace.n <- K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@par$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .traces.Normal -### @description Plots traces for parameters of a univariate Normal +### @description Plots traces for parameters of a univariate Normal ### mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Normal mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Normal mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".traces.Normal" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 2 * K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@par$mu - sigma <- x@par$sigma - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Normal" <- function(x, dev) { + K <- x@model@K + trace.n <- 2 * K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@par$mu + sigma <- x@par$sigma + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .traces.Student -### @description Plots traces for parameters of a univariate Student +### @description Plots traces for parameters of a univariate Student ### mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Student mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".traces.Student" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 3 * K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@par$mu - sigma <- x@par$sigma - df <- x@par$df - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( df[, k], type = "l", axes = F, - col = "gray40", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( nu[k = .( k )]), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Student" <- function(x, dev) { + K <- x@model@K + trace.n <- 3 * K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@par$mu + sigma <- x@par$sigma + df <- x@par$df + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(df[, k], + type = "l", axes = F, + col = "gray40", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(nu[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### ------------------------------------------------------------------------- @@ -489,123 +555,159 @@ setMethod("getPrior", "mcmcoutputfix", ### @see ?plotTraces ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------- -".traces.Normult" <- function( x, dev, col ) -{ - K <- x@model@K - r <- x@model@r - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - trace.n <- r + 2 - par( mfrow = c( trace.n, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 2, 4 ) ) - mu <- x@par$mu - sigma <- x@par$sigma - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - for ( rr in 1:r ) { - mmax <- max( mu[,rr,] ) - mmin <- min( mu[,rr,] ) - plot( mu[, rr, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax + 0.3 * (mmax - mmin) ) ) - for ( k in 2:K ) { - lines( mu[, rr, k], col = cscale[ k ] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[rr = .( rr )] ), - cex = .6, line = 3 ) - if ( rr == 1 ) { - name <- vector( "character", K ) - for (k in 1:K ) { - name[k] <- paste( "k = ", k, sep = "") - } - legend( "top", legend = name, col = cscale, horiz = TRUE, - lty = 1 ) - } - } - sigma.tr <- array( numeric(), dim = c( x@M, K ) ) - sigma.det <- array( numeric(), dim = c( x@M, K ) ) - for ( k in 1:K ) { - sigma.tr[, k] <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( sigma[i,, k] ) ) ) ) - sigma.det[, k] <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( sigma[i,, k] ) ) ) ) - } - # Sigma traces - mmax <- max( sigma.tr ) - mmin <- min( sigma.tr ) - plot( sigma.tr[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for ( k in 2:K ) { - lines( sigma.tr[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr( Sigma ) ), - cex = .6, line = 3 ) - - # Sigma logdets - mmax <- max( sigma.det ) - mmin <- min( sigma.det ) - plot( sigma.det[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for( k in 2:K ) { - lines( sigma.det[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( log( det( Sigma ) ) ), - cex = .6, line = 3 ) - - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - - # Get moments - moms <- moments_cc( x ) - for ( rr in 1:r ) { - if ( .check.grDevice() && dev ) { - dev.new( title = paste( "Traceplots Feature ", rr, sep = "" ) ) - } - par( mfrow = c( 2, 2 ), mar = c( 4, 4, 0.5, 0.5 ), - oma = c( 1.5, 2, 1, 1 ) ) - # Mu - plot( moms$mean[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Variance - plot( moms$var[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Skewness - plot( moms$skewness[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Skewness", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Kurtosis - plot( moms$kurtosis[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Kurtosis", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - } - +".traces.Normult" <- function(x, dev, col) { + K <- x@model@K + r <- x@model@r + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + trace.n <- r + 2 + par( + mfrow = c(trace.n, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 2, 4) + ) + mu <- x@par$mu + sigma <- x@par$sigma + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + for (rr in 1:r) { + mmax <- max(mu[, rr, ]) + mmin <- min(mu[, rr, ]) + plot(mu[, rr, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax + 0.3 * (mmax - mmin)) + ) + for (k in 2:K) { + lines(mu[, rr, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[rr = .(rr)]), + cex = .6, line = 3 + ) + if (rr == 1) { + name <- vector("character", K) + for (k in 1:K) { + name[k] <- paste("k = ", k, sep = "") + } + legend("top", + legend = name, col = cscale, horiz = TRUE, + lty = 1 + ) + } + } + sigma.tr <- array(numeric(), dim = c(x@M, K)) + sigma.det <- array(numeric(), dim = c(x@M, K)) + for (k in 1:K) { + sigma.tr[, k] <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(sigma[i, , k]))) + ) + sigma.det[, k] <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(sigma[i, , k]))) + ) + } + # Sigma traces + mmax <- max(sigma.tr) + mmin <- min(sigma.tr) + plot(sigma.tr[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.tr[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(Sigma)), + cex = .6, line = 3 + ) + + # Sigma logdets + mmax <- max(sigma.det) + mmin <- min(sigma.det) + plot(sigma.det[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.det[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(log(det(Sigma))), + cex = .6, line = 3 + ) + + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + + # Get moments + moms <- moments_cc(x) + for (rr in 1:r) { + if (.check.grDevice() && dev) { + dev.new(title = paste("Traceplots Feature ", rr, sep = "")) + } + par( + mfrow = c(2, 2), mar = c(4, 4, 0.5, 0.5), + oma = c(1.5, 2, 1, 1) + ) + # Mu + plot(moms$mean[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Variance + plot(moms$var[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Skewness + plot(moms$skewness[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Skewness", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Kurtosis + plot(moms$kurtosis[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Kurtosis", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + } } ### ------------------------------------------------------------------------- @@ -621,1045 +723,1179 @@ setMethod("getPrior", "mcmcoutputfix", ### @see ?plotTraces ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------- -".traces.Studmult" <- function( x, dev, col ) -{ - K <- x@model@K - r <- x@model@r - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - trace.n <- r + 2 - par( mfrow = c( trace.n, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@par$mu - sigma <- x@par$sigma - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - for ( rr in 1:r ) { - mmax <- max( mu[,rr,] ) - mmin <- min( mu[,rr,] ) - plot( mu[, rr, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax + 0.3 * ( mmax - mmin ) ) ) - for ( k in 2:K ) { - lines( mu[, rr, k], col = cscale[ k ] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[rr = .( rr )] ), - cex = .6, line = 3 ) - if ( rr == 1 ) { - name <- vector( "character", K ) - for (k in 1:K ) { - name[k] <- paste( "k = ", k, sep = "") - } - legend( "top", legend = name, col = cscale, horiz = TRUE, - lty = 1 ) - } - } - sigma.tr <- array( numeric(), dim = c( x@M, K ) ) - sigma.det <- array( numeric(), dim = c( x@M, K ) ) - for ( k in 1:K ) { - sigma.tr[, k] <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( sigma[i,, k] ) ) ) ) - sigma.det[, k] <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( sigma[i,, k] ) ) ) ) - } - # Sigma traces - mmax <- max( sigma.tr ) - mmin <- min( sigma.tr ) - plot( sigma.tr[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for ( k in 2:K ) { - lines( sigma.tr[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr( Sigma ) ), - cex = .6, line = 3 ) - - # Sigma logdets - mmax <- max( sigma.det ) - mmin <- min( sigma.det ) - plot( sigma.det[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for( k in 2:K ) { - lines( sigma.det[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( log( det( Sigma ) ) ), - cex = .6, line = 3 ) - - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - - # Degrees of freedom - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Degrees of Freedom" ) - } - degf <- x@par$df - par( mfrow = c( K, 1 ), mar = c( 1, 2, 0, 0), - oma = c( 4, 5, 4, 4 ) ) - for ( k in 1:K ) { - plot( degf[,k], type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( nu[ k = .(k) ] ), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Get moments - moms <- moments_cc( x ) - for ( rr in 1:r ) { - if ( .check.grDevice() && dev ) { - dev.new( title = paste( "Traceplots Feature ", rr, sep = "" ) ) - } - par( mfrow = c( 2, 2 ), mar = c( 4, 4, 0.5, 0.5 ), - oma = c( 1.5, 2, 1, 1 ) ) - # Mu - plot( moms$mean[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Variance - plot( moms$var[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Skewness - plot( moms$skewness[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Skewness", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Kurtosis - plot( moms$kurtosis[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Kurtosis", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - } +".traces.Studmult" <- function(x, dev, col) { + K <- x@model@K + r <- x@model@r + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + trace.n <- r + 2 + par( + mfrow = c(trace.n, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@par$mu + sigma <- x@par$sigma + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + for (rr in 1:r) { + mmax <- max(mu[, rr, ]) + mmin <- min(mu[, rr, ]) + plot(mu[, rr, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax + 0.3 * (mmax - mmin)) + ) + for (k in 2:K) { + lines(mu[, rr, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[rr = .(rr)]), + cex = .6, line = 3 + ) + if (rr == 1) { + name <- vector("character", K) + for (k in 1:K) { + name[k] <- paste("k = ", k, sep = "") + } + legend("top", + legend = name, col = cscale, horiz = TRUE, + lty = 1 + ) + } + } + sigma.tr <- array(numeric(), dim = c(x@M, K)) + sigma.det <- array(numeric(), dim = c(x@M, K)) + for (k in 1:K) { + sigma.tr[, k] <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(sigma[i, , k]))) + ) + sigma.det[, k] <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(sigma[i, , k]))) + ) + } + # Sigma traces + mmax <- max(sigma.tr) + mmin <- min(sigma.tr) + plot(sigma.tr[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.tr[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(Sigma)), + cex = .6, line = 3 + ) + + # Sigma logdets + mmax <- max(sigma.det) + mmin <- min(sigma.det) + plot(sigma.det[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.det[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(log(det(Sigma))), + cex = .6, line = 3 + ) + + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + + # Degrees of freedom + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Degrees of Freedom") + } + degf <- x@par$df + par( + mfrow = c(K, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + for (k in 1:K) { + plot(degf[, k], + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(nu[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Get moments + moms <- moments_cc(x) + for (rr in 1:r) { + if (.check.grDevice() && dev) { + dev.new(title = paste("Traceplots Feature ", rr, sep = "")) + } + par( + mfrow = c(2, 2), mar = c(4, 4, 0.5, 0.5), + oma = c(1.5, 2, 1, 1) + ) + # Mu + plot(moms$mean[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Variance + plot(moms$var[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Skewness + plot(moms$skewness[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Skewness", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Kurtosis + plot(moms$kurtosis[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Kurtosis", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + } } ### Traces Poisson: Plots the traces of MCMC samples ### for the log-likelihoods. If dev = FALSE, no graphical ### device is started, instead it is assumed that the ### user wants to save the graphic to a file. -".traces.Log" <- function( x, dev, col ) -{ - if( .check.grDevice() && dev ) { - dev.new( title = "Log Likelihood Traceplots" ) - } - if ( col ) { - cscale <- rainbow( 3, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( 3, start = 0.5, end = 0.15 ) - } - par( mfrow = c( 2, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mixlik <- x@log$mixlik - plot( mixlik, type = "l", axes = F, - col = cscale[3], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixlik", cex = 0.6, - line = 3 ) - mixprior <- x@log$mixprior - plot( mixprior, type = "l", axes = F, - col = cscale[2], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixprior", cex = 0.6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = 0.7, line = 3 ) +".traces.Log" <- function(x, dev, col) { + if (.check.grDevice() && dev) { + dev.new(title = "Log Likelihood Traceplots") + } + if (col) { + cscale <- rainbow(3, start = 0.5, end = 0) + } else { + cscale <- gray.colors(3, start = 0.5, end = 0.15) + } + par( + mfrow = c(2, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mixlik <- x@log$mixlik + plot(mixlik, + type = "l", axes = F, + col = cscale[3], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixlik", cex = 0.6, + line = 3 + ) + mixprior <- x@log$mixprior + plot(mixprior, + type = "l", axes = F, + col = cscale[2], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixprior", cex = 0.6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### Plot Histogramms ### Plot Hist Poisson: Plots Histograms for each component -### parameter. -".hist.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms") - } - lambda <- x@par$lambda - if (K == 1) { - .symmetric.Hist(lambda, list(bquote(lambda))) - } else { - lab.names <- vector("list", K) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - .symmetric.Hist(lambda, lab.names) +### parameter. +".hist.Poisson" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + lambda <- x@par$lambda + if (K == 1) { + .symmetric.Hist(lambda, list(bquote(lambda))) + } else { + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) } + .symmetric.Hist(lambda, lab.names) + } } -".hist.Binomial" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms") - } - p <- x@par$p - if (K == 1) { - .symmetric.Hist(p, list(bquote(p))) - } else { - lab.names <- vector("list", K) - for (k in 1:K) { - lab.names[[k]] <- bquote(p[.(k)]) - } - .symmetric.Hist(p, lab.names) +".hist.Binomial" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + p <- x@par$p + if (K == 1) { + .symmetric.Hist(p, list(bquote(p))) + } else { + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(p[.(k)]) } + .symmetric.Hist(p, lab.names) + } } -".hist.Exponential" <- function( x, dev ) -{ - K <- x@model@K - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms" ) - } - lambda <- x@par$lambda - if ( K == 1 ) { - .symmetric.Hist( lambda, list( bquote( lambda ) ) ) - } else { - lab.names <- vector( "list", K ) - for ( k in 1:K ) { - lab.names[[k]] <- bquote( lambda[.( k )] ) - } - .symmetric.Hist( lambda, lab.names ) +".hist.Exponential" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + lambda <- x@par$lambda + if (K == 1) { + .symmetric.Hist(lambda, list(bquote(lambda))) + } else { + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) } + .symmetric.Hist(lambda, lab.names) + } } -".hist.Normal" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Mu" ) - } - .symmetric.Hist( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Sigma" ) - } - .symmetric.Hist( sigma, list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Mu" ) - } - .symmetric.Hist( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Sigma" ) - } - .symmetric.Hist( sigma, sigma.lab.names ) +".hist.Normal" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + if (K == 1) { + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Mu") } -} - -".hist.Student" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Mu" ) - } - .symmetric.Hist( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Sigma" ) - } - .symmetric.Hist( sigma, list( bquote( sigma ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Degrees of Freedom" ) - } - .symmetric.Hist( degf, list( bquote( nu ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Mu" ) - } - .symmetric.Hist( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Sigma" ) - } - .symmetric.Hist( sigma, sigma.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Degrees of Freedom" ) - } - .symmetric.Hist( degf, degf.lab.names ) + .symmetric.Hist(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Sigma") } -} - -".hist.Normult" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], sigma.lab.names ) - } + .symmetric.Hist(sigma, list(bquote(sigma))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) } -} - -".hist.Studmult" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], list( bquote( sigma ) ) ) - - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], sigma.lab.names ) - } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Mu") } - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( degf[, rr,], list( bquote( nu ) ) ) - } else { - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( degf[, rr,], degf.lab.names ) + .symmetric.Hist(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Sigma") } + .symmetric.Hist(sigma, sigma.lab.names) + } } -### Plot Densities -### Plot Dens Poisson: Plots Kernel densities for each -### component parameter. -".dens.Poisson" <- function(x, dev) -{ - K <- x@model@K +".hist.Student" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + if (K == 1) { if (.check.grDevice() && dev) { - dev.new(title = "Densities") + dev.new(title = "Histogram Mu") } - lambda <- x@par$lambda - if (K == 1) { - .symmetric.Dens(lambda, list(bquote(lambda))) - } else { - lab.names <- vector("list", K) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - .symmetric.Dens(lambda, lab.names) + .symmetric.Hist(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Sigma") } -} - -".dens.Binomial" <- function(x, dev) -{ - K <- x@model@K + .symmetric.Hist(sigma, list(bquote(sigma))) if (.check.grDevice() && dev) { - dev.new(title = "Densities") + dev.new(title = "Histogram Degrees of Freedom") } - p <- x@par$p - if (K == 1) { - .symmetric.Dens(p, list(bquote(p))) - } else { - lab.names <- vector("list", K) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(p[.(k)]) - } - .symmetric.Dens(p, lab.names) + .symmetric.Hist(degf, list(bquote(nu))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + degf.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + degf.lab.names[[k]] <- bquote(nu[.(k)]) } -} - -".dens.Exponential" <- function( x, dev ) -{ - K <- x@model@K - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities" ) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Mu") } - lambda <- x@par$lambda - if ( K == 1 ) { - .symmetric.Dens( lambda, list( bquote( lambda ) ) ) - } else { - lab.names <- vector( "list", K ) - for ( k in 1:K ) { - lab.names[[k]] <- bquote( lambda[.( k )] ) - } - .symmetric.Dens( lambda, lab.names ) + .symmetric.Hist(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Sigma") + } + .symmetric.Hist(sigma, sigma.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Degrees of Freedom") } + .symmetric.Hist(degf, degf.lab.names) + } } -".dens.Normal" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Mu" ) - } - .symmetric.Dens( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Sigma" ) - } - .symmetric.Dens( sigma, list( bquote( sigma ) ) ) +".hist.Normult" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], list(bquote(sigma))) } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Mu" ) - } - .symmetric.Dens( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Sigma" ) - } - .symmetric.Dens( sigma, sigma.lab.names ) - } + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], sigma.lab.names) + } + } } -".dens.Student.Hier" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Mu" ) - } - .symmetric.Dens( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Sigma" ) - } - .symmetric.Dens( sigma, list( bquote( sigma ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Degrees of Freedom" ) - } - .symmetric.Dens( degf, list( bquote( nu ) ) ) +".hist.Studmult" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], list(bquote(sigma))) } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Mu" ) - } - .symmetric.Dens( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Sigma" ) - } - .symmetric.Dens( sigma, sigma.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Degrees of Freedom" ) - } - .symmetric.Dens( degf, degf.lab.names ) + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], sigma.lab.names) + } + } + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(degf[, rr, ], list(bquote(nu))) + } else { + degf.lab.names <- vector("list", K) + for (k in 1:K) { + degf.lab.names[[k]] <- bquote(nu[.(k)]) } + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(degf[, rr, ], degf.lab.names) + } } -".dens.Normult" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], sigma.lab.names ) - } +### Plot Densities +### Plot Dens Poisson: Plots Kernel densities for each +### component parameter. +".dens.Poisson" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + lambda <- x@par$lambda + if (K == 1) { + .symmetric.Dens(lambda, list(bquote(lambda))) + } else { + lab.names <- vector("list", K) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Hyperparameter C" ) - } + .symmetric.Dens(lambda, lab.names) + } } -".dens.Studmult" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], list( bquote( sigma ) ) ) - - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], sigma.lab.names ) - } +".dens.Binomial" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + p <- x@par$p + if (K == 1) { + .symmetric.Dens(p, list(bquote(p))) + } else { + lab.names <- vector("list", K) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(p[.(k)]) } - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = "Density Degrees of Freedom" ) - } - .symmetric.Dens( degf[, rr,], list( bquote( nu ) ) ) - } else { - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = "Densities Degrees of Freedom" ) - } - .symmetric.Dens( degf[, rr,], degf.lab.names ) + .symmetric.Dens(p, lab.names) + } +} + +".dens.Exponential" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + lambda <- x@par$lambda + if (K == 1) { + .symmetric.Dens(lambda, list(bquote(lambda))) + } else { + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) } + .symmetric.Dens(lambda, lab.names) + } } -### Plot Point Processes -### Plot Point Process Poisson: Plots the point process -### for the MCMC draws for lambda. The values are plotted -### against a random normal sample. -".pointproc.Poisson" <- function(x, dev) -{ - K <- x@model@K - M <- x@M +".dens.Normal" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + if (K == 1) { if (.check.grDevice() && dev) { - dev.new(title = "Point Process Representation (MCMC)") + dev.new(title = "Density Mu") } - y.grid <- replicate(K, rnorm(M)) - if (median(x@par$lambda) < 1) { - lambda <- log(x@par$lambda) - } else { - lambda <- x@par$lambda + .symmetric.Dens(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Density Sigma") } - col.grid <- gray.colors(K, start = 0, - end = 0.5) - legend.names <- vector("list", K) - for (k in seq(1, K)) { - legend.names[[k]] <- bquote(lambda[.(k)]) + .symmetric.Dens(sigma, list(bquote(sigma))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) } - plot(lambda, y.grid, pch = 20, col = col.grid, - cex = .7, cex.axis = .7, cex.lab = .7, - main = "", ylab = "", xlab = "") - mtext(side = 1, bquote(lambda), cex = .7, - cex.lab = .7, line = 3) - legend("topright", legend = do.call(expression, - legend.names), - col = col.grid, fill = col.grid) -} - -".pointproc.Binomial" <- function(x, dev) -{ - K <- x@model@K - M <- x@M if (.check.grDevice() && dev) { - dev.new(title = "Point Process Representation (MCMC)") + dev.new(title = "Densities Mu") } - y.grid <- replicate(K, rnorm(M)) - p <- x@par$p - col.grid <- gray.colors(K, start = 0, - end = 0.5) - legend.names <- vector("list", K) - for (k in seq(1, K)) { - legend.names[[k]] <- bquote(p[.(k)]) + .symmetric.Dens(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Densities Sigma") } - plot(p, y.grid, pch = 20, col = col.grid, - cex = .7, cex.axis = .7, cex.lab = .7, - main = "", ylab = "", xlab = "") - mtext(side = 1, bquote(p), cex = .7, - cex.lab = .7, line = 3) - legend("topright", legend = do.call(expression, - legend.names), - col = col.grid, fill = col.grid) + .symmetric.Dens(sigma, sigma.lab.names) + } } -### Plot sampling representation -### Plot sampling representation Poisson: Plots the sampling -### representation for Poisson parameters. Each parameter sample -### is combined with the other samples. -".samprep.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (K == 1) { - warning(paste("Sampling representation is only ", - "available for mixture models with ", - "K > 1.", sep = "")) - return(FALSE) +".dens.Student.Hier" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + if (K == 1) { + if (.check.grDevice() && dev) { + dev.new(title = "Density Mu") + } + .symmetric.Dens(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Density Sigma") + } + .symmetric.Dens(sigma, list(bquote(sigma))) + if (.check.grDevice() && dev) { + dev.new(title = "Density Degrees of Freedom") + } + .symmetric.Dens(degf, list(bquote(nu))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + degf.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + degf.lab.names[[k]] <- bquote(nu[.(k)]) } - M <- x@M - n <- min(2000, x@M) - n.perm <- choose(K, 2) * factorial(2) - lambda <- x@par$lambda if (.check.grDevice() && dev) { - dev.new(title = "Sampling Representation (MCMC)") + dev.new(title = "Densities Mu") } - comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) - comb <- comb[which(comb[, 1] != comb[, 2]), ] - lambda <- lambda[seq(1, n), ] - lambda <- matrix(lambda[,comb], nrow = n * n.perm, ncol = 2) - plot(lambda, col = "gray47", cex.lab = .7, cex.axis = .7, - cex = .7, pch = 20, main = "", xlab = "", ylab = "") - abline(0, 1, lty = 1) - mtext(side = 1, bquote(lambda), cex = .7, cex.lab = .7, - line = 3) - mtext(side = 2, bquote(lambda), cex = .7, cex.lab = .7, - line = 3) + .symmetric.Dens(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Densities Sigma") + } + .symmetric.Dens(sigma, sigma.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Densities Degrees of Freedom") + } + .symmetric.Dens(degf, degf.lab.names) + } +} +".dens.Normult" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], list(bquote(sigma))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], sigma.lab.names) + } + } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Hyperparameter C") + } } -".samprep.Binomial" <- function(x, dev) -{ - K <- x@model@K +".dens.Studmult" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + for (rr in 1:r) { if (K == 1) { - warning(paste("Sampling representation is only ", - "available for mixture models with ", - "K > 1.", sep = "")) - return(FALSE) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], list(bquote(sigma))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], sigma.lab.names) + } + } + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = "Density Degrees of Freedom") + } + .symmetric.Dens(degf[, rr, ], list(bquote(nu))) + } else { + degf.lab.names <- vector("list", K) + for (k in 1:K) { + degf.lab.names[[k]] <- bquote(nu[.(k)]) } - M <- x@M - n <- min(2000, x@M) - n.perm <- choose(K, 2) * factorial(2) - p <- x@par$p - if (.check.grDevice() && dev) { - dev.new(title = "Sampling Representation") + if (.check.grDevice() & dev) { + dev.new(title = "Densities Degrees of Freedom") } - comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) - comb <- comb[which(comb[, 1] != comb[, 2]), ] - p <- p[seq(1, n), ] - p <- matrix(p[,comb], nrow = n * n.perm, ncol = 2) - plot(p, col = "gray47", cex.lab = .7, cex.axis = .7, - cex = .7, pch = 20, main = "", xlab = "", ylab = "") - abline(0, 1, lty = 1) - mtext(side = 1, bquote(p), cex = .7, cex.lab = .7, - line = 3) - mtext(side = 2, bquote(p), cex = .7, cex.lab = .7, - line = 3) + .symmetric.Dens(degf[, rr, ], degf.lab.names) + } +} +### Plot Point Processes +### Plot Point Process Poisson: Plots the point process +### for the MCMC draws for lambda. The values are plotted +### against a random normal sample. +".pointproc.Poisson" <- function(x, dev) { + K <- x@model@K + M <- x@M + if (.check.grDevice() && dev) { + dev.new(title = "Point Process Representation (MCMC)") + } + y.grid <- replicate(K, rnorm(M)) + if (median(x@par$lambda) < 1) { + lambda <- log(x@par$lambda) + } else { + lambda <- x@par$lambda + } + col.grid <- gray.colors(K, + start = 0, + end = 0.5 + ) + legend.names <- vector("list", K) + for (k in seq(1, K)) { + legend.names[[k]] <- bquote(lambda[.(k)]) + } + plot(lambda, y.grid, + pch = 20, col = col.grid, + cex = .7, cex.axis = .7, cex.lab = .7, + main = "", ylab = "", xlab = "" + ) + mtext( + side = 1, bquote(lambda), cex = .7, + cex.lab = .7, line = 3 + ) + legend("topright", + legend = do.call( + expression, + legend.names + ), + col = col.grid, fill = col.grid + ) +} + +".pointproc.Binomial" <- function(x, dev) { + K <- x@model@K + M <- x@M + if (.check.grDevice() && dev) { + dev.new(title = "Point Process Representation (MCMC)") + } + y.grid <- replicate(K, rnorm(M)) + p <- x@par$p + col.grid <- gray.colors(K, + start = 0, + end = 0.5 + ) + legend.names <- vector("list", K) + for (k in seq(1, K)) { + legend.names[[k]] <- bquote(p[.(k)]) + } + plot(p, y.grid, + pch = 20, col = col.grid, + cex = .7, cex.axis = .7, cex.lab = .7, + main = "", ylab = "", xlab = "" + ) + mtext( + side = 1, bquote(p), cex = .7, + cex.lab = .7, line = 3 + ) + legend("topright", + legend = do.call( + expression, + legend.names + ), + col = col.grid, fill = col.grid + ) +} + +### Plot sampling representation +### Plot sampling representation Poisson: Plots the sampling +### representation for Poisson parameters. Each parameter sample +### is combined with the other samples. +".samprep.Poisson" <- function(x, dev) { + K <- x@model@K + if (K == 1) { + warning(paste("Sampling representation is only ", + "available for mixture models with ", + "K > 1.", + sep = "" + )) + return(FALSE) + } + M <- x@M + n <- min(2000, x@M) + n.perm <- choose(K, 2) * factorial(2) + lambda <- x@par$lambda + if (.check.grDevice() && dev) { + dev.new(title = "Sampling Representation (MCMC)") + } + comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) + comb <- comb[which(comb[, 1] != comb[, 2]), ] + lambda <- lambda[seq(1, n), ] + lambda <- matrix(lambda[, comb], nrow = n * n.perm, ncol = 2) + plot(lambda, + col = "gray47", cex.lab = .7, cex.axis = .7, + cex = .7, pch = 20, main = "", xlab = "", ylab = "" + ) + abline(0, 1, lty = 1) + mtext( + side = 1, bquote(lambda), cex = .7, cex.lab = .7, + line = 3 + ) + mtext( + side = 2, bquote(lambda), cex = .7, cex.lab = .7, + line = 3 + ) +} + +".samprep.Binomial" <- function(x, dev) { + K <- x@model@K + if (K == 1) { + warning(paste("Sampling representation is only ", + "available for mixture models with ", + "K > 1.", + sep = "" + )) + return(FALSE) + } + M <- x@M + n <- min(2000, x@M) + n.perm <- choose(K, 2) * factorial(2) + p <- x@par$p + if (.check.grDevice() && dev) { + dev.new(title = "Sampling Representation") + } + comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) + comb <- comb[which(comb[, 1] != comb[, 2]), ] + p <- p[seq(1, n), ] + p <- matrix(p[, comb], nrow = n * n.perm, ncol = 2) + plot(p, + col = "gray47", cex.lab = .7, cex.axis = .7, + cex = .7, pch = 20, main = "", xlab = "", ylab = "" + ) + abline(0, 1, lty = 1) + mtext( + side = 1, bquote(p), cex = .7, cex.lab = .7, + line = 3 + ) + mtext( + side = 2, bquote(p), cex = .7, cex.lab = .7, + line = 3 + ) } ### Posterior Density -### Posterior Density Poisson: Plots a contour plot of the +### Posterior Density Poisson: Plots a contour plot of the ### posterior density of the sampled parameters for K = 2. -".postdens.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (K != 2) { - warning(paste("A plot of the posterior density is ", - "available only for K = 2.", sep = "")) - } else { - M <- x@M - n <- min(2000, M) - lambda <- x@par$lambda - lambda <- lambda[seq(1, n), ] - dens <- bkde2D(lambda, bandwidth = c(sd(lambda[, 1]), - sd(lambda[, 2]))) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Contour Plot (MCMC)") - } - contour(dens$x1, dens$x2, dens$fhat, cex = .7, - cex.lab = .7, cex.axis = .7, col = "gray47", - main = "", xlab = "", ylab = "") - mtext(side = 1, bquote(lambda[1]), cex = .7, - cex.lab = .7, line = 3) - mtext(side = 2, bquote(lambda[2]), cex = .7, - cex.lab = .7, line = 3) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Perspective Plot (MCMC)") - } - persp(dens$x1, dens$x2, dens$fhat, col = "gray65", - border = "gray47", theta = 55, phi = 30, - expand = .5, lphi = 180, ltheta = 90, - r = 40, d = .1, ticktype = "detailed", zlab = - "Density", xlab = "k = 1" , ylab = "k = 2") - } +".postdens.Poisson" <- function(x, dev) { + K <- x@model@K + if (K != 2) { + warning(paste("A plot of the posterior density is ", + "available only for K = 2.", + sep = "" + )) + } else { + M <- x@M + n <- min(2000, M) + lambda <- x@par$lambda + lambda <- lambda[seq(1, n), ] + dens <- bkde2D(lambda, bandwidth = c( + sd(lambda[, 1]), + sd(lambda[, 2]) + )) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Contour Plot (MCMC)") + } + contour(dens$x1, dens$x2, dens$fhat, + cex = .7, + cex.lab = .7, cex.axis = .7, col = "gray47", + main = "", xlab = "", ylab = "" + ) + mtext( + side = 1, bquote(lambda[1]), cex = .7, + cex.lab = .7, line = 3 + ) + mtext( + side = 2, bquote(lambda[2]), cex = .7, + cex.lab = .7, line = 3 + ) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Perspective Plot (MCMC)") + } + persp(dens$x1, dens$x2, dens$fhat, + col = "gray65", + border = "gray47", theta = 55, phi = 30, + expand = .5, lphi = 180, ltheta = 90, + r = 40, d = .1, ticktype = "detailed", zlab = + "Density", xlab = "k = 1", ylab = "k = 2" + ) + } } -".postdens.Binomial" <- function(x, dev) -{ - K <- x@model@K - if (K != 2) { - warning(paste("A plot of the posterior density is ", - "available only for K = 2.", sep = "")) - } else { - M <- x@M - n <- min(2000, M) - p <- x@par$p - p <- p[seq(1, n), ] - dens <- bkde2D(p, bandwidth = c(sd(p[, 1]), - sd(p[, 2]))) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Contour Plot (MCMC)") - } - contour(dens$x1, dens$x2, dens$fhat, cex = .7, - cex.lab = .7, cex.axis = .7, col = "gray47", - main = "", xlab = "", ylab = "") - mtext(side = 1, bquote(p[1]), cex = .7, - cex.lab = .7, line = 3) - mtext(side = 2, bquote(p[2]), cex = .7, - cex.lab = .7, line = 3) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Perspective Plot (MCMC)") - } - persp(dens$x1, dens$x2, dens$fhat, col = "gray65", - border = "gray47", theta = 55, phi = 30, - expand = .5, lphi = 180, ltheta = 90, - r = 40, d = .1, ticktype = "detailed", zlab = - "Density", xlab = "k = 1" , ylab = "k = 2") - } +".postdens.Binomial" <- function(x, dev) { + K <- x@model@K + if (K != 2) { + warning(paste("A plot of the posterior density is ", + "available only for K = 2.", + sep = "" + )) + } else { + M <- x@M + n <- min(2000, M) + p <- x@par$p + p <- p[seq(1, n), ] + dens <- bkde2D(p, bandwidth = c( + sd(p[, 1]), + sd(p[, 2]) + )) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Contour Plot (MCMC)") + } + contour(dens$x1, dens$x2, dens$fhat, + cex = .7, + cex.lab = .7, cex.axis = .7, col = "gray47", + main = "", xlab = "", ylab = "" + ) + mtext( + side = 1, bquote(p[1]), cex = .7, + cex.lab = .7, line = 3 + ) + mtext( + side = 2, bquote(p[2]), cex = .7, + cex.lab = .7, line = 3 + ) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Perspective Plot (MCMC)") + } + persp(dens$x1, dens$x2, dens$fhat, + col = "gray65", + border = "gray47", theta = 55, phi = 30, + expand = .5, lphi = 180, ltheta = 90, + r = 40, d = .1, ticktype = "detailed", zlab = + "Density", xlab = "k = 1", ylab = "k = 2" + ) + } } ### Logic -### Logic subseq: This function is used for each +### Logic subseq: This function is used for each ### distribution type in 'model'. It crreates a subsequence -### for the log-likelihoods. -".subseq.Log.Fix" <- function(obj, index) -{ - obj@log$mixlik <- matrix(obj@log$mixlik[index], - nrow = obj@M, ncol = 1) - obj@log$mixprior <- matrix(obj@log$mixprior[index], - nrow = obj@M, ncol = 1) - return(obj) +### for the log-likelihoods. +".subseq.Log.Fix" <- function(obj, index) { + obj@log$mixlik <- matrix(obj@log$mixlik[index], + nrow = obj@M, ncol = 1 + ) + obj@log$mixprior <- matrix(obj@log$mixprior[index], + nrow = obj@M, ncol = 1 + ) + return(obj) } -### Logic subseq Poisson: This function creates a subsequence -### MCMC Poisson parameter samples. -".subseq.Poisson" <- function(obj, index) -{ - if (obj@model@K == 1) { - obj@par$lambda <- matrix(obj@par$lambda[index], - nrow = obj@M, ncol = 1) - } else { - obj@par$lambda <- obj@par$lambda[index,] - } - return(obj) +### Logic subseq Poisson: This function creates a subsequence +### MCMC Poisson parameter samples. +".subseq.Poisson" <- function(obj, index) { + if (obj@model@K == 1) { + obj@par$lambda <- matrix(obj@par$lambda[index], + nrow = obj@M, ncol = 1 + ) + } else { + obj@par$lambda <- obj@par$lambda[index, ] + } + return(obj) } -### +### -".subseq.Binomial" <- function(obj, index) -{ - if (obj@model@K == 1) { - obj@par$p <- matrix(obj@par$p[index], nrow = obj@M, - ncol = 1) - } else { - obj@par$p <- obj@par$p[index,] - } - return(obj) +".subseq.Binomial" <- function(obj, index) { + if (obj@model@K == 1) { + obj@par$p <- matrix(obj@par$p[index], + nrow = obj@M, + ncol = 1 + ) + } else { + obj@par$p <- obj@par$p[index, ] + } + return(obj) } -### +### -".subseq.Normal" <- function( obj, index ) -{ - if ( obj@model@K == 1 ) { - obj@par$mu <- matrix( obj@par$mu[index], nrow = obj@M, - ncol = 1 ) - obj@par$sigma <- matrix( obj@par$mu[index], nrow = obj@M, - ncol = 1) - } else { - obj@par$mu <- obj@par$mu[index, ] - obj@par$sigma <- obj@par$sigma[index, ] - } - return( obj ) +".subseq.Normal" <- function(obj, index) { + if (obj@model@K == 1) { + obj@par$mu <- matrix(obj@par$mu[index], + nrow = obj@M, + ncol = 1 + ) + obj@par$sigma <- matrix(obj@par$mu[index], + nrow = obj@M, + ncol = 1 + ) + } else { + obj@par$mu <- obj@par$mu[index, ] + obj@par$sigma <- obj@par$sigma[index, ] + } + return(obj) } ### -".subseq.Student" <- function( obj, index ) -{ - if ( obj@model@K == 1 ) { - obj@par$mu <- matrix( obj@par$mu[index], nrow = obj@M, - ncol = 1 ) - obj@par$sigma <- matrix( obj@par$sigma[index], nrow = obj@M, - ncol = 1 ) - obj@par$df <- matrix( obj@par$df[index], nrow = obj@M, - ncol = 1 ) - } else { - obj@par$mu <- obj@par$mu[index, ] - obj@par$sigma <- obj@par$sigma[index, ] - obj@par$df <- obj@par$df[index, ] - } - return( obj ) +".subseq.Student" <- function(obj, index) { + if (obj@model@K == 1) { + obj@par$mu <- matrix(obj@par$mu[index], + nrow = obj@M, + ncol = 1 + ) + obj@par$sigma <- matrix(obj@par$sigma[index], + nrow = obj@M, + ncol = 1 + ) + obj@par$df <- matrix(obj@par$df[index], + nrow = obj@M, + ncol = 1 + ) + } else { + obj@par$mu <- obj@par$mu[index, ] + obj@par$sigma <- obj@par$sigma[index, ] + obj@par$df <- obj@par$df[index, ] + } + return(obj) } -".subseq.Normult" <- function( obj, index ) -{ - if ( obj@model@K == 1 ) { - obj@par$mu <- matrix( obj@par$mu[index,], nrow = obj@M, - ncol = 1 ) - obj@par$sigma <- matrix( obj@par$sigma[index,], nrow = obj@M, - ncol = 1 ) - obj@par$sigmainv <- matrix( obj@par$sigmainv[index, ], nrow = obj@M, - ncol = 1 ) - } else { - obj@par$mu <- obj@par$mu[index,,] - obj@par$sigma <- obj@par$sigma[index,,] - obj@par$sigmainv <- obj@par$sigmainv[index,,] - } - return( obj ) +".subseq.Normult" <- function(obj, index) { + if (obj@model@K == 1) { + obj@par$mu <- matrix(obj@par$mu[index, ], + nrow = obj@M, + ncol = 1 + ) + obj@par$sigma <- matrix(obj@par$sigma[index, ], + nrow = obj@M, + ncol = 1 + ) + obj@par$sigmainv <- matrix(obj@par$sigmainv[index, ], + nrow = obj@M, + ncol = 1 + ) + } else { + obj@par$mu <- obj@par$mu[index, , ] + obj@par$sigma <- obj@par$sigma[index, , ] + obj@par$sigmainv <- obj@par$sigmainv[index, , ] + } + return(obj) } -".subseq.Studmult" <- function( obj, index ) -{ - if ( obj@model@K == 1 ) { - obj@par$mu <- obj@par$mu[index,] - obj@par$sigma <- obj@par$sigma[index,] - obj@par$sigmainv <- obj@par$sigmainv[index,] - obj@par$df <- obj@par$df[index] - } else { - obj@par$mu <- obj@par$mu[index,,] - obj@par$sigma <- obj@par$sigma[index,,] - obj@par$sigmainv <- obj@par$sigmainv[index,,] - obj@par$df <- obj@par$df[index,] - } - return( obj ) +".subseq.Studmult" <- function(obj, index) { + if (obj@model@K == 1) { + obj@par$mu <- obj@par$mu[index, ] + obj@par$sigma <- obj@par$sigma[index, ] + obj@par$sigmainv <- obj@par$sigmainv[index, ] + obj@par$df <- obj@par$df[index] + } else { + obj@par$mu <- obj@par$mu[index, , ] + obj@par$sigma <- obj@par$sigma[index, , ] + obj@par$sigmainv <- obj@par$sigmainv[index, , ] + obj@par$df <- obj@par$df[index, ] + } + return(obj) } ### Log swapElements ### Logic swapElements Poisson: This function permutes -### the elements in the MCMC sample for Poisson +### the elements in the MCMC sample for Poisson ### parameters by calling the C++-function 'swap_cc()'. -".swapElements.Poisson" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc' - obj@par$lambda <- swap_cc( obj@par$lambda, index ) - return(obj) +".swapElements.Poisson" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@par$lambda <- swap_cc(obj@par$lambda, index) + return(obj) } ### -".swapElements.Binomial" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc' - obj@par$p <- swap_cc( obj@par$p, index ) - return(obj) +".swapElements.Binomial" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@par$p <- swap_cc(obj@par$p, index) + return(obj) } -".swapElements.Exponential" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc' - obj@par$lambda <- swap_cc( obj@par$lambda, index ) - return( obj ) +".swapElements.Exponential" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@par$lambda <- swap_cc(obj@par$lambda, index) + return(obj) } -".swapElements.Normal" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc' - obj@par$mu <- swap_cc( obj@par$mu, index ) - obj@par$sigma <- swap_cc( obj@par$sigma, index ) - return( obj ) +".swapElements.Normal" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@par$mu <- swap_cc(obj@par$mu, index) + obj@par$sigma <- swap_cc(obj@par$sigma, index) + return(obj) } -".swapElements.Student" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc' - obj@par$mu <- swap_cc( obj@par$mu, index ) - obj@par$sigma <- swap_cc( obj@par$sigma, index ) - obj@par$df <- swap_cc( obj@par$df, index ) - return( obj ) +".swapElements.Student" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@par$mu <- swap_cc(obj@par$mu, index) + obj@par$sigma <- swap_cc(obj@par$sigma, index) + obj@par$df <- swap_cc(obj@par$df, index) + return(obj) } -".swapElements.Normult" <- function( obj, index) -{ - ## Rcpp::export 'swap_3d_cc' - obj@par$mu <- swap_3d_cc( obj@par$mu, index ) - obj@par$sigma <- swap_3d_cc( obj@par$sigma, index ) - obj@par$sigmainv <- swap_3d_cc( obj@par$sigma, index ) - return( obj ) +".swapElements.Normult" <- function(obj, index) { + ## Rcpp::export 'swap_3d_cc' + obj@par$mu <- swap_3d_cc(obj@par$mu, index) + obj@par$sigma <- swap_3d_cc(obj@par$sigma, index) + obj@par$sigmainv <- swap_3d_cc(obj@par$sigma, index) + return(obj) } -".swapElements.Studmult" <- function( obj, index) -{ - ## Rcpp::export 'swap_3d_cc' - obj@par$mu <- swap_3d_cc( obj@par$mu, index ) - obj@par$sigma <- swap_3d_cc( obj@par$sigma, index ) - obj@par$sigmainv <- swap_3d_cc( obj@par$sigma, index ) - obj@par$df <- swap_cc( obj@par$df, index ) - return( obj ) +".swapElements.Studmult" <- function(obj, index) { + ## Rcpp::export 'swap_3d_cc' + obj@par$mu <- swap_3d_cc(obj@par$mu, index) + obj@par$sigma <- swap_3d_cc(obj@par$sigma, index) + obj@par$sigmainv <- swap_3d_cc(obj@par$sigma, index) + obj@par$df <- swap_cc(obj@par$df, index) + return(obj) } ### Validity -### Validity subseq: The index given to 'subseq()' must +### Validity subseq: The index given to 'subseq()' must ### have dimension M x 1 and must contain logical values. -".subseq.valid.Arg" <- function(obj, index) -{ - if (dim(index)[1] != obj@M) { - stop("Argument 'index' has wrong dimension.") - } - if (typeof(index) != "logical") { - stop("Argument 'index' must be of type 'logical'.") - } +".subseq.valid.Arg" <- function(obj, index) { + if (dim(index)[1] != obj@M) { + stop("Argument 'index' has wrong dimension.") + } + if (typeof(index) != "logical") { + stop("Argument 'index' must be of type 'logical'.") + } } ### Validity swapElements: The index given to 'swapElements()' ### must have dimension M x K. It must be of type 'integer' ### and must be in the range 1, ..., K. -".swapElements.valid.Arg" <- function(obj, index) -{ - if (dim(index)[1] != obj@M || dim(index)[2] != obj@model@K) { - stop("Argument 'index' has wrong dimension.") - } - if (typeof(index) != "integer") { - stop("Argument 'index' must be of type 'integer'.") - } - if (!all(index > 0) || any(index > obj@model@K)) { - stop(paste("Elements in argument 'index' must be greater 0", - "and must not exceed its number of columns.", - sep = "")) - } +".swapElements.valid.Arg" <- function(obj, index) { + if (dim(index)[1] != obj@M || dim(index)[2] != obj@model@K) { + stop("Argument 'index' has wrong dimension.") + } + if (typeof(index) != "integer") { + stop("Argument 'index' must be of type 'integer'.") + } + if (!all(index > 0) || any(index > obj@model@K)) { + stop(paste("Elements in argument 'index' must be greater 0", + "and must not exceed its number of columns.", + sep = "" + )) + } } ### -------------------------------------------------------------- ### Extract ### -------------------------------------------------------------- -".extract.Normult" <- function( obj, index ) -{ - dist <- obj@model@dist - r <- obj@model@r - K <- obj@model@K - pars <- sapply( obj@par, function( x ) x[index,,] ) - weight <- as.array( obj@model@weight ) - .mcmcextract( dist = dist, K = K, r = r, par = pars, - weight = weight ) +".extract.Normult" <- function(obj, index) { + dist <- obj@model@dist + r <- obj@model@r + K <- obj@model@K + pars <- sapply(obj@par, function(x) x[index, , ]) + weight <- as.array(obj@model@weight) + .mcmcextract( + dist = dist, K = K, r = r, par = pars, + weight = weight + ) } ### -------------------------------------------------------------- ### Moments ### -------------------------------------------------------------- -".moments.Normult.Mcmcoutput" <- function( obj ) -{ - moments <- array( numeric(), dim = c( obj@M, r, ) ) - moments <- apply( seq( 1, obj@M ), 1, - function( i ) { mm <- extract( obj, i ); - moms <- moments( mm ) } ) +".moments.Normult.Mcmcoutput" <- function(obj) { + moments <- array(numeric(), dim = c(obj@M, r, )) + moments <- apply( + seq(1, obj@M), 1, + function(i) { + mm <- extract(obj, i) + moms <- moments(mm) + } + ) } diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index 4db213d..06d1ab0 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -16,184 +16,214 @@ # along with finmix. If not, see . .mcmcoutputfixhier <- setClass("mcmcoutputfixhier", - representation(hyper = "list"), - contains = c("mcmcoutputfix"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype(hyper = list()) + representation(hyper = "list"), + contains = c("mcmcoutputfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(hyper = list()) ) -setMethod("show", "mcmcoutputfixhier", - function(object) - { - cat("Object 'mcmcoutput'\n") - cat(" class :", class(object), - "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, - "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputfixhier", + function(object) { + cat("Object 'mcmcoutput'\n") + cat( + " class :", class(object), + "\n" + ) + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat( + " ranperm :", object@ranperm, + "\n" + ) + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputfixhier", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .traces.Poisson.Hier(x, dev) - } else if ( dist == "binomial" ) { - .traces.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - callNextMethod( x, dev ) - } else if ( dist == "normal" ) { - .traces.Normal.Hier( x, dev ) - } else if ( dist == "student" ) { - .traces.Student.Hier( x, dev ) - } else if ( dist == "normult" ) { - .traces.Normult.Hier( x, dev, col ) - } else if ( dist == "studmult" ) { - .traces.Studmult.Hier( x, dev, col ) - } - } - if (lik %in% c(1, 2)) { - ## log ## - .traces.Log(x, dev, col ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputfixhier", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .traces.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .traces.Binomial(x, dev) + } else if (dist == "exponential") { + callNextMethod(x, dev) + } else if (dist == "normal") { + .traces.Normal.Hier(x, dev) + } else if (dist == "student") { + .traces.Student.Hier(x, dev) + } else if (dist == "normult") { + .traces.Normult.Hier(x, dev, col) + } else if (dist == "studmult") { + .traces.Studmult.Hier(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .traces.Log(x, dev, col) + } + } ) -setMethod( "plotHist", signature( x = "mcmcoutputfixhier", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - dist <- x@model@dist - if( dist == "poisson" ) { - .hist.Poisson.Hier(x, dev) - } else if ( dist == "binomial" ) { - .hist.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .hist.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .hist.Normal.Hier( x, dev ) - } else if ( dist == "student" ) { - .hist.Student.Hier( x, dev ) - } else if ( dist == "normult" ) { - .hist.Normult.Hier( x, dev ) - } else if ( dist == "studmult" ) { - .hist.Studmult.Hier( x, dev ) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .hist.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .hist.Binomial(x, dev) + } else if (dist == "exponential") { + .hist.Exponential(x, dev) + } else if (dist == "normal") { + .hist.Normal.Hier(x, dev) + } else if (dist == "student") { + .hist.Student.Hier(x, dev) + } else if (dist == "normult") { + .hist.Normult.Hier(x, dev) + } else if (dist == "studmult") { + .hist.Studmult.Hier(x, dev) + } + } ) -setMethod( "plotDens", signature( x = "mcmcoutputfixhier", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - dist <- x@model@dist - if ( dist == "poisson" ) { - .dens.Poisson.Hier( x, dev ) - } else if ( dist == "binomial" ) { - .dens.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .dens.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .dens.Normal.Hier( x, dev ) - } else if ( dist == "student" ) { - .dens.Student.Hier( x, dev ) - } else if ( dist == "normult" ) { - .dens.Normult.Hier( x, dev ) - } else if ( dist == "studmult" ) { - .dens.Studmult.Hier( x, dev ) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .dens.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .dens.Binomial(x, dev) + } else if (dist == "exponential") { + .dens.Exponential(x, dev) + } else if (dist == "normal") { + .dens.Normal.Hier(x, dev) + } else if (dist == "student") { + .dens.Student.Hier(x, dev) + } else if (dist == "normult") { + .dens.Normult.Hier(x, dev) + } else if (dist == "studmult") { + .dens.Studmult.Hier(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputfix' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputfix' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens()' from 'mcmcoutputfix' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod( "subseq", signature( object = "mcmcoutputfixhier", - index = "array" ), - function( object, index ) - { - ## Call 'subseq()' from 'mcmcoutputfix' - callNextMethod( object, index ) - dist <- object@model@dist - ## hyper ## - if ( dist == "poisson" ) { - .subseq.Poisson.Hier( object, index ) - } else if ( dist == "normal" || dist == "student" ) { - .subseq.Normal.Hier( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .subseq.Norstud.Hier.( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .subseq.Normultstud.Hier( object, index ) - } - } +setMethod( + "subseq", signature( + object = "mcmcoutputfixhier", + index = "array" + ), + function(object, index) { + ## Call 'subseq()' from 'mcmcoutputfix' + callNextMethod(object, index) + dist <- object@model@dist + ## hyper ## + if (dist == "poisson") { + .subseq.Poisson.Hier(object, index) + } else if (dist == "normal" || dist == "student") { + .subseq.Normal.Hier(object, index) + } else if (dist %in% c("normal", "student")) { + .subseq.Norstud.Hier.(object, index) + } else if (dist %in% c("normult", "studmult")) { + .subseq.Normultstud.Hier(object, index) + } + } ) -setMethod( "swapElements", signature( object = "mcmcoutputfixhier", - index = "array" ), - function( object, index ) - { - ## Check arguments, TODO: .validObject ## - .swapElements.valid.Arg( object, index ) - if ( object@model@K == 1 ) { - return( object ) - } else { - ## Call method 'swap()' from 'mcmcoutputfix' - callNextMethod( object, index ) - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputfixhier", + index = "array" + ), + function(object, index) { + ## Check arguments, TODO: .validObject ## + .swapElements.valid.Arg(object, index) + if (object@model@K == 1) { + return(object) + } else { + ## Call method 'swap()' from 'mcmcoutputfix' + callNextMethod(object, index) + } + } ) -setMethod( "getHyper", "mcmcoutputfixhier", - function( object ) - { - return( object@hyper ) - } +setMethod( + "getHyper", "mcmcoutputfixhier", + function(object) { + return(object@hyper) + } ) - + ## No setters for this object as it is not intended ## ## that users manipulate this object. ## @@ -205,668 +235,751 @@ setMethod( "getHyper", "mcmcoutputfixhier", ### Plot Traces ### Plot traces Poisson: Plots traces for each component ### parameter of a Poisson mixture and the hyper parameter 'b'. -".traces.Poisson.Hier" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K + 1 - if (.check.grDevice() && y) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@par$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = 0.6, line = 3) - } - b <- x@hyper$b - plot(b, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) +".traces.Poisson.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- K + 1 + if (.check.grDevice() && y) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@par$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = 0.6, line = 3 + ) + } + b <- x@hyper$b + plot(b, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } -".traces.Normal.Hier" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 2 * K + 1 - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@par$mu - sigma <- x@par$sigma - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - C <- x@hyper$C - plot( c, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 2, "C", cex = .6, line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Normal.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- 2 * K + 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@par$mu + sigma <- x@par$sigma + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + C <- x@hyper$C + plot(c, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext(side = 2, las = 2, "C", cex = .6, line = 3) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .traces.Student.Hier -### @description Plots traces for parameters of a univariate Student +### @description Plots traces for parameters of a univariate Student ### mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Student mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".traces.Student.Hier" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 3 * K + 1 - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@par$mu - sigma <- x@par$sigma - df <- x@par$df - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( df[, k], type = "l", axes = F, - col = "gray40", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( nu[k = .( k )]), - cex = .6, line = 3 ) - } - C <- x@hyper$C - plot( C, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, "C", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Student.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- 3 * K + 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@par$mu + sigma <- x@par$sigma + df <- x@par$df + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(df[, k], + type = "l", axes = F, + col = "gray40", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(nu[k = .(k)]), + cex = .6, line = 3 + ) + } + C <- x@hyper$C + plot(C, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, "C", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -"traces.Normult.Hier" <- function( x, dev, col ) -{ - .traces.Normult( x, dev, col ) - r <- x@model@r - K <- x@model@K - C <- x@hyper$C - C.trace <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( C[i,] ) ) ) ) - C.logdet <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( C[i,] ) ) ) ) - # C traces - mmax <- max( C.trace ) - mmin <- min( C.trace ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Hyperparameters" ) - } - par( mfrow = c( 2, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - plot( C.trace, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr(C) ), - cex = .6, line = 3 ) - plot( C.logdet, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - name <- vector( "character", K ) - mtext( side = 2, las = 2, bquote( log(det(C))), - cex = .6, line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +"traces.Normult.Hier" <- function(x, dev, col) { + .traces.Normult(x, dev, col) + r <- x@model@r + K <- x@model@K + C <- x@hyper$C + C.trace <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(C[i, ]))) + ) + C.logdet <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(C[i, ]))) + ) + # C traces + mmax <- max(C.trace) + mmin <- min(C.trace) + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Hyperparameters") + } + par( + mfrow = c(2, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + plot(C.trace, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(C)), + cex = .6, line = 3 + ) + plot(C.logdet, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + name <- vector("character", K) + mtext( + side = 2, las = 2, bquote(log(det(C))), + cex = .6, line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".traces.Studmult.Hier" <- function( x, dev, col ) -{ - .traces.Studmult( x, dev, col ) - r <- x@model@r - K <- x@model@K - C <- x@hyper$C - C.trace <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( C[i,] ) ) ) ) - C.logdet <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( C[i,] ) ) ) ) - - # C traces - mmax <- max( C.trace ) - mmin <- min( C.trace ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Hyperparameters" ) - } - par( mfrow = c( 2, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - plot( C.trace, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr(C) ), - cex = .6, line = 3 ) - plot( C.logdet, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( log(det(C))), - cex = .6, line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".traces.Studmult.Hier" <- function(x, dev, col) { + .traces.Studmult(x, dev, col) + r <- x@model@r + K <- x@model@K + C <- x@hyper$C + C.trace <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(C[i, ]))) + ) + C.logdet <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(C[i, ]))) + ) + + # C traces + mmax <- max(C.trace) + mmin <- min(C.trace) + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Hyperparameters") + } + par( + mfrow = c(2, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + plot(C.trace, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(C)), + cex = .6, line = 3 + ) + plot(C.logdet, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(log(det(C))), + cex = .6, line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### Plot Histograms ### Plot hist Poisson: Plots histograms for each component ### parameter and the hyper parameter 'b'. -".hist.Poisson.Hier" <- function(x, dev) -{ - K <- x@model@K +".hist.Poisson.Hier" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + lambda <- x@par$lambda + b <- x@hyper$b + vars <- cbind(lambda, b) + if (K == 1) { + lab.names <- list(bquote(lambda), "b") + .symmetric.Hist(vars, lab.names) + } else { + lab.names <- vector("list", K + 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + lab.names[[K + 1]] <- "b" + .symmetric.Hist(vars, lab.names) + } +} + +".hist.Normal.Hier" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + C <- x@hyper$C + if (K == 1) { if (.check.grDevice() && dev) { - dev.new(title = "Histograms") + dev.new(title = "Histogram Mu") } - lambda <- x@par$lambda - b <- x@hyper$b - vars <- cbind(lambda, b) - if (K == 1) { - lab.names <- list(bquote(lambda), "b") - .symmetric.Hist(vars, lab.names) - } else { - lab.names <- vector("list", K + 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - lab.names[[K + 1]] <- "b" - .symmetric.Hist(vars, lab.names) + .symmetric.Hist(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Sigma") + } + .symmetric.Hist(sigma, list(bquote(sigma))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Mu") } + .symmetric.Hist(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Sigma") + } + .symmetric.Hist(sigma, sigma.lab.names) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Hyperparameter C") + } + .symmetric.Hist(C, "C") } -".hist.Normal.Hier" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - C <- x@hyper$C - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Mu" ) - } - .symmetric.Hist( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Sigma" ) - } - .symmetric.Hist( sigma, list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Mu" ) - } - .symmetric.Hist( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Sigma" ) - } - .symmetric.Hist( sigma, sigma.lab.names ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Hyperparameter C" ) - } - .symmetric.Hist( C, "C" ) +".hist.Student.Hier" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + C <- x@hyper$C + if (K == 1) { + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Mu") + } + .symmetric.Hist(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Sigma") + } + .symmetric.Hist(sigma, list(bquote(sigma))) + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Degrees of Freedom") + } + .symmetric.Hist(degf, list(bquote(nu))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + degf.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + degf.lab.names[[k]] <- bquote(nu[.(k)]) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Mu") + } + .symmetric.Hist(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Sigma") + } + .symmetric.Hist(sigma, sigma.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Degrees of Freedom") + } + .symmetric.Hist(degf, degf.lab.names) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Hyperparameter C") + } + .symmetric.Hist(C, "C") } -".hist.Student.Hier" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - C <- x@hyper$C - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Mu" ) - } - .symmetric.Hist( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Sigma" ) - } - .symmetric.Hist( sigma, list( bquote( sigma ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Degrees of Freedom" ) - } - .symmetric.Hist( degf, list( bquote( nu ) ) ) +".hist.Normult.Hier" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + logdetC <- sapply(seq(1, x@M), function(i) log(det(qinmatr(x@hyper$C[i, ])))) + trC <- sapply(seq(1, x@M), function(i) sum(diag(qinmatr(x@hyper$C[i, ])))) + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], list(bquote(sigma))) } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Mu" ) - } - .symmetric.Hist( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Sigma" ) - } - .symmetric.Hist( sigma, sigma.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Degrees of Freedom" ) - } - .symmetric.Hist( degf, degf.lab.names ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Hyperparameter C" ) - } - .symmetric.Hist( C, "C" ) -} - -".hist.Normult.Hier" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - logdetC <- sapply( seq( 1, x@M ), function( i ) log( det( qinmatr( x@hyper$C[i, ] ) ) ) ) - trC <- sapply( seq( 1, x@M ), function( i ) sum( diag( qinmatr( x@hyper$C[i, ] ) ) ) ) - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], sigma.lab.names ) - } - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Hyperparameter C" ) - } - C.lab.names <- vector( "list", 2 ) - C.lab.names[[1]] <- "log(det(C))" - C.lab.names[[2]] <- "tr(C)" - .symmetric.Hist( cbind( logdetC, trC ), C.lab.names ) + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], sigma.lab.names) + } + } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Hyperparameter C") + } + C.lab.names <- vector("list", 2) + C.lab.names[[1]] <- "log(det(C))" + C.lab.names[[2]] <- "tr(C)" + .symmetric.Hist(cbind(logdetC, trC), C.lab.names) } -".hist.Studmult.Hier" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - logdetC <- sapply( seq( 1, x@M ), function( i ) log( det( qinmatr( x@hyper$C[i, ] ) ) ) ) - trC <- sapply( seq( 1, x@M ), function( i ) sum( diag( qinmatr( x@hyper$C[i, ] ) ) ) ) - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], list( bquote( sigma ) ) ) - - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( sigma[, rr,], sigma.lab.names ) - } - } - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Hist( degf[, rr,], list( bquote( nu ) ) ) +".hist.Studmult.Hier" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + logdetC <- sapply(seq(1, x@M), function(i) log(det(qinmatr(x@hyper$C[i, ])))) + trC <- sapply(seq(1, x@M), function(i) sum(diag(qinmatr(x@hyper$C[i, ])))) + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], list(bquote(sigma))) } else { - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Histograms Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Hist( degf[, rr,], degf.lab.names ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histograms Hyperparameter C" ) - } - C.lab.names <- vector( "list", 2 ) - C.lab.names[[1]] <- "log(det(C))" - C.lab.names[[2]] <- "tr(C)" - .symmetric.Hist( cbind( logdetC, trC ), C.lab.names ) - + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(sigma[, rr, ], sigma.lab.names) + } + } + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Hist(degf[, rr, ], list(bquote(nu))) + } else { + degf.lab.names <- vector("list", K) + for (k in 1:K) { + degf.lab.names[[k]] <- bquote(nu[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Histograms Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Hist(degf[, rr, ], degf.lab.names) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histograms Hyperparameter C") + } + C.lab.names <- vector("list", 2) + C.lab.names[[1]] <- "log(det(C))" + C.lab.names[[2]] <- "tr(C)" + .symmetric.Hist(cbind(logdetC, trC), C.lab.names) } ### Plot Densities ### Plot Dens Poisson Hier: Plots Kernel densities for each ### component parameter and the hyper parameter 'b'. -".dens.Poisson.Hier" <- function(x, dev) -{ - K <- x@model@K +".dens.Poisson.Hier" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new("Densities") + } + lambda <- x@par$lambda + b <- x@hyper$b + vars <- cbind(lambda, b) + if (K == 1) { + lab.names <- list(bquote(lambda), "b") + .symmetric.Dens(vars, lab.names) + } else { + lab.names <- vector("list", K + 1) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + lab.names[[K + 1]] <- "b" + .symmetric.Dens(vars, lab.names) + } +} + +".dens.Normal.Hier" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + C <- x@hyper$C + if (K == 1) { if (.check.grDevice() && dev) { - dev.new("Densities") + dev.new(title = "Density Mu") } - lambda <- x@par$lambda - b <- x@hyper$b - vars <- cbind(lambda, b) - if (K == 1) { - lab.names <- list(bquote(lambda), "b") - .symmetric.Dens(vars, lab.names) - } else { - lab.names <- vector("list", K + 1) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - lab.names[[K + 1]] <- "b" - .symmetric.Dens(vars, lab.names) + .symmetric.Dens(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Density Sigma") + } + .symmetric.Dens(sigma, list(bquote(sigma))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Mu") + } + .symmetric.Dens(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Densities Sigma") + } + .symmetric.Dens(sigma, sigma.lab.names) + } + if (.check.grDevice() && dev) { + dev.new(title = "Histogram Hyperparameter C") + } + .symmetric.Dens(C, "C") } -".dens.Normal.Hier" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - C <- x@hyper$C - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Mu" ) - } - .symmetric.Dens( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Sigma" ) - } - .symmetric.Dens( sigma, list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Mu" ) - } - .symmetric.Dens( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Sigma" ) - } - .symmetric.Dens( sigma, sigma.lab.names ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Histogram Hyperparameter C" ) - } - .symmetric.Dens( C, "C" ) +".dens.Student.Hier" <- function(x, dev) { + K <- x@model@K + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + C <- x@hyper$C + if (K == 1) { + if (.check.grDevice() && dev) { + dev.new(title = "Density Mu") + } + .symmetric.Dens(mu, list(bquote(mu))) + if (.check.grDevice() && dev) { + dev.new(title = "Density Sigma") + } + .symmetric.Dens(sigma, list(bquote(sigma))) + if (.check.grDevice() && dev) { + dev.new(title = "Density Degrees of Freedom") + } + .symmetric.Dens(degf, list(bquote(nu))) + } else { + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + degf.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + degf.lab.names[[k]] <- bquote(nu[.(k)]) + } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Mu") + } + .symmetric.Dens(mu, mu.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Densities Sigma") + } + .symmetric.Dens(sigma, sigma.lab.names) + if (.check.grDevice() && dev) { + dev.new(title = "Densities Degrees of Freedom") + } + .symmetric.Dens(degf, degf.lab.names) + } + if (.check.grDevice() && dev) { + dev.new(title = "Density Hyperparameter C") + } + .symmetric.Dens(C, "C") } -".dens.Student.Hier" <- function( x, dev ) -{ - K <- x@model@K - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - C <- x@hyper$C - if ( K == 1 ) { - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Mu" ) - } - .symmetric.Dens( mu, list( bquote( mu ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Sigma" ) - } - .symmetric.Dens( sigma, list( bquote( sigma ) ) ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Degrees of Freedom" ) - } - .symmetric.Dens( degf, list( bquote( nu ) ) ) +"dens.Normult.Hier" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + logdetC <- sapply(seq(1, x@M), function(i) log(det(qinmatr(x@hyper$C[i, ])))) + trC <- sapply(seq(1, x@M), function(i) sum(diag(qinmatr(x@hyper$C[i, ])))) + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], list(bquote(sigma))) } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Mu" ) - } - .symmetric.Dens( mu, mu.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Sigma" ) - } - .symmetric.Dens( sigma, sigma.lab.names ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Degrees of Freedom" ) - } - .symmetric.Dens( degf, degf.lab.names ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Density Hyperparameter C" ) - } - .symmetric.Dens( C, "C" ) -} - -"dens.Normult.Hier" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - logdetC <- sapply( seq( 1, x@M ), function( i ) log( det( qinmatr( x@hyper$C[i, ] ) ) ) ) - trC <- sapply( seq( 1, x@M ), function( i ) sum( diag( qinmatr( x@hyper$C[i, ] ) ) ) ) - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], list( bquote( sigma ) ) ) - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], sigma.lab.names ) - } - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Hyperparameter C" ) - } - C.lab.names <- vector( "list", 2 ) - C.lab.names[[1]] <- "log(det(C))" - C.lab.names[[2]] <- "tr(C)" - .symmetric.Dens( cbind( logdetC, trC ), C.lab.names ) + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], sigma.lab.names) + } + } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Hyperparameter C") + } + C.lab.names <- vector("list", 2) + C.lab.names[[1]] <- "log(det(C))" + C.lab.names[[2]] <- "tr(C)" + .symmetric.Dens(cbind(logdetC, trC), C.lab.names) } -"dens.Studmult.Hier" <- function( x, dev ) -{ - K <- x@model@K - r <- x@model@r - mu <- x@par$mu - sigma <- x@par$sigma - degf <- x@par$df - logdetC <- sapply( seq( 1, x@M ), function( i ) log( det( qinmatr( x@hyper$C[i, ] ) ) ) ) - trC <- sapply( seq( 1, x@M ), function( i ) sum( diag( qinmatr( x@hyper$C[i, ] ) ) ) ) - for ( rr in 1:r ) { - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], list( bquote( mu ) ) ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], list( bquote( sigma ) ) ) - - } else { - mu.lab.names <- vector( "list", K ) - sigma.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - mu.lab.names[[k]] <- bquote( mu[.( k )] ) - sigma.lab.names[[k]] <- bquote( sigma[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Mu", sep = "" ) ) - } - .symmetric.Dens( mu[, rr,], mu.lab.names ) - if (.check.grDevice() & dev ) { - dev.new( title = paste( "Densities Feature ", rr, - " Sigma", sep = "" ) ) - } - .symmetric.Dens( sigma[, rr,], sigma.lab.names ) - } - } - if ( K == 1 ) { - if (.check.grDevice() & dev ) { - dev.new( title = "Density Degrees of Freedom" ) - } - .symmetric.Dens( degf[, rr,], list( bquote( nu ) ) ) +"dens.Studmult.Hier" <- function(x, dev) { + K <- x@model@K + r <- x@model@r + mu <- x@par$mu + sigma <- x@par$sigma + degf <- x@par$df + logdetC <- sapply(seq(1, x@M), function(i) log(det(qinmatr(x@hyper$C[i, ])))) + trC <- sapply(seq(1, x@M), function(i) sum(diag(qinmatr(x@hyper$C[i, ])))) + for (rr in 1:r) { + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], list(bquote(mu))) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], list(bquote(sigma))) } else { - degf.lab.names <- vector( "list", K ) - for ( k in 1:K ) { - degf.lab.names[[k]] <- bquote( nu[.( k )] ) - } - if (.check.grDevice() & dev ) { - dev.new( title = "Densities Degrees of Freedom" ) - } - .symmetric.Dens( degf[, rr,], degf.lab.names ) - } - if ( .check.grDevice() && dev ) { - dev.new( title = "Densities Hyperparameter C" ) - } - C.lab.names <- vector( "list", 2 ) - C.lab.names[[1]] <- "log(det(C))" - C.lab.names[[2]] <- "tr(C)" - .symmetric.Dens( cbind( logdetC, trC ), C.lab.names ) - + mu.lab.names <- vector("list", K) + sigma.lab.names <- vector("list", K) + for (k in 1:K) { + mu.lab.names[[k]] <- bquote(mu[.(k)]) + sigma.lab.names[[k]] <- bquote(sigma[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Mu", + sep = "" + )) + } + .symmetric.Dens(mu[, rr, ], mu.lab.names) + if (.check.grDevice() & dev) { + dev.new(title = paste("Densities Feature ", rr, + " Sigma", + sep = "" + )) + } + .symmetric.Dens(sigma[, rr, ], sigma.lab.names) + } + } + if (K == 1) { + if (.check.grDevice() & dev) { + dev.new(title = "Density Degrees of Freedom") + } + .symmetric.Dens(degf[, rr, ], list(bquote(nu))) + } else { + degf.lab.names <- vector("list", K) + for (k in 1:K) { + degf.lab.names[[k]] <- bquote(nu[.(k)]) + } + if (.check.grDevice() & dev) { + dev.new(title = "Densities Degrees of Freedom") + } + .symmetric.Dens(degf[, rr, ], degf.lab.names) + } + if (.check.grDevice() && dev) { + dev.new(title = "Densities Hyperparameter C") + } + C.lab.names <- vector("list", 2) + C.lab.names[[1]] <- "log(det(C))" + C.lab.names[[2]] <- "tr(C)" + .symmetric.Dens(cbind(logdetC, trC), C.lab.names) } ### Logic ### Logic subseq Hier: Creates a subsequence for the sample ### of the Poisson hyper parameter 'b'. -".subseq.Poisson.Hier" <- function( obj, index ) -{ - obj@hyper$b <- array( obj@hyper$b[index], - dim = c( obj@M, 1 ) ) - return( obj ) +".subseq.Poisson.Hier" <- function(obj, index) { + obj@hyper$b <- array(obj@hyper$b[index], + dim = c(obj@M, 1) + ) + return(obj) } -".subseq.Norstud.Hier" <- function( obj, index ) -{ - obj@hyper$C <- array( obj@hyper$C[index], - dim = c( obj@M, 1 ) ) - return( obj ) +".subseq.Norstud.Hier" <- function(obj, index) { + obj@hyper$C <- array(obj@hyper$C[index], + dim = c(obj@M, 1) + ) + return(obj) } -".subseq.Normultstud.Hier" <- function( obj, index ) -{ - obj@hyper$C <- array( obj@hyper$C[index, ], - dim = c( obj@M, obj@model@K ) ) - return( obj ) +".subseq.Normultstud.Hier" <- function(obj, index) { + obj@hyper$C <- array(obj@hyper$C[index, ], + dim = c(obj@M, obj@model@K) + ) + return(obj) } diff --git a/R/mcmcoutputfixhierpost.R b/R/mcmcoutputfixhierpost.R index 997c466..cc69758 100644 --- a/R/mcmcoutputfixhierpost.R +++ b/R/mcmcoutputfixhierpost.R @@ -15,137 +15,164 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputfixhierpost <- setClass( "mcmcoutputfixhierpost", - representation( post = "list" ), - contains = c("mcmcoutputfixhier" ), - validity = function( object ) - { - ## else: OK - TRUE - }, - prototype( post = list() ) +.mcmcoutputfixhierpost <- setClass("mcmcoutputfixhierpost", + representation(post = "list"), + contains = c("mcmcoutputfixhier"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(post = list()) ) -setMethod("show", "mcmcoutputfixhierpost", - function(object) - { - cat("Object 'mcmcoutput'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputfixhierpost", + function(object) { + cat("Object 'mcmcoutput'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputfixhierpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function(x, dev = TRUE, lik = 1, col = FALSE, ...) - { - ## Call method 'plot()' from 'mcmcoutputfixhier' - callNextMethod(x, dev, lik, col, ...) - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputfixhierpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + ## Call method 'plot()' from 'mcmcoutputfixhier' + callNextMethod(x, dev, lik, col, ...) + } ) -setMethod( "plotHist", signature( x = "mcmcoutputfixhierpost", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - ## Call 'plotHist()' from 'mcmcoutputfixhier' - callNextMethod( x, dev, ... ) - } +setMethod( + "plotHist", signature( + x = "mcmcoutputfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotHist()' from 'mcmcoutputfixhier' + callNextMethod(x, dev, ...) + } ) -setMethod( "plotDens", signature( x = "mcmcoutputfixhierpost", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - ## Call 'plotDens()' from 'mcmcoutputfixhier' - callNextMethod( x, dev, ... ) - } +setMethod( + "plotDens", signature( + x = "mcmcoutputfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotDens()' from 'mcmcoutputfixhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputfixhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputfixhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputfixhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputfixhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens' from 'mcmcoutputfixhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens' from 'mcmcoutputfixhier' + callNextMethod(x, dev, ...) + } ) -setMethod( "subseq", signature( object = "mcmcoutputfixhierpost", - index = "array" ), - function( object, index ) - { - ## TODO: Check arguments via .validObject ## - dist <- object@model@dist - ## Call 'subseq()' from 'mcmcoutputfixhier' - callNextMethod( object, index ) - ## post ## - if ( dist == "poisson" ) { - .subseq.Poisson.Post(object, index) - } else if ( dist == "binomial" ) { - .subseq.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .subseq.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .subseq.Normultstud.Mcmcoutputfixpost( object, index ) - } - } +setMethod( + "subseq", signature( + object = "mcmcoutputfixhierpost", + index = "array" + ), + function(object, index) { + ## TODO: Check arguments via .validObject ## + dist <- object@model@dist + ## Call 'subseq()' from 'mcmcoutputfixhier' + callNextMethod(object, index) + ## post ## + if (dist == "poisson") { + .subseq.Poisson.Post(object, index) + } else if (dist == "binomial") { + .subseq.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .subseq.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .subseq.Normultstud.Mcmcoutputfixpost(object, index) + } + } ) -setMethod("swapElements", signature( object = "mcmcoutputfixhierpost", - index = "array" ), - function(object, index ) - { - if ( object@model@K == 1 ) { - return( object ) - } else { - ## Check arguments, TODO: .validObject ## - dist <- object@model@dist - ## Call 'swapElements()' from 'mcmcoutputfixhier' - object <- callNextMethod( object, index ) - if ( dist == "poisson" ) { - .swapElements.Poisson.Post( object, index ) - } else if ( dist == "binomial" ) { - .swapElements.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .swapElements.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .swapElements.Normultstud.Mcmcoutputfixpost( object, index ) - } - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputfixhierpost", + index = "array" + ), + function(object, index) { + if (object@model@K == 1) { + return(object) + } else { + ## Check arguments, TODO: .validObject ## + dist <- object@model@dist + ## Call 'swapElements()' from 'mcmcoutputfixhier' + object <- callNextMethod(object, index) + if (dist == "poisson") { + .swapElements.Poisson.Post(object, index) + } else if (dist == "binomial") { + .swapElements.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .swapElements.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .swapElements.Normultstud.Mcmcoutputfixpost(object, index) + } + } + } ) diff --git a/R/mcmcoutputfixpost.R b/R/mcmcoutputfixpost.R index 224ef31..ec2f4e0 100644 --- a/R/mcmcoutputfixpost.R +++ b/R/mcmcoutputfixpost.R @@ -15,242 +15,268 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputfixpost <- setClass( "mcmcoutputfixpost", - representation( post = "list" ), - contains = c( "mcmcoutputfix" ), - validity = function( object ) { - ## else: OK - TRUE - }, - prototype( post = list() ) +.mcmcoutputfixpost <- setClass("mcmcoutputfixpost", + representation(post = "list"), + contains = c("mcmcoutputfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(post = list()) ) -setMethod("show", "mcmcoutputfixpost", - function(object) - { - cat("Object 'mcmcoutputfixpost\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputfixpost", + function(object) { + cat("Object 'mcmcoutputfixpost\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputfixpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function(x, dev = TRUE, lik = 1, col = FALSE, ...) { - ## Call 'plot()' from 'mcmcoutputfix - callNextMethod(x, dev, lik, col, ...) - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputfixpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + ## Call 'plot()' from 'mcmcoutputfix + callNextMethod(x, dev, lik, col, ...) + } ) -setMethod( "plotHist", signature( x = "mcmcoutputfixpost", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - ## Call 'plotHist()' from 'mcmcoutputfix' - callNextMethod( x, dev, ... ) - } +setMethod( + "plotHist", signature( + x = "mcmcoutputfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotHist()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod( "plotDens", signature( x = "mcmcoutputfixpost", - dev = "ANY" ), - function( x, dev = TRUE, ... ) - { - ## Call 'plotDens()' from 'mcmcoutputfix' - callNextMethod( x, dev, ... ) - } +setMethod( + "plotDens", signature( + x = "mcmcoutputfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotDens()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputfix' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputfix' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens()' from 'mcmcoutputfix' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens()' from 'mcmcoutputfix' + callNextMethod(x, dev, ...) + } ) -setMethod( "subseq", signature( object = "mcmcoutputfixpost", - index = "array" ), - function( object, index ) - { - ## Call 'subseq()' from 'mcmcoutputfix' - callNextMethod( object, index ) - dist <- object@model@dist - ## post ## - if ( dist == "poisson" ) { - .subseq.Poisson.Post( object, index ) - } else if ( dist == "binomial" ) { - .subseq.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .subseq.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .subseq.Normultstud.Mcmcoutputfixpost( object, index ) - } - } +setMethod( + "subseq", signature( + object = "mcmcoutputfixpost", + index = "array" + ), + function(object, index) { + ## Call 'subseq()' from 'mcmcoutputfix' + callNextMethod(object, index) + dist <- object@model@dist + ## post ## + if (dist == "poisson") { + .subseq.Poisson.Post(object, index) + } else if (dist == "binomial") { + .subseq.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .subseq.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .subseq.Normultstud.Mcmcoutputfixpost(object, index) + } + } ) -setMethod( "swapElements", signature( object = "mcmcoutputfixpost", - index = "array"), - function( object, index ) - { - if ( object@model@K == 1 ) { - return( object ) - } else { - ## Call method 'swapiElements()' from 'mcmcoutputfix' - object <- callNextMethod() - dist <- object@model@dist - if ( dist == "poisson" ) { - .swapElements.Poisson(object, index) - } else if ( dist == "binomial" ) { - .swapElements.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .swapElements.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .swapElements.Normultstud.Mcmcoutputfixpost( object, index ) - } - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputfixpost", + index = "array" + ), + function(object, index) { + if (object@model@K == 1) { + return(object) + } else { + ## Call method 'swapiElements()' from 'mcmcoutputfix' + object <- callNextMethod() + dist <- object@model@dist + if (dist == "poisson") { + .swapElements.Poisson(object, index) + } else if (dist == "binomial") { + .swapElements.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .swapElements.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .swapElements.Normultstud.Mcmcoutputfixpost(object, index) + } + } + } ) -setMethod( "getPost", "mcmcoutputfixpost", - function( object ) - { - return( object@post ) - } +setMethod( + "getPost", "mcmcoutputfixpost", + function(object) { + return(object@post) + } ) ## No setters as users are not intended to manipulate ## ## this object. ## -".subseq.Poisson.Post" <- function(obj, index) -{ - if (obj@model@K == 1) { - obj@post$par$a <- array(obj@post$par$a[index], - dim = c(obj@M, 1)) - obj@post$par$b <- array(obj@post$par$b[index], - dim = c(obj@M, 1)) - } else { - obj@post$par$a <- obj@post$par$a[index, ] - obj@post$par$b <- obj@post$par$b[index, ] - } - return(obj) +".subseq.Poisson.Post" <- function(obj, index) { + if (obj@model@K == 1) { + obj@post$par$a <- array(obj@post$par$a[index], + dim = c(obj@M, 1) + ) + obj@post$par$b <- array(obj@post$par$b[index], + dim = c(obj@M, 1) + ) + } else { + obj@post$par$a <- obj@post$par$a[index, ] + obj@post$par$b <- obj@post$par$b[index, ] + } + return(obj) } -".swapElements.Poisson.Post" <- function(obj, index) -{ - ## Rcpp::export 'swap_cc' - obj@post$par$a <- swap_cc(obj@post$par$a, index) - obj@post$par$b <- swap_cc(obj@post$par$b, index) - return(obj) +".swapElements.Poisson.Post" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@post$par$a <- swap_cc(obj@post$par$a, index) + obj@post$par$b <- swap_cc(obj@post$par$b, index) + return(obj) } -".subseq.Binomial.Mcmcoutputfixpost" <- function(obj, index) - -{ - if (obj@model@K == 1) { - obj@post$par$a <- array(obj@post$par$a[index], - dim = c(obj@M, 1)) - obj@post$par$b <- array(obj@post$par$b[index], - dim = c(obj@M, 1)) - } else { - obj@post$par$a <- obj@post$par$a[index, ] - obj@post$par$b <- obj@post$par$b[index, ] - } - return(obj) +".subseq.Binomial.Mcmcoutputfixpost" <- function(obj, index) { + if (obj@model@K == 1) { + obj@post$par$a <- array(obj@post$par$a[index], + dim = c(obj@M, 1) + ) + obj@post$par$b <- array(obj@post$par$b[index], + dim = c(obj@M, 1) + ) + } else { + obj@post$par$a <- obj@post$par$a[index, ] + obj@post$par$b <- obj@post$par$b[index, ] + } + return(obj) } -".swapElements.Binomial.Mcmcoutputfixpost" <- function(obj, index) -{ - ## Rcpp::export 'swap_cc' - obj@post$par$a <- swap_cc(obj@post$par$a, index) - obj@post$par$b <- swap_cc(obj@post$par$b, index) - return(obj) +".swapElements.Binomial.Mcmcoutputfixpost" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@post$par$a <- swap_cc(obj@post$par$a, index) + obj@post$par$b <- swap_cc(obj@post$par$b, index) + return(obj) } -".subseq.Norstud.Mcmcoutputfixpost" <- function( obj, index ) -{ - if ( obj@model@K == 1 ) { - obj@post$par$mu$b <- array( obj@post$par$mu$b[index], - dim = c( obj@M, 1 ) ) - obj@post$par$mu$B <- array( obj@post$par$mu$B[index], - dim = c( obj@M, 1 ) ) - obj@post$par$sigma$c <- array( obj@post$par$sigma$c[index], - dim = c( obj@M, 1 ) ) - obj@post$par$sigma$C <- array( obj@post$par$sigma$C[index], - dim = c( obj@M, 1 ) ) - } else { - obj@post$par$mu$b <- obj@post$par$mu$b[index, ] - obj@post$par$mu$b <- obj@post$par$mu$B[index, ] - obj@post$par$sigma$c <- obj@post$par$sigma$c[index, ] - obj@post$par$sigma$C <- obj@post$par$sigma$C[index, ] - } - return( obj ) +".subseq.Norstud.Mcmcoutputfixpost" <- function(obj, index) { + if (obj@model@K == 1) { + obj@post$par$mu$b <- array(obj@post$par$mu$b[index], + dim = c(obj@M, 1) + ) + obj@post$par$mu$B <- array(obj@post$par$mu$B[index], + dim = c(obj@M, 1) + ) + obj@post$par$sigma$c <- array(obj@post$par$sigma$c[index], + dim = c(obj@M, 1) + ) + obj@post$par$sigma$C <- array(obj@post$par$sigma$C[index], + dim = c(obj@M, 1) + ) + } else { + obj@post$par$mu$b <- obj@post$par$mu$b[index, ] + obj@post$par$mu$b <- obj@post$par$mu$B[index, ] + obj@post$par$sigma$c <- obj@post$par$sigma$c[index, ] + obj@post$par$sigma$C <- obj@post$par$sigma$C[index, ] + } + return(obj) } -".swapElements.Norstud.Mcmcoutputfixpost" <- function( obj, index ) -{ - ## Rcpp::export 'swap_cc' - obj@post$par$mu$b <- swap_cc( obj@post$par$mu$b, index ) - obj@post$par$mu$B <- swap_cc( obj@post$par$mu$B, index ) - obj@post$par$sigma$c <- swap_cc( obj@post$par$sigma$c, index ) - obj@post$par$sigma$C <- swap_cc( obj@post$par$sigma$C, index ) - return( obj ) +".swapElements.Norstud.Mcmcoutputfixpost" <- function(obj, index) { + ## Rcpp::export 'swap_cc' + obj@post$par$mu$b <- swap_cc(obj@post$par$mu$b, index) + obj@post$par$mu$B <- swap_cc(obj@post$par$mu$B, index) + obj@post$par$sigma$c <- swap_cc(obj@post$par$sigma$c, index) + obj@post$par$sigma$C <- swap_cc(obj@post$par$sigma$C, index) + return(obj) } -".subseq.Normultstud.Mcmcoutputfixpost" <- function( obj, index ) -{ - if( obj@model@K == 1 ) { - obj@post$par$mu$b <- obj@post$par$mu$b[index,] - obj@post$par$mu$B <- obj@post$par$mu$B[index,] - obj@post$par$sigma$c <- obj@post$par$sigma$c[index,] - obj@post$par$sigma$C <- obj@post$par$sigma$C[index,] - } else { - obj@post$par$mu$b <- obj@post$par$mu$b[index,,] - obj@post$par$mu$B <- obj@post$par$mu$B[index,,] - obj@post$par$sigma$c <- obj@post$par$sigma$c[index,,] - obj@post$par$sigma$C <- obj@post$par$sigma$C[index,,] - } - return( obj ) +".subseq.Normultstud.Mcmcoutputfixpost" <- function(obj, index) { + if (obj@model@K == 1) { + obj@post$par$mu$b <- obj@post$par$mu$b[index, ] + obj@post$par$mu$B <- obj@post$par$mu$B[index, ] + obj@post$par$sigma$c <- obj@post$par$sigma$c[index, ] + obj@post$par$sigma$C <- obj@post$par$sigma$C[index, ] + } else { + obj@post$par$mu$b <- obj@post$par$mu$b[index, , ] + obj@post$par$mu$B <- obj@post$par$mu$B[index, , ] + obj@post$par$sigma$c <- obj@post$par$sigma$c[index, , ] + obj@post$par$sigma$C <- obj@post$par$sigma$C[index, , ] + } + return(obj) } -".swapElements.Normultstud.Mcmcoutputfixpost" <- function( obj, index ) -{ - ## Rcpp::export 'swap_3d_cc' - obj@post$par$mu$b <- swap_cc( obj@post$par$mu$b, index ) - obj@post$par$mu$B <- swap_3d_cc( obj@post$par$mu$B, index ) - obj@post$par$sigma$c <- swap_cc( obj@post$par$sigma$c, index ) - obj@post$par$sigma$C <- swap_3d_cc( obj@post$par$sigma$C, index ) - return( obj ) +".swapElements.Normultstud.Mcmcoutputfixpost" <- function(obj, index) { + ## Rcpp::export 'swap_3d_cc' + obj@post$par$mu$b <- swap_cc(obj@post$par$mu$b, index) + obj@post$par$mu$B <- swap_3d_cc(obj@post$par$mu$B, index) + obj@post$par$sigma$c <- swap_cc(obj@post$par$sigma$c, index) + obj@post$par$sigma$C <- swap_3d_cc(obj@post$par$sigma$C, index) + return(obj) } diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index 7a0cad4..ad58da0 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -16,166 +16,200 @@ # along with finmix. If not, see . .mcmcoutputhier <- setClass("mcmcoutputhier", - representation(hyper = "list"), - contains = c("mcmcoutputbase"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(hyper = list()) + representation(hyper = "list"), + contains = c("mcmcoutputbase"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(hyper = list()) ) -setMethod("show", "mcmcoutputhier", - function(object) - { - cat("Object 'mcmcoutput'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputhier", + function(object) { + cat("Object 'mcmcoutput'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputhier", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" || dist == "cond.poisson" ) { - .traces.Poisson.Base.Hier( x, dev ) - } else if ( dist == "binomial" ) { - .traces.Binomial.Base( x, dev ) - } else if ( dist == "exponential" ) { - .traces.Exponential.Base( x, dev ) - } else if ( dist == "normal" ) { - .traces.Normal.Hier( x, dev ) - .traces.Weights.Base( x, dev, col ) - } else if ( dist == "student" ) { - .traces.Student.Hier( x, dev ) - .traces.Weights.Base( x, dev, col ) - } else if ( dist == "normult" ) { - .traces.Normult.Hier( x, dev, col ) - .traces.Weights.Base( x, dev, col ) - } else if ( dist == "studmult" ) { - .traces.Studmult.Hier( x, dev, col ) - .traces.Weights.Base( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .traces.Log.Base( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputhier", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson" || dist == "cond.poisson") { + .traces.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .traces.Binomial.Base(x, dev) + } else if (dist == "exponential") { + .traces.Exponential.Base(x, dev) + } else if (dist == "normal") { + .traces.Normal.Hier(x, dev) + .traces.Weights.Base(x, dev, col) + } else if (dist == "student") { + .traces.Student.Hier(x, dev) + .traces.Weights.Base(x, dev, col) + } else if (dist == "normult") { + .traces.Normult.Hier(x, dev, col) + .traces.Weights.Base(x, dev, col) + } else if (dist == "studmult") { + .traces.Studmult.Hier(x, dev, col) + .traces.Weights.Base(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .traces.Log.Base(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .hist.Poisson.Base.Hier(x, dev) - } else if (dist == "binomial") { - .hist.Binomial.Base(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .hist.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .hist.Binomial.Base(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .dens.Poisson.Base.Hier(x, dev) - } else if (dist == "binomial") { - .dens.Binomial.Base(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .dens.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .dens.Binomial.Base(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod( "subseq", signature( object = "mcmcoutputhier", - index = "array" ), - function( object, index ) - { - ## Call 'subseq()' method from 'mcmcoutputfixhier' - as( object, "mcmcoutputbase" ) <- callNextMethod( object, index ) - dist <- object@model@dist - if ( dist == "poisson" ) { - .subseq.Poisson.Hier( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .subseq.Norstud.Hier( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .subseq.Normultstud.Hier( object, index ) - } - } +setMethod( + "subseq", signature( + object = "mcmcoutputhier", + index = "array" + ), + function(object, index) { + ## Call 'subseq()' method from 'mcmcoutputfixhier' + as(object, "mcmcoutputbase") <- callNextMethod(object, index) + dist <- object@model@dist + if (dist == "poisson") { + .subseq.Poisson.Hier(object, index) + } else if (dist %in% c("normal", "student")) { + .subseq.Norstud.Hier(object, index) + } else if (dist %in% c("normult", "studmult")) { + .subseq.Normultstud.Hier(object, index) + } + } ) -setMethod( "swapElements", signature( object = "mcmcoutputhier", - index = "array" ), - function( object, index ) - { - ## Check arguments, TODO: .validObject ## - ## Call method 'swapElements()' from 'mcmcoutputbase' - callNextMethod( object, index ) - } +setMethod( + "swapElements", signature( + object = "mcmcoutputhier", + index = "array" + ), + function(object, index) { + ## Check arguments, TODO: .validObject ## + ## Call method 'swapElements()' from 'mcmcoutputbase' + callNextMethod(object, index) + } ) -setMethod( "getHyper", "mcmcoutputhier", - function( object ) { - return( object@hyper ) - } +setMethod( + "getHyper", "mcmcoutputhier", + function(object) { + return(object@hyper) + } ) @@ -190,87 +224,95 @@ setMethod( "getHyper", "mcmcoutputhier", ### Plot traces Poisson: Plots the traces of the MCMC sample ### for the Poisson parameters, the weights and the hyper- ### parameter 'b'. -".traces.Poisson.Base.Hier" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K * 2 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@par$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = 0.6, line = 3) - } - weight <- x@weight - for (k in 1:(K - 1)) { - plot(weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(eta[k = .(k)]), - cex = 0.6, line = 3) - } - b <- x@hyper$b - plot(b, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "") +".traces.Poisson.Base.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@par$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = 0.6, line = 3 + ) + } + weight <- x@weight + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = 0.6, line = 3 + ) + } + b <- x@hyper$b + plot(b, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### Plot Histograms ### Plot Histograms Poisson: Plots histograms for ### the Poisson parameters the weights and the hyper- ### parameter b. -".hist.Poisson.Base.Hier" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms") - } - lambda <- x@par$lambda - weight <- x@weight - b <- x@hyper$b - vars <- cbind(lambda, weight[, seq(1, K - 1)], b) - lab.names <- vector("list", 2 * K) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in seq(K + 1, 2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - lab.names[[2 * K]] <- "b" - .symmetric.Hist(vars, lab.names) -} +".hist.Poisson.Base.Hier" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms") + } + lambda <- x@par$lambda + weight <- x@weight + b <- x@hyper$b + vars <- cbind(lambda, weight[, seq(1, K - 1)], b) + lab.names <- vector("list", 2 * K) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + lab.names[[2 * K]] <- "b" + .symmetric.Hist(vars, lab.names) +} ### Plot Densities ### Plot Densities Poisson: Plots Kernel densities for ### the Poisson parameters the weights and the hyper- ### parameter b. -".dens.Poisson.Base.Hier" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Densities") - } - lambda <- x@par$lambda - weight <- x@weight - b <- x@hyper$b - vars <- cbind(lambda, weight[, seq(1, K - 1)], b) - lab.names <- vector("list", 2 * K) - for (k in seq(1, K)) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in seq(K + 1, 2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - lab.names[[2 * K]] <- "b" - .symmetric.Dens(vars, lab.names) +".dens.Poisson.Base.Hier" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities") + } + lambda <- x@par$lambda + weight <- x@weight + b <- x@hyper$b + vars <- cbind(lambda, weight[, seq(1, K - 1)], b) + lab.names <- vector("list", 2 * K) + for (k in seq(1, K)) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in seq(K + 1, 2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + lab.names[[2 * K]] <- "b" + .symmetric.Dens(vars, lab.names) } - diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index d18c252..8adbf15 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -15,173 +15,211 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputhierpost <- setClass("mcmcoutputhierpost", - representation(post = "list"), - contains = c("mcmcoutputhier"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(post = list()) +.mcmcoutputhierpost <- setClass("mcmcoutputhierpost", + representation(post = "list"), + contains = c("mcmcoutputhier"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(post = list()) ) ## Set 'mcmcoutput' to the virtual class inheriting ## ## to each other 'mcmcoutput' class. ## ## This is done to simplify dispatching methods. ## -setClassUnion("mcmcoutput", - c( - "mcmcoutputfix", - "mcmcoutputfixhier", - "mcmcoutputfixpost", - "mcmcoutputfixhierpost", - "mcmcoutputbase", - "mcmcoutputhier", - "mcmcoutputpost", - "mcmcoutputhierpost") +setClassUnion( + "mcmcoutput", + c( + "mcmcoutputfix", + "mcmcoutputfixhier", + "mcmcoutputfixpost", + "mcmcoutputfixhierpost", + "mcmcoutputbase", + "mcmcoutputhier", + "mcmcoutputpost", + "mcmcoutputhierpost" + ) ) -setMethod("show", "mcmcoutputhierpost", - function(object) - { - cat("Object 'mcmcoutput'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" weight :", - paste(dim(object@weight), collapse = "x"), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputhierpost", + function(object) { + cat("Object 'mcmcoutput'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " weight :", + paste(dim(object@weight), collapse = "x"), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputhierpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function(x, dev = TRUE, lik = 1, col = FALSE, ...) - { - ## Call method 'plot()' from 'mcmcoutputhier' - callNextMethod(x, dev, lik, col, ...) - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputhierpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + ## Call method 'plot()' from 'mcmcoutputhier' + callNextMethod(x, dev, lik, col, ...) + } ) -setMethod("plotHist", signature(x = "mcmcoutputhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call method 'plotHist()' from 'mcmcoutputhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotHist", signature( + x = "mcmcoutputhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call method 'plotHist()' from 'mcmcoutputhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotDens", signature(x = "mcmcoutputhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotHist()' from 'mcmcoutputhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotDens", signature( + x = "mcmcoutputhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotHist()' from 'mcmcoutputhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputhier' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens()' from 'mcmcoutputhier' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens()' from 'mcmcoutputhier' + callNextMethod(x, dev, ...) + } ) -setMethod( "subseq", signature( object = "mcmcoutputhierpost", - index = "array"), - function( object, index ) - { - ## Call 'subseq()' method from 'mcmcoutputhier' - as( object, "mcmcoutputhier" ) <- callNextMethod( object, index ) - # Change owned slots # - dist <- object@model@dist - if ( dist == "poisson" ) { - .subseq.Poisson.Post( object, index ) - } else if ( dist == "binomial" ) { - .subseq.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .subseq.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .subseq.Normultstud.Mcmcoutputfixpost( object, index ) - } - - } +setMethod( + "subseq", signature( + object = "mcmcoutputhierpost", + index = "array" + ), + function(object, index) { + ## Call 'subseq()' method from 'mcmcoutputhier' + as(object, "mcmcoutputhier") <- callNextMethod(object, index) + # Change owned slots # + dist <- object@model@dist + if (dist == "poisson") { + .subseq.Poisson.Post(object, index) + } else if (dist == "binomial") { + .subseq.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .subseq.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .subseq.Normultstud.Mcmcoutputfixpost(object, index) + } + } ) -setMethod("swapElements", signature( object = "mcmcoutputhierpost", - index = "array" ), - function( object, index ) - { - ## Check arguments, TODO: .validObject ## - if ( object@model@K == 1 ) { - return( object ) - } else { - dist <- object@model@dist - ## Call method 'swapElements()' from 'mcmcoutputhier' - object <- callNextMethod( object, index ) - if ( dist == "poisson" ) { - .swapElements.Poisson.Post( object, index ) - } else if ( dist == "binomial" ) { - .swapElements.binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .swapElements.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .swapElements.Normultstud( object, index ) - } - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputhierpost", + index = "array" + ), + function(object, index) { + ## Check arguments, TODO: .validObject ## + if (object@model@K == 1) { + return(object) + } else { + dist <- object@model@dist + ## Call method 'swapElements()' from 'mcmcoutputhier' + object <- callNextMethod(object, index) + if (dist == "poisson") { + .swapElements.Poisson.Post(object, index) + } else if (dist == "binomial") { + .swapElements.binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .swapElements.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .swapElements.Normultstud(object, index) + } + } + } ) -setMethod( "getPost", "mcmcoutputhierpost", - function( object ) - { - return( object@post ) - } +setMethod( + "getPost", "mcmcoutputhierpost", + function(object) { + return(object@post) + } ) ## No setters as users are not intended to manipuate ## diff --git a/R/mcmcoutputpermbase.R b/R/mcmcoutputpermbase.R index 6a30076..8e21d90 100644 --- a/R/mcmcoutputpermbase.R +++ b/R/mcmcoutputpermbase.R @@ -15,433 +15,517 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputpermbase <- setClass( "mcmcoutputpermbase", - contains = c( "mcmcpermind", - "mcmcoutputbase" ), - validity = function( object ) - { - ## else: OK - TRUE - } +.mcmcoutputpermbase <- setClass("mcmcoutputpermbase", + contains = c( + "mcmcpermind", + "mcmcoutputbase" + ), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermbase", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), relabel = character(), - weightperm = array(), logperm = list(), - entropyperm = array(), STperm = array(), - Sperm = array(), NKperm = array()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcout@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@weight <- mcmcoutput@weight - .Object@log <- mcmcoutput@log - .Object@ST <- mcmcoutput@ST - .Object@S <- mcmcoutput@S - .Object@NK <- mcmcoutput@NK - .Object@clust <- mcmcoutput@clust - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@relabel <- relabel - .Object@weightperm <- weightperm - .Object@logperm <- logperm - .Object@entropyperm <- entropyperm - .Object@STperm <- STperm - .Object@Sperm <- Sperm - .Object@NKperm <- NKperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermbase", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), relabel = character(), + weightperm = array(), logperm = list(), + entropyperm = array(), STperm = array(), + Sperm = array(), NKperm = array()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcout@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@weight <- mcmcoutput@weight + .Object@log <- mcmcoutput@log + .Object@ST <- mcmcoutput@ST + .Object@S <- mcmcoutput@S + .Object@NK <- mcmcoutput@NK + .Object@clust <- mcmcoutput@clust + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@relabel <- relabel + .Object@weightperm <- weightperm + .Object@logperm <- logperm + .Object@entropyperm <- entropyperm + .Object@STperm <- STperm + .Object@Sperm <- Sperm + .Object@NKperm <- NKperm + .Object + } ) -setMethod("show", "mcmcoutputpermbase", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" relabel :", object@relabel, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" weightperm :", - paste(dim(object@weightperm), collapse = "x"), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" entropyperm :", - paste(dim(object@entropyperm), collapse = "x"), "\n") - cat(" STperm :", - paste(dim(object@STperm), collapse = "x"), "\n") - if (!all(is.na(object@Sperm))) { - cat(" Sperm :", - paste(dim(object@Sperm), collapse = "x"), "\n") - } - cat(" NKperm :", - paste(dim(object@NKperm), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermbase", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" relabel :", object@relabel, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " weightperm :", + paste(dim(object@weightperm), collapse = "x"), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " entropyperm :", + paste(dim(object@entropyperm), collapse = "x"), "\n" + ) + cat( + " STperm :", + paste(dim(object@STperm), collapse = "x"), "\n" + ) + if (!all(is.na(object@Sperm))) { + cat( + " Sperm :", + paste(dim(object@Sperm), collapse = "x"), "\n" + ) + } + cat( + " NKperm :", + paste(dim(object@NKperm), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermbase", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson.Base( x, dev ) - } else if ( dist == "binomial" ) { - .permtraces.Binomial.Base( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential.Base( x, dev ) - } else if ( dist == "normal" ) { - .permtraces.Normal( x, dev ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "student" ) { - .permtraces.Student( x, dev ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "normult" ) { - .permtraces.Normult( x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult(x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log.Base( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermbase", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial.Base(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential.Base(x, dev) + } else if (dist == "normal") { + .permtraces.Normal(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "student") { + .permtraces.Student(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "normult") { + .permtraces.Normult(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log.Base(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if(dist == "poisson") { - .permhist.Poisson.Base(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial.Base(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial.Base(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson.Base(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial.Base(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial.Base(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermbase", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermbase", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermbase", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermbase", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) -### Private functions. +### Private functions. ### These functions are not exported. ### Plot ### Traces ### Traces Poisson: Plots traces for all Poisson parameters ### and the weights. -".permtraces.Poisson.Base" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K * 2 - 1 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots (permuted)") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@parperm$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = 0.6, line = 3) - } - weight <- x@weightperm - for (k in 1:(K - 1)) { - plot(weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(eta[k = .(k)]), - cex = 0.6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) +".permtraces.Poisson.Base" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 - 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots (permuted)") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@parperm$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = 0.6, line = 3 + ) + } + weight <- x@weightperm + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = 0.6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } -".permtraces.Binomial.Base" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K * 2 - 1 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots (permuted)") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - p <- x@parperm$p - for (k in 1:K) { - plot(p[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(p[k = .(k)]), - cex = 0.6, line = 3) - } - weight <- x@weightperm - for (k in 1:(K - 1)) { - plot(weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(eta[k = .(k)]), - cex = 0.6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) +".permtraces.Binomial.Base" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 - 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots (permuted)") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + p <- x@parperm$p + for (k in 1:K) { + plot(p[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(p[k = .(k)]), + cex = 0.6, line = 3 + ) + } + weight <- x@weightperm + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = 0.6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } -".permtraces.Exponential.Base" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- K * 2 - 1 - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - lambda <- x@parperm$lambda - for ( k in 1:K ) { - plot( lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( lambda[k = .( k )] ), - cex = .6, line = 3 ) - } - weight <- x@weight - for ( k in 1:( K - 1 ) ) { - plot( weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote(eta[k = .(k)]), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Exponential.Base" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 - 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@parperm$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = .6, line = 3 + ) + } + weight <- x@weight + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".permtraces.Weights.Base" <- function( x, dev, col ) -{ - weight <- x@weightperm - K <- x@model@K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Weights" ) - } - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } +".permtraces.Weights.Base" <- function(x, dev, col) { + weight <- x@weightperm + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Weights") + } + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } - plot( weight[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", ylim = c( 0, 1.2 ) ) - for( k in 2:K ) { - lines( weight[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( eta ), - cex = .6, line = 3 ) - name <- vector( "character", K ) - for( k in 1:K ) { - name[k] <- paste( "k = ", k, sep = "" ) - } - legend( "top", legend = name, col = cscale, lty = 1, - horiz = TRUE, cex = .7 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) + plot(weight[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", ylim = c(0, 1.2) + ) + for (k in 2:K) { + lines(weight[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(eta), + cex = .6, line = 3 + ) + name <- vector("character", K) + for (k in 1:K) { + name[k] <- paste("k = ", k, sep = "") + } + legend("top", + legend = name, col = cscale, lty = 1, + horiz = TRUE, cex = .7 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### Traces log-likelihoods: Plots traces for the log-likelihoods. -".permtraces.Log.Base" <- function( x, dev ) -{ - if ( .check.grDevice() && dev ) { - dev.new( title = "Log Likelihood Traceplots (permuted)" ) - } - if ( col ) { - cscale <- rainbow( 3, start = 0, end = .5 ) - } else { - cscale <- gray.colors( 3, start = 0, end = .15 ) - } - par( mfrow = c( 3, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mixlik <- x@logperm$mixlik - plot( mixlik, type = "l", axes = F, - col = cscale[3], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixlik", cex = 0.6, - line = 3 ) - mixprior <- x@logperm$mixprior - plot( mixprior, type = "l", axes = F, - col = cscale[2], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixprior", cex = 0.6, - line = 3) - cdpost <- x@logperm$cdpost - plot( mixprior, type = "l", axes = F, - col = cscale[3], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "cdpost", cex = 0.6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = 0.7, line = 3 ) +".permtraces.Log.Base" <- function(x, dev) { + if (.check.grDevice() && dev) { + dev.new(title = "Log Likelihood Traceplots (permuted)") + } + if (col) { + cscale <- rainbow(3, start = 0, end = .5) + } else { + cscale <- gray.colors(3, start = 0, end = .15) + } + par( + mfrow = c(3, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mixlik <- x@logperm$mixlik + plot(mixlik, + type = "l", axes = F, + col = cscale[3], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixlik", cex = 0.6, + line = 3 + ) + mixprior <- x@logperm$mixprior + plot(mixprior, + type = "l", axes = F, + col = cscale[2], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixprior", cex = 0.6, + line = 3 + ) + cdpost <- x@logperm$cdpost + plot(mixprior, + type = "l", axes = F, + col = cscale[3], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "cdpost", cex = 0.6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### Histograms -### Histograms Poisson: Plots histograms for all Poisson +### Histograms Poisson: Plots histograms for all Poisson ### parameters and the weights. -".permhist.Poisson.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - weight <- x@weightperm - vars <- cbind(lambda, weight[, seq(1:(K - 1))]) - lab.names <- vector("list", 2 * K - 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in (K + 1):(2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Hist(vars, lab.names) +".permhist.Poisson.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + weight <- x@weightperm + vars <- cbind(lambda, weight[, seq(1:(K - 1))]) + lab.names <- vector("list", 2 * K - 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in (K + 1):(2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Hist(vars, lab.names) } -".permhist.Binomial.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - p <- x@parperm$p - weight <- x@weightperm - vars <- cbind(p, weight[, seq(1:(K - 1))]) - lab.names <- vector("list", 2 * K - 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(p[.(k)]) - } - for (k in (K + 1):(2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Hist(vars, lab.names) +".permhist.Binomial.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + p <- x@parperm$p + weight <- x@weightperm + vars <- cbind(p, weight[, seq(1:(K - 1))]) + lab.names <- vector("list", 2 * K - 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(p[.(k)]) + } + for (k in (K + 1):(2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Hist(vars, lab.names) } ### Densities ### Densities Poisson: Plots Kernel densities for all Poisson ### parameters and weights. -".permdens.Poisson.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - weight <- x@weightperm - vars <- cbind(lambda, weight[, seq(1:(K - 1))]) - lab.names <- vector("list", 2 * K - 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in (K + 1):(2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Dens(vars, lab.names) +".permdens.Poisson.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + weight <- x@weightperm + vars <- cbind(lambda, weight[, seq(1:(K - 1))]) + lab.names <- vector("list", 2 * K - 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in (K + 1):(2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Dens(vars, lab.names) } -".permdens.Binomial.Base" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - p <- x@parperm$p - weight <- x@weightperm - vars <- cbind(p, weight[, seq(1:(K - 1))]) - lab.names <- vector("list", 2 * K - 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(p[.(k)]) - } - for (k in (K + 1):(2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - .symmetric.Dens(vars, lab.names) +".permdens.Binomial.Base" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + p <- x@parperm$p + weight <- x@weightperm + vars <- cbind(p, weight[, seq(1:(K - 1))]) + lab.names <- vector("list", 2 * K - 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(p[.(k)]) + } + for (k in (K + 1):(2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + .symmetric.Dens(vars, lab.names) } diff --git a/R/mcmcoutputpermfix.R b/R/mcmcoutputpermfix.R index 9c07ed8..d9fe158 100644 --- a/R/mcmcoutputpermfix.R +++ b/R/mcmcoutputpermfix.R @@ -16,150 +16,173 @@ # along with finmix. If not, see . .mcmcoutputpermfix <- setClass("mcmcoutputpermfix", - contains = c("mcmcpermfix", "mcmcoutputfix"), - validity = function(object) - { - ## else: OK - TRUE - } + contains = c("mcmcpermfix", "mcmcoutputfix"), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermfix", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), logperm = list()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@log <- mcmcoutput@log - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@logperm <- logperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermfix", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), logperm = list()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@log <- mcmcoutput@log + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@logperm <- logperm + .Object + } ) -setMethod("show", "mcmcoutputpermfix", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermfix", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermfix", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function(x, dev = TRUE, lik = 1, col = FALSE, ...) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if( dist == "poisson" ) { - .permtraces.Poisson( x, dev ) - } else if ( dist == "binomial" ) { - .permtraces.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .permtraces.Normal( x, dev ) - } else if ( dist == "student") { - .permtraces.Student( x, dev ) - } else if ( dist == "normult" ) { - .permtraces.Normult( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log( x, dev, col ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermfix", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential(x, dev) + } else if (dist == "normal") { + .permtraces.Normal(x, dev) + } else if (dist == "student") { + .permtraces.Student(x, dev) + } else if (dist == "normult") { + .permtraces.Normult(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log(x, dev, col) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermfix", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if(dist == "poisson") { - .permhist.Poisson(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial(x, dev) - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial(x, dev) } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermfix", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermfix", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermfix", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermfix", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermfix", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermfix", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) ### Private functions. @@ -167,171 +190,208 @@ setMethod("plotPostDens", signature(x = "mcmcoutputpermfix", ### Traces ### Traces Poisson: Plots the traces of the Poisson parameter. -".permtraces.Poisson" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4,4)) - lambda <- x@parperm$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = 0.6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) -} - -".permtraces.Binomial" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4,4)) - p <- x@parperm$p - for (k in 1:K) { - plot(p[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(p[k = .(k)]), - cex = 0.6, line = 3) - } - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) +".permtraces.Poisson" <- function(x, dev) { + K <- x@model@K + trace.n <- K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@parperm$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = 0.6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) +} + +".permtraces.Binomial" <- function(x, dev) { + K <- x@model@K + trace.n <- K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + p <- x@parperm$p + for (k in 1:K) { + plot(p[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(p[k = .(k)]), + cex = 0.6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### -------------------------------------------------------------------- ### .permtraces.Exponential ### @description Plots traces for parameters of Exponential mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Exponential mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Exponential mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".permtraces.Exponential" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - lambda <- x@parperm$lambda - for ( k in 1:K ) { - plot( lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( lambda[k = .( k )] ), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Exponential" <- function(x, dev) { + K <- x@model@K + trace.n <- K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@parperm$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .permtraces.Normal -### @description Plots traces for parameters of a univariate Normal +### @description Plots traces for parameters of a univariate Normal ### mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Normal mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Normal mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".permtraces.Normal" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 2 * K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@parperm$mu - sigma <- x@parperm$sigma - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Normal" <- function(x, dev) { + K <- x@model@K + trace.n <- 2 * K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@parperm$mu + sigma <- x@parperm$sigma + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .permtraces.Student -### @description Plots traces for parameters of a univariate Student +### @description Plots traces for parameters of a univariate Student ### mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Student mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".permtraces.Student" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 3 * K - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@parperm$mu - sigma <- x@parperm$sigma - df <- x@par$df - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( df[, k], type = "l", axes = F, - col = "gray40", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( nu[k = .( k )]), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Student" <- function(x, dev) { + K <- x@model@K + trace.n <- 3 * K + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@parperm$mu + sigma <- x@parperm$sigma + df <- x@par$df + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(df[, k], + type = "l", axes = F, + col = "gray40", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(nu[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### ------------------------------------------------------------------------- @@ -347,123 +407,159 @@ setMethod("plotPostDens", signature(x = "mcmcoutputpermfix", ### @see ?plotTraces ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------- -".permtraces.Normult" <- function( x, dev, col ) -{ - K <- x@model@K - r <- x@model@r - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - trace.n <- r + 2 - par( mfrow = c( trace.n, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 2, 4 ) ) - mu <- x@parperm$mu - sigma <- x@parperm$sigma - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - for ( rr in 1:r ) { - mmax <- max( mu[,rr,] ) - mmin <- min( mu[,rr,] ) - plot( mu[, rr, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax + 0.3 * (mmax - mmin) ) ) - for ( k in 2:K ) { - lines( mu[, rr, k], col = cscale[ k ] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[rr = .( rr )] ), - cex = .6, line = 3 ) - if ( rr == 1 ) { - name <- vector( "character", K ) - for (k in 1:K ) { - name[k] <- paste( "k = ", k, sep = "") - } - legend( "top", legend = name, col = cscale, horiz = TRUE, - lty = 1 ) - } +".permtraces.Normult" <- function(x, dev, col) { + K <- x@model@K + r <- x@model@r + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + trace.n <- r + 2 + par( + mfrow = c(trace.n, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 2, 4) + ) + mu <- x@parperm$mu + sigma <- x@parperm$sigma + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + for (rr in 1:r) { + mmax <- max(mu[, rr, ]) + mmin <- min(mu[, rr, ]) + plot(mu[, rr, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax + 0.3 * (mmax - mmin)) + ) + for (k in 2:K) { + lines(mu[, rr, k], col = cscale[k]) } - sigma.tr <- array( numeric(), dim = c( x@M, K ) ) - sigma.det <- array( numeric(), dim = c( x@M, K ) ) - for ( k in 1:K ) { - sigma.tr[, k] <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( sigma[i,, k] ) ) ) ) - sigma.det[, k] <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( sigma[i,, k] ) ) ) ) - } - # Sigma traces - mmax <- max( sigma.tr ) - mmin <- min( sigma.tr ) - plot( sigma.tr[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for ( k in 2:K ) { - lines( sigma.tr[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr( Sigma ) ), - cex = .6, line = 3 ) - - # Sigma logdets - mmax <- max( sigma.det ) - mmin <- min( sigma.det ) - plot( sigma.det[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for( k in 2:K ) { - lines( sigma.det[, k], col = cscale[k] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( log( det( Sigma ) ) ), - cex = .6, line = 3 ) - - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - - # Get moments - moms <- permmoments_cc( x ) - for ( rr in 1:r ) { - if ( .check.grDevice() && dev ) { - dev.new( title = paste( "Traceplots Feature ", rr, sep = "" ) ) - } - par( mfrow = c( 2, 2 ), mar = c( 4, 4, 0.5, 0.5 ), - oma = c( 1.5, 2, 1, 1 ) ) - # Mu - plot( moms$mean[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Variance - plot( moms$var[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Skewness - plot( moms$skewness[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Skewness", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Kurtosis - plot( moms$kurtosis[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Kurtosis", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[rr = .(rr)]), + cex = .6, line = 3 + ) + if (rr == 1) { + name <- vector("character", K) + for (k in 1:K) { + name[k] <- paste("k = ", k, sep = "") + } + legend("top", + legend = name, col = cscale, horiz = TRUE, + lty = 1 + ) } + } + sigma.tr <- array(numeric(), dim = c(x@M, K)) + sigma.det <- array(numeric(), dim = c(x@M, K)) + for (k in 1:K) { + sigma.tr[, k] <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(sigma[i, , k]))) + ) + sigma.det[, k] <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(sigma[i, , k]))) + ) + } + # Sigma traces + mmax <- max(sigma.tr) + mmin <- min(sigma.tr) + plot(sigma.tr[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.tr[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(Sigma)), + cex = .6, line = 3 + ) + + # Sigma logdets + mmax <- max(sigma.det) + mmin <- min(sigma.det) + plot(sigma.det[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.det[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(log(det(Sigma))), + cex = .6, line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + + # Get moments + moms <- permmoments_cc(x) + for (rr in 1:r) { + if (.check.grDevice() && dev) { + dev.new(title = paste("Traceplots Feature ", rr, sep = "")) + } + par( + mfrow = c(2, 2), mar = c(4, 4, 0.5, 0.5), + oma = c(1.5, 2, 1, 1) + ) + # Mu + plot(moms$mean[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Variance + plot(moms$var[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Skewness + plot(moms$skewness[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Skewness", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Kurtosis + plot(moms$kurtosis[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Kurtosis", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + } } ### ------------------------------------------------------------------------- @@ -479,420 +575,520 @@ setMethod("plotPostDens", signature(x = "mcmcoutputpermfix", ### @see ?plotTraces ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------- -".permtraces.Studmult" <- function( x, dev, col ) -{ - K <- x@model@K - r <- x@model@r - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - trace.n <- r + 2 - par( mfrow = c( trace.n, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@parperm$mu - sigma <- x@parperm$sigma - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - for ( rr in 1:r ) { - mmax <- max( mu[,rr,] ) - mmin <- min( mu[,rr,] ) - plot( mu[, rr, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax + 0.3 * ( mmax - mmin ) ) ) - for ( k in 2:K ) { - lines( mu[, rr, k], col = cscale[ k ] ) - } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[rr = .( rr )] ), - cex = .6, line = 3 ) - if ( rr == 1 ) { - name <- vector( "character", K ) - for (k in 1:K ) { - name[k] <- paste( "k = ", k, sep = "") - } - legend( "top", legend = name, col = cscale, horiz = TRUE, - lty = 1 ) - } - } - sigma.tr <- array( numeric(), dim = c( x@M, K ) ) - sigma.det <- array( numeric(), dim = c( x@M, K ) ) - for ( k in 1:K ) { - sigma.tr[, k] <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( sigma[i,, k] ) ) ) ) - sigma.det[, k] <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( sigma[i,, k] ) ) ) ) - } - # Sigma traces - mmax <- max( sigma.tr ) - mmin <- min( sigma.tr ) - plot( sigma.tr[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for ( k in 2:K ) { - lines( sigma.tr[, k], col = cscale[k] ) +".permtraces.Studmult" <- function(x, dev, col) { + K <- x@model@K + r <- x@model@r + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + trace.n <- r + 2 + par( + mfrow = c(trace.n, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@parperm$mu + sigma <- x@parperm$sigma + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + for (rr in 1:r) { + mmax <- max(mu[, rr, ]) + mmin <- min(mu[, rr, ]) + plot(mu[, rr, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax + 0.3 * (mmax - mmin)) + ) + for (k in 2:K) { + lines(mu[, rr, k], col = cscale[k]) } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr( Sigma ) ), - cex = .6, line = 3 ) - - # Sigma logdets - mmax <- max( sigma.det ) - mmin <- min( sigma.det ) - plot( sigma.det[, 1], type = "l", axes = F, - col = cscale[1], xlab = "", ylab = "", - ylim = c( mmin, mmax ) ) - for( k in 2:K ) { - lines( sigma.det[, k], col = cscale[k] ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[rr = .(rr)]), + cex = .6, line = 3 + ) + if (rr == 1) { + name <- vector("character", K) + for (k in 1:K) { + name[k] <- paste("k = ", k, sep = "") + } + legend("top", + legend = name, col = cscale, horiz = TRUE, + lty = 1 + ) } - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( log( det( Sigma ) ) ), - cex = .6, line = 3 ) - - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - - # Degrees of freedom - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Degrees of Freedom" ) - } - degf <- x@parperm$df - par( mfrow = c( K, 1 ), mar = c( 1, 2, 0, 0), - oma = c( 4, 5, 4, 4 ) ) - for ( k in 1:K ) { - plot( degf[,k], type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( nu[ k = .(k) ] ), - cex = .6, line = 3 ) - } - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Get moments - moms <- permmoments_cc( x ) - for ( rr in 1:r ) { - if ( .check.grDevice() && dev ) { - dev.new( title = paste( "Traceplots Feature ", rr, sep = "" ) ) - } - par( mfrow = c( 2, 2 ), mar = c( 4, 4, 0.5, 0.5 ), - oma = c( 1.5, 2, 1, 1 ) ) - # Mu - plot( moms$mean[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Variance - plot( moms$var[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma ), cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Skewness - plot( moms$skewness[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Skewness", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) - # Kurtosis - plot( moms$kurtosis[, rr], type = "l", axes = F, - xlab = "", ylab = "", col = cscale[K] ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, "Kurtosis", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) + } + sigma.tr <- array(numeric(), dim = c(x@M, K)) + sigma.det <- array(numeric(), dim = c(x@M, K)) + for (k in 1:K) { + sigma.tr[, k] <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(sigma[i, , k]))) + ) + sigma.det[, k] <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(sigma[i, , k]))) + ) + } + # Sigma traces + mmax <- max(sigma.tr) + mmin <- min(sigma.tr) + plot(sigma.tr[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.tr[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(Sigma)), + cex = .6, line = 3 + ) + + # Sigma logdets + mmax <- max(sigma.det) + mmin <- min(sigma.det) + plot(sigma.det[, 1], + type = "l", axes = F, + col = cscale[1], xlab = "", ylab = "", + ylim = c(mmin, mmax) + ) + for (k in 2:K) { + lines(sigma.det[, k], col = cscale[k]) + } + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(log(det(Sigma))), + cex = .6, line = 3 + ) + + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + + # Degrees of freedom + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Degrees of Freedom") + } + degf <- x@parperm$df + par( + mfrow = c(K, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + for (k in 1:K) { + plot(degf[, k], + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(nu[k = .(k)]), + cex = .6, line = 3 + ) + } + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Get moments + moms <- permmoments_cc(x) + for (rr in 1:r) { + if (.check.grDevice() && dev) { + dev.new(title = paste("Traceplots Feature ", rr, sep = "")) } + par( + mfrow = c(2, 2), mar = c(4, 4, 0.5, 0.5), + oma = c(1.5, 2, 1, 1) + ) + # Mu + plot(moms$mean[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Variance + plot(moms$var[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma), cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Skewness + plot(moms$skewness[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Skewness", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + # Kurtosis + plot(moms$kurtosis[, rr], + type = "l", axes = F, + xlab = "", ylab = "", col = cscale[K] + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, "Kurtosis", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) + } } ### Traces log-likelihood: Plots the traces of the log- ### likelihoods. -".permtraces.Log" <- function( x, dev, col ) -{ - if( .check.grDevice() && dev ) { - dev.new( title = "Log Likelihood Traceplots" ) - } - if ( col ) { - cscale <- rainbow( 3, start = 0, end = .5 ) - } else { - cscale <- gray.colors( 3, start = 0, end = .15 ) - } - par( mfrow = c( 2, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mixlik <- x@logperm$mixlik - plot( mixlik, type = "l", axes = F, - col = cscale[3], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixlik", cex = 0.6, - line = 3 ) - mixprior <- x@logperm$mixprior - plot( mixprior, type = "l", axes = F, - col = cscale[2], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 3, "mixprior", cex = 0.6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = 0.7, line = 3 ) +".permtraces.Log" <- function(x, dev, col) { + if (.check.grDevice() && dev) { + dev.new(title = "Log Likelihood Traceplots") + } + if (col) { + cscale <- rainbow(3, start = 0, end = .5) + } else { + cscale <- gray.colors(3, start = 0, end = .15) + } + par( + mfrow = c(2, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mixlik <- x@logperm$mixlik + plot(mixlik, + type = "l", axes = F, + col = cscale[3], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixlik", cex = 0.6, + line = 3 + ) + mixprior <- x@logperm$mixprior + plot(mixprior, + type = "l", axes = F, + col = cscale[2], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 3, "mixprior", cex = 0.6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### Histograms ### Histograms Poisson: Plots histograms for all Poisson ### parameters. -".permhist.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - lab.names <- vector("list", K) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - .symmetric.Hist(lambda, lab.names) +".permhist.Poisson" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + .symmetric.Hist(lambda, lab.names) } -".permhist.Binomial" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - p <- x@parperm$p - lab.names <- vector("list", K) - for (k in 1:K) { - lab.names[[k]] <- bquote(p[.(k)]) - } - .symmetric.Hist(p, lab.names) +".permhist.Binomial" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + p <- x@parperm$p + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(p[.(k)]) + } + .symmetric.Hist(p, lab.names) } ### Densities ### Densities Poisson: Plots densities for all Poisson ### parameters. -".permdens.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Densities (permuted)") - } - lambda <- x@parperm$lambda - lab.names <- vector("list", K) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - .symmetric.Dens(lambda, lab.names) +".permdens.Poisson" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities (permuted)") + } + lambda <- x@parperm$lambda + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + .symmetric.Dens(lambda, lab.names) } -".permdens.Binomial" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Densities (permuted)") - } - p <- x@parperm$p - lab.names <- vector("list", K) - for (k in 1:K) { - lab.names[[k]] <- bquote(p[.(k)]) - } - .symmetric.Dens(p, lab.names) +".permdens.Binomial" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Densities (permuted)") + } + p <- x@parperm$p + lab.names <- vector("list", K) + for (k in 1:K) { + lab.names[[k]] <- bquote(p[.(k)]) + } + .symmetric.Dens(p, lab.names) } ### Plot Point Processes ### Plot Point Process Poisson: Plots the point process ### for the MCMC draws for lambda. The values are plotted -### against a random normal sample. -".permpointproc.Poisson" <- function(x, dev) -{ - K <- x@model@K - M <- x@M - if (.check.grDevice() && dev) { - dev.new("Point Process Representation (MCMC permuted)") - } - y.grid <- replicate(K, rnorm(M)) - if (median(x@parperm$lambda) < 1) { - lambda <- log(x@parperm$lambda) - } else { - lambda <- x@parperm$lambda - } - col.grid <- gray.colors(K, start = 0, - end = 0.5) - legend.names <- vector("list", K) - for (k in seq(1, K)) { - legend.names[[k]] <- bquote(lambda[.(k)]) - } - plot(lambda, y.grid, pch = 20, col = col.grid, - cex = .7, cex.axis = .7, cex.lab = .7, - main = "", ylab = "", xlab = "") - mtext(side = 1, bquote(lambda), cex = .7, - cex.lab = .7, line = 3) - legend("topright", legend = do.call(expression, - legend.names), - col = col.grid, fill = col.grid) +### against a random normal sample. +".permpointproc.Poisson" <- function(x, dev) { + K <- x@model@K + M <- x@M + if (.check.grDevice() && dev) { + dev.new("Point Process Representation (MCMC permuted)") + } + y.grid <- replicate(K, rnorm(M)) + if (median(x@parperm$lambda) < 1) { + lambda <- log(x@parperm$lambda) + } else { + lambda <- x@parperm$lambda + } + col.grid <- gray.colors(K, + start = 0, + end = 0.5 + ) + legend.names <- vector("list", K) + for (k in seq(1, K)) { + legend.names[[k]] <- bquote(lambda[.(k)]) + } + plot(lambda, y.grid, + pch = 20, col = col.grid, + cex = .7, cex.axis = .7, cex.lab = .7, + main = "", ylab = "", xlab = "" + ) + mtext( + side = 1, bquote(lambda), cex = .7, + cex.lab = .7, line = 3 + ) + legend("topright", + legend = do.call( + expression, + legend.names + ), + col = col.grid, fill = col.grid + ) } -".permpointproc.Binomial" <- function(x, dev) -{ - K <- x@model@K - M <- x@M - if (.check.grDevice() && dev) { - dev.new(title = "Point Process Representation (MCMC permuted)") - } - y.grid <- replicate(K, rnorm(M)) - p <- x@par$p - col.grid <- gray.colors(K, start = 0, - end = 0.5) - legend.names <- vector("list", K) - for (k in seq(1, K)) { - legend.names[[k]] <- bquote(p[.(k)]) - } - plot(p, y.grid, pch = 20, col = col.grid, - cex = .7, cex.axis = .7, cex.lab = .7, - main = "", ylab = "", xlab = "") - mtext(side = 1, bquote(p), cex = .7, - cex.lab = .7, line = 3) - legend("topright", legend = do.call(expression, - legend.names), - col = col.grid, fill = col.grid) +".permpointproc.Binomial" <- function(x, dev) { + K <- x@model@K + M <- x@M + if (.check.grDevice() && dev) { + dev.new(title = "Point Process Representation (MCMC permuted)") + } + y.grid <- replicate(K, rnorm(M)) + p <- x@par$p + col.grid <- gray.colors(K, + start = 0, + end = 0.5 + ) + legend.names <- vector("list", K) + for (k in seq(1, K)) { + legend.names[[k]] <- bquote(p[.(k)]) + } + plot(p, y.grid, + pch = 20, col = col.grid, + cex = .7, cex.axis = .7, cex.lab = .7, + main = "", ylab = "", xlab = "" + ) + mtext( + side = 1, bquote(p), cex = .7, + cex.lab = .7, line = 3 + ) + legend("topright", + legend = do.call( + expression, + legend.names + ), + col = col.grid, fill = col.grid + ) } ### Plot sampling representation ### Plot sampling representation Poisson: Plots the sampling ### representation for Poisson parameters. Each parameter sample -### is combined with the other samples. -".permsamprep.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (K == 1) { - warning(paste("Sampling representation is only ", - "available for mixture models with ", - "K > 1.", sep = "")) - return(FALSE) - } - M <- x@M - n <- min(2000, x@M) - n.perm <- choose(K, 2) * factorial(2) - lambda <- x@parperm$lambda - if (.check.grDevice() && dev) { - dev.new(title = "Sampling Representation") - } - comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) - comb <- comb[which(comb[, 1] != comb[, 2]), ] - lambda <- lambda[seq(1, n), ] - lambda <- matrix(lambda[,comb], nrow = n * n.perm, ncol = 2) - plot(lambda, col = "gray47", cex.lab = .7, cex.axis = .7, - cex = .7, pch = 20, main = "", xlab = "", ylab = "") - abline(0, 1, lty = 1) - mtext(side = 1, bquote(lambda), cex = .7, cex.lab = .7, - line = 3) - mtext(side = 2, bquote(lambda), cex = .7, cex.lab = .7, - line = 3) - +### is combined with the other samples. +".permsamprep.Poisson" <- function(x, dev) { + K <- x@model@K + if (K == 1) { + warning(paste("Sampling representation is only ", + "available for mixture models with ", + "K > 1.", + sep = "" + )) + return(FALSE) + } + M <- x@M + n <- min(2000, x@M) + n.perm <- choose(K, 2) * factorial(2) + lambda <- x@parperm$lambda + if (.check.grDevice() && dev) { + dev.new(title = "Sampling Representation") + } + comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) + comb <- comb[which(comb[, 1] != comb[, 2]), ] + lambda <- lambda[seq(1, n), ] + lambda <- matrix(lambda[, comb], nrow = n * n.perm, ncol = 2) + plot(lambda, + col = "gray47", cex.lab = .7, cex.axis = .7, + cex = .7, pch = 20, main = "", xlab = "", ylab = "" + ) + abline(0, 1, lty = 1) + mtext( + side = 1, bquote(lambda), cex = .7, cex.lab = .7, + line = 3 + ) + mtext( + side = 2, bquote(lambda), cex = .7, cex.lab = .7, + line = 3 + ) } -".permsamprep.Binomial" <- function(x, dev) -{ - K <- x@model@K - if (K == 1) { - warning(paste("Sampling representation is only ", - "available for mixture models with ", - "K > 1.", sep = "")) - return(FALSE) - } - M <- x@M - n <- min(2000, x@M) - n.perm <- choose(K, 2) * factorial(2) - p <- x@parperm$p - if (.check.grDevice() && dev) { - dev.new(title = "Sampling Representation (MCMC permuted)") - } - comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) - comb <- comb[which(comb[, 1] != comb[, 2]), ] - p <- p[seq(1, n), ] - p <- matrix(p[,comb], nrow = n * n.perm, ncol = 2) - plot(p, col = "gray47", cex.lab = .7, cex.axis = .7, - cex = .7, pch = 20, main = "", xlab = "", ylab = "") - abline(0, 1, lty = 1) - mtext(side = 1, bquote(p), cex = .7, cex.lab = .7, - line = 3) - mtext(side = 2, bquote(p), cex = .7, cex.lab = .7, - line = 3) - +".permsamprep.Binomial" <- function(x, dev) { + K <- x@model@K + if (K == 1) { + warning(paste("Sampling representation is only ", + "available for mixture models with ", + "K > 1.", + sep = "" + )) + return(FALSE) + } + M <- x@M + n <- min(2000, x@M) + n.perm <- choose(K, 2) * factorial(2) + p <- x@parperm$p + if (.check.grDevice() && dev) { + dev.new(title = "Sampling Representation (MCMC permuted)") + } + comb <- as.matrix(expand.grid(seq(1, K), seq(1, K))) + comb <- comb[which(comb[, 1] != comb[, 2]), ] + p <- p[seq(1, n), ] + p <- matrix(p[, comb], nrow = n * n.perm, ncol = 2) + plot(p, + col = "gray47", cex.lab = .7, cex.axis = .7, + cex = .7, pch = 20, main = "", xlab = "", ylab = "" + ) + abline(0, 1, lty = 1) + mtext( + side = 1, bquote(p), cex = .7, cex.lab = .7, + line = 3 + ) + mtext( + side = 2, bquote(p), cex = .7, cex.lab = .7, + line = 3 + ) } ### Posterior Density -### Posterior Density Poisson: Plots a contour plot of the +### Posterior Density Poisson: Plots a contour plot of the ### posterior density of the sampled parameters for K = 2. -".permpostdens.Poisson" <- function(x, dev) -{ - K <- x@model@K - if (K != 2) { - warning(paste("A plot of the posterior density is ", - "available only for K = 2.", sep = "")) - } else { - M <- x@M - n <- min(2000, M) - lambda <- x@parperm$lambda - lambda <- lambda[seq(1, n), ] - dens <- bkde2D(lambda, bandwidth = c(sd(lambda[, 1]), - sd(lambda[, 2]))) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Contour Plot (MCMC)") - } - contour(dens$x1, dens$x2, dens$fhat, cex = .7, - cex.lab = .7, cex.axis = .7, col = "gray47", - main = "", xlab = "", ylab = "") - mtext(side = 1, bquote(lambda[1]), cex = .7, - cex.lab = .7, line = 3) - mtext(side = 2, bquote(lambda[2]), cex = .7, - cex.lab = .7, line = 3) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Persepctive Plot (MCMC)") - } - persp(dens$x1, dens$x2, dens$fhat, col = "gray65", - border = "gray47", theta = 55, phi = 30, - expand = .5, lphi = 180, ltheta = 90, - r = 40, d = .1, ticktype = "detailed", zlab = - "Density", xlab = "k = 1" , ylab = "k = 2") +".permpostdens.Poisson" <- function(x, dev) { + K <- x@model@K + if (K != 2) { + warning(paste("A plot of the posterior density is ", + "available only for K = 2.", + sep = "" + )) + } else { + M <- x@M + n <- min(2000, M) + lambda <- x@parperm$lambda + lambda <- lambda[seq(1, n), ] + dens <- bkde2D(lambda, bandwidth = c( + sd(lambda[, 1]), + sd(lambda[, 2]) + )) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Contour Plot (MCMC)") } + contour(dens$x1, dens$x2, dens$fhat, + cex = .7, + cex.lab = .7, cex.axis = .7, col = "gray47", + main = "", xlab = "", ylab = "" + ) + mtext( + side = 1, bquote(lambda[1]), cex = .7, + cex.lab = .7, line = 3 + ) + mtext( + side = 2, bquote(lambda[2]), cex = .7, + cex.lab = .7, line = 3 + ) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Persepctive Plot (MCMC)") + } + persp(dens$x1, dens$x2, dens$fhat, + col = "gray65", + border = "gray47", theta = 55, phi = 30, + expand = .5, lphi = 180, ltheta = 90, + r = 40, d = .1, ticktype = "detailed", zlab = + "Density", xlab = "k = 1", ylab = "k = 2" + ) + } } -".permpostdens.Binomial" <- function(x, dev) -{ - K <- x@model@K - if (K != 2) { - warning(paste("A plot of the posterior density is ", - "available only for K = 2.", sep = "")) - } else { - M <- x@M - n <- min(2000, M) - p <- x@parperm$p - p <- p[seq(1, n), ] - dens <- bkde2D(p, bandwidth = c(sd(p[, 1]), - sd(p[, 2]))) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Contour Plot (MCMC)") - } - contour(dens$x1, dens$x2, dens$fhat, cex = .7, - cex.lab = .7, cex.axis = .7, col = "gray47", - main = "", xlab = "", ylab = "") - mtext(side = 1, bquote(p[1]), cex = .7, - cex.lab = .7, line = 3) - mtext(side = 2, bquote(p[2]), cex = .7, - cex.lab = .7, line = 3) - if (.check.grDevice() && dev) { - dev.new(title = "Posterior Density Persepctive Plot (MCMC)") - } - persp(dens$x1, dens$x2, dens$fhat, col = "gray65", - border = "gray47", theta = 55, phi = 30, - expand = .5, lphi = 180, ltheta = 90, - r = 40, d = .1, ticktype = "detailed", zlab = - "Density", xlab = "k = 1" , ylab = "k = 2") +".permpostdens.Binomial" <- function(x, dev) { + K <- x@model@K + if (K != 2) { + warning(paste("A plot of the posterior density is ", + "available only for K = 2.", + sep = "" + )) + } else { + M <- x@M + n <- min(2000, M) + p <- x@parperm$p + p <- p[seq(1, n), ] + dens <- bkde2D(p, bandwidth = c( + sd(p[, 1]), + sd(p[, 2]) + )) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Contour Plot (MCMC)") + } + contour(dens$x1, dens$x2, dens$fhat, + cex = .7, + cex.lab = .7, cex.axis = .7, col = "gray47", + main = "", xlab = "", ylab = "" + ) + mtext( + side = 1, bquote(p[1]), cex = .7, + cex.lab = .7, line = 3 + ) + mtext( + side = 2, bquote(p[2]), cex = .7, + cex.lab = .7, line = 3 + ) + if (.check.grDevice() && dev) { + dev.new(title = "Posterior Density Persepctive Plot (MCMC)") } + persp(dens$x1, dens$x2, dens$fhat, + col = "gray65", + border = "gray47", theta = 55, phi = 30, + expand = .5, lphi = 180, ltheta = 90, + r = 40, d = .1, ticktype = "detailed", zlab = + "Density", xlab = "k = 1", ylab = "k = 2" + ) + } } diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index bcc88df..9741461 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -16,389 +16,473 @@ # along with finmix. If not, see . .mcmcoutputpermfixhier <- setClass("mcmcoutputpermfixhier", - contains = c("mcmcpermfix", "mcmcoutputfixhier"), - validity = function(object) - { - ## else: OK - TRUE - } + contains = c("mcmcpermfix", "mcmcoutputfixhier"), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermfixhier", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), logperm = list()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@log <- mcmcoutput@log - .Object@hyper <- mcmcoutput@hyper - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@logperm <- logperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermfixhier", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), logperm = list()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@log <- mcmcoutput@log + .Object@hyper <- mcmcoutput@hyper + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@logperm <- logperm + .Object + } ) -setMethod("show", "mcmcoutputpermfixhier", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermfixhier", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermfixhier", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson.Hier( x, dev ) - } else if ( dist == "binomial" ) { - .permtraces.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - callNextMethod( x, dev, lik, col, ... ) - } else if ( dist == "normal" ) { - .permtraces.Normal.Hier( x, dev ) - } else if ( dist == "student" ) { - .permtraces.Student.Hier( x, dev ) - } else if ( dist == "normult" ) { - .permtraces.Normult.Hier( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult.Hier( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log( x, dev, col ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermfixhier", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial(x, dev) + } else if (dist == "exponential") { + callNextMethod(x, dev, lik, col, ...) + } else if (dist == "normal") { + .permtraces.Normal.Hier(x, dev) + } else if (dist == "student") { + .permtraces.Student.Hier(x, dev) + } else if (dist == "normult") { + .permtraces.Normult.Hier(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult.Hier(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log(x, dev, col) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permhist.Poisson.Hier(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson.Hier(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermfixhier", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermfixhier", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermfixhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermfixhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) ### Private functions. ### These functions are not exported. -### Traces -### Traces Poisson: Plots the traces of Poisson parameters +### Traces +### Traces Poisson: Plots the traces of Poisson parameters ### and the hyper-parameter 'b'. -".permtraces.Poisson.Hier" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K + 1 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@parperm$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = 0.6, line = 3) - } - b <- x@hyper$b - plot(b, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "") +".permtraces.Poisson.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- K + 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@parperm$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = 0.6, line = 3 + ) + } + b <- x@hyper$b + plot(b, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } -".permtraces.Normal.Hier" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 2 * K + 1 - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@parperm$mu - sigma <- x@parperm$sigma - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - C <- x@hyper$C - plot( c, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = 0.7 ) - mtext( side = 2, las = 2, "C", cex = .6, line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Normal.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- 2 * K + 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@parperm$mu + sigma <- x@parperm$sigma + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + C <- x@hyper$C + plot(c, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext(side = 2, las = 2, "C", cex = .6, line = 3) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### -------------------------------------------------------------------- ### .permtraces.Student.Hier -### @description Plots traces for parameters of a univariate Student +### @description Plots traces for parameters of a univariate Student ### mixture. ### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' +### dev an object of class 'logical' ### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead +### Student mixture. If 'dev' is set to FALSE +### (TRUE is default) no device is created, instead ### the graphic can be stored to a file. ### @see ?mcmcoutput, ?plotTraces ### @author Lars Simon Zehnder ### -------------------------------------------------------------------- -".permtraces.Student.Hier" <- function( x, dev ) -{ - K <- x@model@K - trace.n <- 3 * K + 1 - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots" ) - } - par( mfrow = c( trace.n, 1 ), mar = c( 1, 0, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - mu <- x@parperm$mu - sigma <- x@parperm$sigma - df <- x@parperm$df - for ( k in 1:K ) { - plot( mu[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( mu[k = .( k )] ), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( sigma[, k], type = "l", axes = F, - col = "gray30", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( sigma[k = .( k )]), - cex = .6, line = 3 ) - } - for ( k in 1:K ) { - plot( df[, k], type = "l", axes = F, - col = "gray40", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( nu[k = .( k )]), - cex = .6, line = 3 ) - } - C <- x@hyper$C - plot( C, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, "C", cex = .6, - line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Student.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- 3 * K + 1 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + mu <- x@parperm$mu + sigma <- x@parperm$sigma + df <- x@parperm$df + for (k in 1:K) { + plot(mu[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(mu[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(sigma[, k], + type = "l", axes = F, + col = "gray30", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(sigma[k = .(k)]), + cex = .6, line = 3 + ) + } + for (k in 1:K) { + plot(df[, k], + type = "l", axes = F, + col = "gray40", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(nu[k = .(k)]), + cex = .6, line = 3 + ) + } + C <- x@hyper$C + plot(C, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, "C", cex = .6, + line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -"permtraces.Normult.Hier" <- function( x, dev, col ) -{ - .permtraces.Normult( x, dev, col ) - r <- x@model@r - K <- x@model@K - C <- x@hyper$C - C.trace <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( C[i,] ) ) ) ) - C.logdet <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( C[i,] ) ) ) ) - # C traces - mmax <- max( C.trace ) - mmin <- min( C.trace ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Hyperparameters" ) - } - par( mfrow = c( 2, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - plot( C.trace, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr(C) ), - cex = .6, line = 3 ) - plot( C.logdet, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - name <- vector( "character", K ) - mtext( side = 2, las = 2, bquote( log(det(C))), - cex = .6, line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +"permtraces.Normult.Hier" <- function(x, dev, col) { + .permtraces.Normult(x, dev, col) + r <- x@model@r + K <- x@model@K + C <- x@hyper$C + C.trace <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(C[i, ]))) + ) + C.logdet <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(C[i, ]))) + ) + # C traces + mmax <- max(C.trace) + mmin <- min(C.trace) + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Hyperparameters") + } + par( + mfrow = c(2, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + plot(C.trace, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(C)), + cex = .6, line = 3 + ) + plot(C.logdet, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + name <- vector("character", K) + mtext( + side = 2, las = 2, bquote(log(det(C))), + cex = .6, line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } -".permtraces.Studmult.Hier" <- function( x, dev, col ) -{ - .permtraces.Studmult( x, dev, col ) - r <- x@model@r - K <- x@model@K - C <- x@hyper$C - C.trace <- sapply( seq( 1, x@M ), - function( i ) sum( diag( qinmatr( C[i,] ) ) ) ) - C.logdet <- sapply( seq( 1, x@M ), - function( i ) log( det( qinmatr( C[i,] ) ) ) ) - - # C traces - mmax <- max( C.trace ) - mmin <- min( C.trace ) - if ( .check.grDevice() && dev ) { - dev.new( title = "Traceplots Hyperparameters" ) - } - par( mfrow = c( 2, 1 ), mar = c( 1, 2, 0, 0 ), - oma = c( 4, 5, 4, 4 ) ) - if ( col ) { - cscale <- rainbow( K, start = 0.5, end = 0 ) - } else { - cscale <- gray.colors( K, start = 0.5, end = 0.15 ) - } - plot( C.trace, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( tr(C) ), - cex = .6, line = 3 ) - plot( C.logdet, type = "l", axes = F, - col = cscale[K], xlab = "", ylab = "" ) - axis( 2, las = 2, cex.axis = .7 ) - mtext( side = 2, las = 2, bquote( log(det(C))), - cex = .6, line = 3 ) - axis( 1 ) - mtext( side = 1, "Iterations", cex = .7, line = 3 ) +".permtraces.Studmult.Hier" <- function(x, dev, col) { + .permtraces.Studmult(x, dev, col) + r <- x@model@r + K <- x@model@K + C <- x@hyper$C + C.trace <- sapply( + seq(1, x@M), + function(i) sum(diag(qinmatr(C[i, ]))) + ) + C.logdet <- sapply( + seq(1, x@M), + function(i) log(det(qinmatr(C[i, ]))) + ) + + # C traces + mmax <- max(C.trace) + mmin <- min(C.trace) + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots Hyperparameters") + } + par( + mfrow = c(2, 1), mar = c(1, 2, 0, 0), + oma = c(4, 5, 4, 4) + ) + if (col) { + cscale <- rainbow(K, start = 0.5, end = 0) + } else { + cscale <- gray.colors(K, start = 0.5, end = 0.15) + } + plot(C.trace, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(tr(C)), + cex = .6, line = 3 + ) + plot(C.logdet, + type = "l", axes = F, + col = cscale[K], xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = .7) + mtext( + side = 2, las = 2, bquote(log(det(C))), + cex = .6, line = 3 + ) + axis(1) + mtext(side = 1, "Iterations", cex = .7, line = 3) } ### Histograms -### Histograms Poisson: Plots histograms for all Poisson +### Histograms Poisson: Plots histograms for all Poisson ### parameters and the hyper-parameter 'b'. -".permhist.Poisson.Hier." <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - b <- x@hyper$b - vars <- cbind(lambda, b) - lab.names <- vector("list", K + 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - lab.names[[K + 1]] <- "b" - .symmetric.Hist(vars, lab.names) +".permhist.Poisson.Hier." <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + b <- x@hyper$b + vars <- cbind(lambda, b) + lab.names <- vector("list", K + 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + lab.names[[K + 1]] <- "b" + .symmetric.Hist(vars, lab.names) } ### Densities -### Densities Poisson: Plots densities for all Poisson +### Densities Poisson: Plots densities for all Poisson ### parameters and the hyper-parameter 'b'. -".permdens.Poisson.Hier." <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - b <- x@hyper$b - vars <- cbind(lambda, b) - lab.names <- vector("list", K + 1) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - lab.names[[K + 1]] <- "b" - .symmetric.Dens(vars, lab.names) +".permdens.Poisson.Hier." <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + b <- x@hyper$b + vars <- cbind(lambda, b) + lab.names <- vector("list", K + 1) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + lab.names[[K + 1]] <- "b" + .symmetric.Dens(vars, lab.names) } diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index e1283c3..0c764eb 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -15,161 +15,191 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputpermfixhierpost <- setClass( "mcmcoutputpermfixhierpost", - contains = c( "mcmcpermfixpost", - "mcmcoutputfixhierpost" ), - validity = function( object ) - { - ## else: OK - TRUE - } +.mcmcoutputpermfixhierpost <- setClass("mcmcoutputpermfixhierpost", + contains = c( + "mcmcpermfixpost", + "mcmcoutputfixhierpost" + ), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermfixhierpost", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), logperm = list(), - postperm = list()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@log <- mcmcoutput@log - .Object@hyper <- mcmcoutput@hyper - .Object@post <- mcmcoutput@post - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@logperm <- logperm - .Object@postperm <- postperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermfixhierpost", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), logperm = list(), + postperm = list()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@log <- mcmcoutput@log + .Object@hyper <- mcmcoutput@hyper + .Object@post <- mcmcoutput@post + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@logperm <- logperm + .Object@postperm <- postperm + .Object + } ) -setMethod("show", "mcmcoutputpermfixhierpost", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" postperm : List of", - length(object@postperm), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermfixhierpost", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " postperm : List of", + length(object@postperm), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermfixhierpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson.Hier( x, dev ) - } else if ( dist == "binomial" ) { - .permtraces.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .permtraces.Normal.Hier( x, dev ) - } else if ( dist == "student" ) { - .permtraces.Student.Hier( x, dev ) - } else if ( dist == "normult" ) { - .permtraces.Normult.Hier( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult.Hier( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermfixhierpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential(x, dev) + } else if (dist == "normal") { + .permtraces.Normal.Hier(x, dev) + } else if (dist == "student") { + .permtraces.Student.Hier(x, dev) + } else if (dist == "normult") { + .permtraces.Normult.Hier(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult.Hier(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permhist.Poisson.Hier(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson.Hier(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson.Hier(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermfixhierpost", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermfixhierpost", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermfixhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermfixhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) - diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index 1bf376f..f0d8ca1 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -16,157 +16,185 @@ # along with finmix. If not, see . .mcmcoutputpermfixpost <- setClass("mcmcoutputpermfixpost", - contains = c("mcmcpermfixpost", - "mcmcoutputfixpost"), - validity = function(object) - { - ## else: OK - TRUE - } + contains = c( + "mcmcpermfixpost", + "mcmcoutputfixpost" + ), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermfixpost", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), logperm = list(), - postperm = list()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@log <- mcmcoutput@log - .Object@post <- mcmcoutput@post - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@logperm <- logperm - .Object@postperm <- postperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermfixpost", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), logperm = list(), + postperm = list()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@log <- mcmcoutput@log + .Object@post <- mcmcoutput@post + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@logperm <- logperm + .Object@postperm <- postperm + .Object + } ) -setMethod("show", "mcmcoutputpermfixpost", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" postperm : List of", - length(object@postperm), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermfixpost", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " postperm : List of", + length(object@postperm), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermfixpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson( x, dev ) - } else if (dist == "binomial" ) { - .permtraces.Binomial( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential( x, dev ) - } else if ( dist == "normal" ) { - .permtraces.Normal( x, dev ) - } else if ( dist == "student" ) { - .permtraces.Student( x, dev ) - } else if ( dist == "normult" ) { - .permtraces.Normult( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermfixpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential(x, dev) + } else if (dist == "normal") { + .permtraces.Normal(x, dev) + } else if (dist == "student") { + .permtraces.Student(x, dev) + } else if (dist == "normult") { + .permtraces.Normult(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permhist.Poisson(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermfixpost", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermfixpost", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermfixpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermfixpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) - diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index 9248e5a..f7903ee 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -16,195 +16,240 @@ # along with finmix. If not, see . .mcmcoutputpermhier <- setClass("mcmcoutputpermhier", - contains = c("mcmcpermind", - "mcmcoutputhier"), - validity = function(object) - { - ## else: OK - TRUE - } + contains = c( + "mcmcpermind", + "mcmcoutputhier" + ), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermhier", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), relabel = character(), - weightperm = array(), logperm = list(), - entropyperm = array(), STperm = array(), - Sperm = array(), NKperm = array()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@weight <- mcmcoutput@weight - .Object@log <- mcmcoutput@log - .Object@hyper <- mcmcoutput@hyper - .Object@ST <- mcmcoutput@ST - .Object@S <- mcmcoutput@S - .Object@NK <- mcmcoutput@NK - .Object@clust <- mcmcoutput@clust - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@relabel <- relabel - .Object@weightperm <- weightperm - .Object@logperm <- logperm - .Object@entropyperm <- entropyperm - .Object@STperm <- STperm - .Object@Sperm <- Sperm - .Object@NKperm <- NKperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermhier", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), relabel = character(), + weightperm = array(), logperm = list(), + entropyperm = array(), STperm = array(), + Sperm = array(), NKperm = array()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@weight <- mcmcoutput@weight + .Object@log <- mcmcoutput@log + .Object@hyper <- mcmcoutput@hyper + .Object@ST <- mcmcoutput@ST + .Object@S <- mcmcoutput@S + .Object@NK <- mcmcoutput@NK + .Object@clust <- mcmcoutput@clust + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@relabel <- relabel + .Object@weightperm <- weightperm + .Object@logperm <- logperm + .Object@entropyperm <- entropyperm + .Object@STperm <- STperm + .Object@Sperm <- Sperm + .Object@NKperm <- NKperm + .Object + } ) -setMethod("show", "mcmcoutputpermhier", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" relabel :", object@relabel, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" weightperm :", - paste(dim(object@weightperm), collapse = "x"), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" entropyperm :", - paste(dim(object@entropyperm), collapse = "x"), "\n") - cat(" STperm :", - paste(dim(object@STperm), collapse = "x"), "\n") - if (!all(is.na(object@Sperm))) { - cat(" Sperm :", - paste(dim(object@Sperm), collapse = "x"), "\n") - } - cat(" NKperm :", - paste(dim(object@NKperm), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermhier", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" relabel :", object@relabel, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " weightperm :", + paste(dim(object@weightperm), collapse = "x"), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " entropyperm :", + paste(dim(object@entropyperm), collapse = "x"), "\n" + ) + cat( + " STperm :", + paste(dim(object@STperm), collapse = "x"), "\n" + ) + if (!all(is.na(object@Sperm))) { + cat( + " Sperm :", + paste(dim(object@Sperm), collapse = "x"), "\n" + ) + } + cat( + " NKperm :", + paste(dim(object@NKperm), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermhier", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson.Base.Hier( x, dev ) - } else if (dist == "binomial") { - .permtraces.Binomial.Base( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential.Base( x, dev ) - } else if ( dist == "normal" ) { - .permtraces.Normal.Hier( x, dev ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "student" ) { - .permtraces.Student.Hier( x, dev ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "normult" ) { - .permtraces.Normult.Hier( x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult.Hier( x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log.Base( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermhier", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial.Base(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential.Base(x, dev) + } else if (dist == "normal") { + .permtraces.Normal.Hier(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "student") { + .permtraces.Student.Hier(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "normult") { + .permtraces.Normult.Hier(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult.Hier(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log.Base(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if(dist == "poisson") { - .permhist.Poisson.Base.Hier(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial.Base(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial.Base(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson.Base.Hier(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial.Base(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial.Base(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermhier", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermhier", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermhier", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermhier", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) ### Private functions. @@ -212,86 +257,95 @@ setMethod("plotPostDens", signature(x = "mcmcoutputpermhier", ### Plot ### Traces -### Traces Poisson: Plots the traces for all Poisson +### Traces Poisson: Plots the traces for all Poisson ### parameters, the weights and the hpyer-parameter 'b'. -".permtraces.Poisson.Base.Hier" <- function(x, dev) -{ - K <- x@model@K - trace.n <- K * 2 - if (.check.grDevice() && dev) { - dev.new(title = "Traceplots (permuted)") - } - par(mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), - oma = c(4, 5, 4, 4)) - lambda <- x@parperm$lambda - for (k in 1:K) { - plot(lambda[, k], type = "l", axes = F, - col = "gray20", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(lambda[k = .(k)]), - cex = 0.6, line = 3) - } - weight <- x@weightperm - for (k in 1:(K - 1)) { - plot(weight[, k], type = "l", axes = F, - col = "gray47", xlab = "", ylab = "") - axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, bquote(eta[k = .(k)]), - cex = 0.6, line = 3) - } - b <- x@hyper$b - plot(b, type = "l", axes = F, - col = "gray68", xlab = "", ylab = "") +".permtraces.Poisson.Base.Hier" <- function(x, dev) { + K <- x@model@K + trace.n <- K * 2 + if (.check.grDevice() && dev) { + dev.new(title = "Traceplots (permuted)") + } + par( + mfrow = c(trace.n, 1), mar = c(1, 0, 0, 0), + oma = c(4, 5, 4, 4) + ) + lambda <- x@parperm$lambda + for (k in 1:K) { + plot(lambda[, k], + type = "l", axes = F, + col = "gray20", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext( + side = 2, las = 2, bquote(lambda[k = .(k)]), + cex = 0.6, line = 3 + ) + } + weight <- x@weightperm + for (k in 1:(K - 1)) { + plot(weight[, k], + type = "l", axes = F, + col = "gray47", xlab = "", ylab = "" + ) axis(2, las = 2, cex.axis = 0.7) - mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) - axis(1) - mtext(side = 1, "Iterations", cex = 0.7, line = 3) + mtext( + side = 2, las = 2, bquote(eta[k = .(k)]), + cex = 0.6, line = 3 + ) + } + b <- x@hyper$b + plot(b, + type = "l", axes = F, + col = "gray68", xlab = "", ylab = "" + ) + axis(2, las = 2, cex.axis = 0.7) + mtext(side = 2, las = 2, "b", cex = 0.6, line = 3) + axis(1) + mtext(side = 1, "Iterations", cex = 0.7, line = 3) } ### Histograms ### Histograms Poisson: plots histograms for all Poisson parameters, ### the weights and the hyper-parameter 'b'. -".permhist.Poisson.Base.Hier" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - weight <- x@weightperm - b <- x@hyper$b - vars <- cbind(lambda, weight[, seq(1:(K - 1))], b) - lab.names <- vector("list", 2 * K) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in (K + 1):(2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - lab.names[[2 * K]] <- "b" - .symmetric.Hist(vars, lab.names) +".permhist.Poisson.Base.Hier" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + weight <- x@weightperm + b <- x@hyper$b + vars <- cbind(lambda, weight[, seq(1:(K - 1))], b) + lab.names <- vector("list", 2 * K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in (K + 1):(2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + lab.names[[2 * K]] <- "b" + .symmetric.Hist(vars, lab.names) } ### Densities -### Densities Poisson: plots Kernel densities for all Poisson +### Densities Poisson: plots Kernel densities for all Poisson ### parameters, the weights and the hyper-parameter 'b'. -".permdens.Poisson.Base.Hier" <- function(x, dev) -{ - K <- x@model@K - if (.check.grDevice() && dev) { - dev.new(title = "Histograms (permuted)") - } - lambda <- x@parperm$lambda - weight <- x@weightperm - b <- x@hyper$b - vars <- cbind(lambda, weight[, seq(1:(K - 1))], b) - lab.names <- vector("list", 2 * K) - for (k in 1:K) { - lab.names[[k]] <- bquote(lambda[.(k)]) - } - for (k in (K + 1):(2 * K - 1)) { - lab.names[[k]] <- bquote(eta[.(k - K)]) - } - lab.names[[2 * K]] <- "b" - .symmetric.Dens(vars, lab.names) +".permdens.Poisson.Base.Hier" <- function(x, dev) { + K <- x@model@K + if (.check.grDevice() && dev) { + dev.new(title = "Histograms (permuted)") + } + lambda <- x@parperm$lambda + weight <- x@weightperm + b <- x@hyper$b + vars <- cbind(lambda, weight[, seq(1:(K - 1))], b) + lab.names <- vector("list", 2 * K) + for (k in 1:K) { + lab.names[[k]] <- bquote(lambda[.(k)]) + } + for (k in (K + 1):(2 * K - 1)) { + lab.names[[k]] <- bquote(eta[.(k - K)]) + } + lab.names[[2 * K]] <- "b" + .symmetric.Dens(vars, lab.names) } diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index b8953af..0c9c5e5 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -15,215 +15,269 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcoutputpermhierpost <- setClass( "mcmcoutputpermhierpost", - contains = c( "mcmcpermindpost", - "mcmcoutputhierpost" ), - validity = function( object ) - { - ## else: OK - TRUE - } +.mcmcoutputpermhierpost <- setClass("mcmcoutputpermhierpost", + contains = c( + "mcmcpermindpost", + "mcmcoutputhierpost" + ), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermhierpost", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), relabel = character(), - weightperm = array(), logperm = list(), - postperm = list(), entropyperm = array(), - STperm = array(), Sperm = array(), - NKperm = array()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@weight <- mcmcoutput@weight - .Object@log <- mcmcoutput@log - .Object@hyper <- mcmcoutput@hyper - .Object@post <- mcmcoutput@post - .Object@ST <- mcmcoutput@ST - .Object@S <- mcmcoutput@S - .Object@NK <- mcmcoutput@NK - .Object@clust <- mcmcoutput@clust - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@relabel <- relabel - .Object@weightperm <- weightperm - .Object@logperm <- logperm - .Object@postperm <- postperm - .Object@entropyperm <- entropyperm - .Object@STperm <- STperm - .Object@Sperm <- Sperm - .Object@NKperm <- NKperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermhierpost", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), relabel = character(), + weightperm = array(), logperm = list(), + postperm = list(), entropyperm = array(), + STperm = array(), Sperm = array(), + NKperm = array()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@weight <- mcmcoutput@weight + .Object@log <- mcmcoutput@log + .Object@hyper <- mcmcoutput@hyper + .Object@post <- mcmcoutput@post + .Object@ST <- mcmcoutput@ST + .Object@S <- mcmcoutput@S + .Object@NK <- mcmcoutput@NK + .Object@clust <- mcmcoutput@clust + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@relabel <- relabel + .Object@weightperm <- weightperm + .Object@logperm <- logperm + .Object@postperm <- postperm + .Object@entropyperm <- entropyperm + .Object@STperm <- STperm + .Object@Sperm <- Sperm + .Object@NKperm <- NKperm + .Object + } ) -setMethod("show", "mcmcoutputpermhierpost", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" relabel :", object@relabel, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" weight :", - paste(dim(object@weight), collapse = "x"), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" hyper : List of", - length(object@hyper), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" weightperm :", - paste(dim(object@weightperm), collapse = "x"), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" postperm : List of", - length(object@postperm), "\n") - cat(" entropyperm :", - paste(dim(object@entropyperm), collapse = "x"), "\n") - cat(" STperm :", - paste(dim(object@STperm), collapse = "x"), "\n") - if (!all(is.na(object@Sperm))) { - cat(" Sperm :", - paste(dim(object@Sperm), collapse = "x"), "\n") - } - cat(" NKperm :", - paste(dim(object@NKperm), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermhierpost", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" relabel :", object@relabel, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " weight :", + paste(dim(object@weight), collapse = "x"), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " hyper : List of", + length(object@hyper), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " weightperm :", + paste(dim(object@weightperm), collapse = "x"), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " postperm : List of", + length(object@postperm), "\n" + ) + cat( + " entropyperm :", + paste(dim(object@entropyperm), collapse = "x"), "\n" + ) + cat( + " STperm :", + paste(dim(object@STperm), collapse = "x"), "\n" + ) + if (!all(is.na(object@Sperm))) { + cat( + " Sperm :", + paste(dim(object@Sperm), collapse = "x"), "\n" + ) + } + cat( + " NKperm :", + paste(dim(object@NKperm), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermhierpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ...) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson.Base.Hier( x, dev ) - } else if ( dist == "binomial" ) { - .permtraces.Binomial.Base( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential.Base( x, dev ) - .permtraces.Weights.Base(x, dev, col ) - } else if ( dist == "normal" ) { - .permtraces.Normal.Hier( x, dev ) - .permtraces.Weights.Base(x, dev, col ) - } else if ( dist == "student" ) { - .permtraces.Student.Hier( x, dev ) - .permtraces.Weights.base(x, dev, col ) - } else if ( dist == "normult" ) { - .permtraces.Normult.Hier( x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult.Hier( x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log.Base( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermhierpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial.Base(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential.Base(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "normal") { + .permtraces.Normal.Hier(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "student") { + .permtraces.Student.Hier(x, dev) + .permtraces.Weights.base(x, dev, col) + } else if (dist == "normult") { + .permtraces.Normult.Hier(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult.Hier(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log.Base(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if(dist == "poisson") { - .permhist.Poisson.Base.Hier(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial.Base(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial.Base(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson.Base.Hier(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial.Base(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson.Base.Hier(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial.Base(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermhierpost", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermhierpost", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermhierpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermhierpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) -setClassUnion("mcmcoutputperm", - c("mcmcoutputpermfix", - "mcmcoutputpermfixhier", - "mcmcoutputpermfixpost", - "mcmcoutputpermfixhierpost", - "mcmcoutputpermbase", - "mcmcoutputpermhier", - "mcmcoutputpermpost", - "mcmcoutputpermhierpost") +setClassUnion( + "mcmcoutputperm", + c( + "mcmcoutputpermfix", + "mcmcoutputpermfixhier", + "mcmcoutputpermfixpost", + "mcmcoutputpermfixhierpost", + "mcmcoutputpermbase", + "mcmcoutputpermhier", + "mcmcoutputpermpost", + "mcmcoutputpermhierpost" + ) ) diff --git a/R/mcmcoutputpermpost.R b/R/mcmcoutputpermpost.R index 9ee8939..a931424 100644 --- a/R/mcmcoutputpermpost.R +++ b/R/mcmcoutputpermpost.R @@ -16,201 +16,248 @@ # along with finmix. If not, see . .mcmcoutputpermpost <- setClass("mcmcoutputpermpost", - contains = c("mcmcpermindpost", - "mcmcoutputpost"), - validity = function(object) - { - ## else: OK - TRUE - } + contains = c( + "mcmcpermindpost", + "mcmcoutputpost" + ), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "mcmcoutputpermpost", - function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), relabel = character(), - weightperm = array(), logperm = list(), - postperm = list(), entropyperm = array(), - STperm = array(), Sperm = array(), - NKperm = array()) - { - .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcoutput@burnin - .Object@ranperm <- mcmcoutput@ranperm - .Object@par <- mcmcoutput@par - .Object@weight <- mcmcoutput@weight - .Object@log <- mcmcoutput@log - .Object@post <- mcmcoutput@post - .Object@ST <- mcmcoutput@ST - .Object@S <- mcmcoutput@S - .Object@NK <- mcmcoutput@NK - .Object@clust <- mcmcoutput@clust - .Object@model <- mcmcoutput@model - .Object@prior <- mcmcoutput@prior - .Object@Mperm <- Mperm - .Object@parperm <- parperm - .Object@relabel <- relabel - .Object@weightperm <- weightperm - .Object@logperm <- logperm - .Object@postperm <- postperm - .Object@entropyperm <- entropyperm - .Object@STperm <- STperm - .Object@Sperm <- Sperm - .Object@NKperm <- NKperm - .Object - } +setMethod( + "initialize", "mcmcoutputpermpost", + function(.Object, mcmcoutput, Mperm = integer(), + parperm = list(), relabel = character(), + weightperm = array(), logperm = list(), + postperm = list(), entropyperm = array(), + STperm = array(), Sperm = array(), + NKperm = array()) { + .Object@M <- mcmcoutput@M + .Object@burnin <- mcmcoutput@burnin + .Object@ranperm <- mcmcoutput@ranperm + .Object@par <- mcmcoutput@par + .Object@weight <- mcmcoutput@weight + .Object@log <- mcmcoutput@log + .Object@post <- mcmcoutput@post + .Object@ST <- mcmcoutput@ST + .Object@S <- mcmcoutput@S + .Object@NK <- mcmcoutput@NK + .Object@clust <- mcmcoutput@clust + .Object@model <- mcmcoutput@model + .Object@prior <- mcmcoutput@prior + .Object@Mperm <- Mperm + .Object@parperm <- parperm + .Object@relabel <- relabel + .Object@weightperm <- weightperm + .Object@logperm <- logperm + .Object@postperm <- postperm + .Object@entropyperm <- entropyperm + .Object@STperm <- STperm + .Object@Sperm <- Sperm + .Object@NKperm <- NKperm + .Object + } ) -setMethod("show", "mcmcoutputpermpost", - function(object) - { - cat("Object 'mcmcoutputperm'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" relabel :", object@relabel, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" weight :", - paste(dim(object@weight), collapse = "x"), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" Mperm :", object@Mperm, "\n") - cat(" parperm : List of", - length(object@parperm), "\n") - cat(" weightperm :", - paste(dim(object@weightperm), collapse = "x"), "\n") - cat(" logperm : List of", - length(object@logperm), "\n") - cat(" postperm : List of", - length(object@postperm), "\n") - cat(" entropyperm :", - paste(dim(object@entropyperm), collapse = "x"), "\n") - cat(" STperm :", - paste(dim(object@STperm), collapse = "x"), "\n") - if (!all(is.na(object@Sperm))) { - cat(" Sperm :", - paste(dim(object@Sperm), collapse = "x"), "\n") - } - cat(" NKperm :", - paste(dim(object@NKperm), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpermpost", + function(object) { + cat("Object 'mcmcoutputperm'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat(" relabel :", object@relabel, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " weight :", + paste(dim(object@weight), collapse = "x"), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat(" Mperm :", object@Mperm, "\n") + cat( + " parperm : List of", + length(object@parperm), "\n" + ) + cat( + " weightperm :", + paste(dim(object@weightperm), collapse = "x"), "\n" + ) + cat( + " logperm : List of", + length(object@logperm), "\n" + ) + cat( + " postperm : List of", + length(object@postperm), "\n" + ) + cat( + " entropyperm :", + paste(dim(object@entropyperm), collapse = "x"), "\n" + ) + cat( + " STperm :", + paste(dim(object@STperm), collapse = "x"), "\n" + ) + if (!all(is.na(object@Sperm))) { + cat( + " Sperm :", + paste(dim(object@Sperm), collapse = "x"), "\n" + ) + } + cat( + " NKperm :", + paste(dim(object@NKperm), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpermpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function( x, dev = TRUE, lik = 1, col = FALSE, ... ) - { - dist <- x@model@dist - if ( lik %in% c( 0, 1 ) ) { - if ( dist == "poisson" ) { - .permtraces.Poisson.Base( x, dev ) - } else if ( dist == "binomial" ) { - .permtraces.Binomial.Base( x, dev ) - } else if ( dist == "exponential" ) { - .permtraces.Exponential.Base( x, dev ) - } else if ( dist == "normal" ) { - .permtraces.Normal( x, dev ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "student" ) { - .permtraces.Student( x, dev ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "normult" ) { - .permtraces.Normult( x, dev, col ) - .permtraces.Weights.Base( x, dev, col ) - } else if ( dist == "studmult" ) { - .permtraces.Studmult( x, dev, col ) - .permtraces.Weights.Base(x, dev, col ) - } - - } - if ( lik %in% c( 1, 2 ) ) { - ## log ## - .permtraces.Log.Base( x, dev ) - } - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpermpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + dist <- x@model@dist + if (lik %in% c(0, 1)) { + if (dist == "poisson") { + .permtraces.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .permtraces.Binomial.Base(x, dev) + } else if (dist == "exponential") { + .permtraces.Exponential.Base(x, dev) + } else if (dist == "normal") { + .permtraces.Normal(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "student") { + .permtraces.Student(x, dev) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "normult") { + .permtraces.Normult(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } else if (dist == "studmult") { + .permtraces.Studmult(x, dev, col) + .permtraces.Weights.Base(x, dev, col) + } + } + if (lik %in% c(1, 2)) { + ## log ## + .permtraces.Log.Base(x, dev) + } + } ) -setMethod("plotHist", signature(x = "mcmcoutputpermpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permhist.Poisson.Base(x, dev) - } else if (dist == "binomial") { - .permhist.Binomial.Base(x, dev) - } - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpermpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permhist.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .permhist.Binomial.Base(x, dev) + } + } ) -setMethod("plotDens", signature(x = "mcmcoutputpermpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permdens.Poisson.Base(x, dev) - } else if (dist == "binomial") { - .permdens.Binomial.Base(x, dev) - } - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpermpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permdens.Poisson.Base(x, dev) + } else if (dist == "binomial") { + .permdens.Binomial.Base(x, dev) + } + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpermpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpointproc.Poisson(x, dev) - } else if (dist == "binomial") { - .permpointproc.Binomial(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpermpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpointproc.Poisson(x, dev) + } else if (dist == "binomial") { + .permpointproc.Binomial(x, dev) + } + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpermpost", - dev = "ANY"), - function(x, dev, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permsamprep.Poisson(x, dev) - } else if (dist == "binomial") { - .permsamprep.Binomial(x, dev) - } - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpermpost", + dev = "ANY" + ), + function(x, dev, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permsamprep.Poisson(x, dev) + } else if (dist == "binomial") { + .permsamprep.Binomial(x, dev) + } + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpermpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - dist <- x@model@dist - if (dist == "poisson") { - .permpostdens.Poisson(x, dev) - } else if (dist == "binomial") { - .permpostdens.Binomial(x, dev) - } - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpermpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + dist <- x@model@dist + if (dist == "poisson") { + .permpostdens.Poisson(x, dev) + } else if (dist == "binomial") { + .permpostdens.Binomial(x, dev) + } + } ) - diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index 8edd221..add9aab 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -16,151 +16,184 @@ # along with finmix. If not, see . .mcmcoutputpost <- setClass("mcmcoutputpost", - representation(post = "list"), - contains = c("mcmcoutputbase"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(post = list()) + representation(post = "list"), + contains = c("mcmcoutputbase"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(post = list()) ) -setMethod("show", "mcmcoutputpost", - function(object) - { - cat("Object 'mcmcoutput'\n") - cat(" class :", class(object), "\n") - cat(" M :", object@M, "\n") - cat(" burnin :", object@burnin, "\n") - cat(" ranperm :", object@ranperm, "\n") - cat(" par : List of", - length(object@par), "\n") - cat(" log : List of", - length(object@log), "\n") - cat(" post : List of", - length(object@post), "\n") - cat(" ST :", - paste(dim(object@ST), collapse = "x"), "\n") - if (!all(is.na(object@S))) { - cat(" S :", - paste(dim(object@S), collapse = "x"), "\n") - } - cat(" NK :", - paste(dim(object@NK), collapse = "x"), "\n") - cat(" clust :", - paste(dim(object@clust), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - cat(" prior : Object of class", - class(object@prior), "\n") - } +setMethod( + "show", "mcmcoutputpost", + function(object) { + cat("Object 'mcmcoutput'\n") + cat(" class :", class(object), "\n") + cat(" M :", object@M, "\n") + cat(" burnin :", object@burnin, "\n") + cat(" ranperm :", object@ranperm, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + cat( + " log : List of", + length(object@log), "\n" + ) + cat( + " post : List of", + length(object@post), "\n" + ) + cat( + " ST :", + paste(dim(object@ST), collapse = "x"), "\n" + ) + if (!all(is.na(object@S))) { + cat( + " S :", + paste(dim(object@S), collapse = "x"), "\n" + ) + } + cat( + " NK :", + paste(dim(object@NK), collapse = "x"), "\n" + ) + cat( + " clust :", + paste(dim(object@clust), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + cat( + " prior : Object of class", + class(object@prior), "\n" + ) + } ) -setMethod( "plotTraces", signature( x = "mcmcoutputpost", - dev = "ANY", - lik = "ANY", - col = "ANY" ), - function(x, dev = TRUE, lik = 1, col = FALSE, ...) - { - ## Call 'plot()' from 'mcmcoutputbase' - callNextMethod(x, dev, lik, col, ...) - } +setMethod( + "plotTraces", signature( + x = "mcmcoutputpost", + dev = "ANY", + lik = "ANY", + col = "ANY" + ), + function(x, dev = TRUE, lik = 1, col = FALSE, ...) { + ## Call 'plot()' from 'mcmcoutputbase' + callNextMethod(x, dev, lik, col, ...) + } ) -setMethod("plotHist", signature(x = "mcmcoutputpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotHist()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotHist", signature( + x = "mcmcoutputpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotHist()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotDens", signature(x = "mcmcoutputpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotDens()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotDens", signature( + x = "mcmcoutputpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotDens()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPointProc", signature(x = "mcmcoutputpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPointProc()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPointProc", signature( + x = "mcmcoutputpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPointProc()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotSampRep", signature(x = "mcmcoutputpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotSampRep()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotSampRep", signature( + x = "mcmcoutputpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotSampRep()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("plotPostDens", signature(x = "mcmcoutputpost", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - ## Call 'plotPostDens()' from 'mcmcoutputbase' - callNextMethod(x, dev, ...) - } +setMethod( + "plotPostDens", signature( + x = "mcmcoutputpost", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + ## Call 'plotPostDens()' from 'mcmcoutputbase' + callNextMethod(x, dev, ...) + } ) -setMethod("subseq", signature( object = "mcmcoutputpost", - index = "array" ), - function( object, index ) - { - ## Call 'subseq()' from 'mcmcoutputbase' - callNextMethod( object, index ) - ## Change owned slots ## - dist <- object@model@dist - if ( dist == "poisson" ) { - .subseq.Poisson.Post( object, index ) - } else if ( dist == "binomial" ) { - .subseq.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .subseq.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .subseq.Normultstud.Mcmcoutputfixpost( object, index ) - } - } +setMethod( + "subseq", signature( + object = "mcmcoutputpost", + index = "array" + ), + function(object, index) { + ## Call 'subseq()' from 'mcmcoutputbase' + callNextMethod(object, index) + ## Change owned slots ## + dist <- object@model@dist + if (dist == "poisson") { + .subseq.Poisson.Post(object, index) + } else if (dist == "binomial") { + .subseq.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .subseq.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .subseq.Normultstud.Mcmcoutputfixpost(object, index) + } + } ) -setMethod( "swapElements", signature( object = "mcmcoutputpost", - index = "array"), - function( object, index ) - { - if( object@model@K == 1 ) { - return( object ) - } else { - dist <- object@model@dist - ## Call method 'swapElements()' from 'mcmcoutputbase' - as( object, "mcmcoutputbase" ) <- callNextMethod( object, index ) - if ( dist == "poisson" ) { - .swapElements.Poisson.Post( object, index ) - } else if ( dist == "binomial" ) { - .swapElements.Binomial.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normal", "student" ) ) { - .swapElements.Norstud.Mcmcoutputfixpost( object, index ) - } else if ( dist %in% c( "normult", "studmult" ) ) { - .swapElements.Normultstud.Mcmcoutputfixpost( object, index ) - } - } - } +setMethod( + "swapElements", signature( + object = "mcmcoutputpost", + index = "array" + ), + function(object, index) { + if (object@model@K == 1) { + return(object) + } else { + dist <- object@model@dist + ## Call method 'swapElements()' from 'mcmcoutputbase' + as(object, "mcmcoutputbase") <- callNextMethod(object, index) + if (dist == "poisson") { + .swapElements.Poisson.Post(object, index) + } else if (dist == "binomial") { + .swapElements.Binomial.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normal", "student")) { + .swapElements.Norstud.Mcmcoutputfixpost(object, index) + } else if (dist %in% c("normult", "studmult")) { + .swapElements.Normultstud.Mcmcoutputfixpost(object, index) + } + } + } ) -setMethod( "getPost", "mcmcoutputpost", - function( object ) - { - return( object@post ) - } +setMethod( + "getPost", "mcmcoutputpost", + function(object) { + return(object@post) + } ) ## No setters as users are not intended to manipulate ## diff --git a/R/mcmcpermfix.R b/R/mcmcpermfix.R index fb203c0..84e8f9c 100644 --- a/R/mcmcpermfix.R +++ b/R/mcmcpermfix.R @@ -15,43 +15,44 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.mcmcpermfix <- setClass("mcmcpermfix", - representation( - Mperm = "integer", - parperm = "list", - logperm = "list"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(Mperm = integer(), - parperm = list(), - logperm = list() - ) +.mcmcpermfix <- setClass("mcmcpermfix", + representation( + Mperm = "integer", + parperm = "list", + logperm = "list" + ), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + Mperm = integer(), + parperm = list(), + logperm = list() + ) ) ## Getters ## -setMethod("getMperm", "mcmcpermfix", - function(object) - { - return(object@Mperm) - } +setMethod( + "getMperm", "mcmcpermfix", + function(object) { + return(object@Mperm) + } ) -setMethod("getParperm", "mcmcpermfix", - function(object) - { - return(object@parperm) - } +setMethod( + "getParperm", "mcmcpermfix", + function(object) { + return(object@parperm) + } ) -setMethod("getLogperm", "mcmcpermfix", - function(object) - { - return(object@logperm) - } +setMethod( + "getLogperm", "mcmcpermfix", + function(object) { + return(object@logperm) + } ) ## No setters as users are not intended to modify these ## -## obect. ## +## objects. ## diff --git a/R/mcmcpermfixpost.R b/R/mcmcpermfixpost.R index e0e355e..605637f 100644 --- a/R/mcmcpermfixpost.R +++ b/R/mcmcpermfixpost.R @@ -16,23 +16,22 @@ # along with Rcpp. If not, see . .mcmcpermfixpost <- setClass("mcmcpermfixpost", - representation(postperm = "list"), - contains = c("mcmcpermfix"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(postperm = list()) + representation(postperm = "list"), + contains = c("mcmcpermfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(postperm = list()) ) ## Getters ## -setMethod("getPostperm", "mcmcpermfixpost", - function(object) - { - return(object@postperm) - } +setMethod( + "getPostperm", "mcmcpermfixpost", + function(object) { + return(object@postperm) + } ) ## No setters implemented as users are not intended to -## manipulate this object +## manipulate this object diff --git a/R/mcmcpermind.R b/R/mcmcpermind.R index 2a7cfbb..7a3e8d1 100644 --- a/R/mcmcpermind.R +++ b/R/mcmcpermind.R @@ -15,70 +15,71 @@ # You should have received a copy of the GNU General Public License # along with Rcpp. If not, see . -.mcmcpermind <- setClass("mcmcpermind", - representation(relabel = "character", - weightperm = "array", - entropyperm = "array", - STperm = "array", - Sperm = "array", - NKperm = "array" - ), - contains = c("mcmcpermfix"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(relabel = character(), - weightperm = array(), - entropyperm = array(), - STperm = array(), - Sperm = array(), - NKperm = array() - ) +.mcmcpermind <- setClass("mcmcpermind", + representation( + relabel = "character", + weightperm = "array", + entropyperm = "array", + STperm = "array", + Sperm = "array", + NKperm = "array" + ), + contains = c("mcmcpermfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + relabel = character(), + weightperm = array(), + entropyperm = array(), + STperm = array(), + Sperm = array(), + NKperm = array() + ) ) ## Getters ## -setMethod("getRelabel", "mcmcpermind", - function(object) - { - return(object@relabel) - } +setMethod( + "getRelabel", "mcmcpermind", + function(object) { + return(object@relabel) + } ) -setMethod("getWeightperm", "mcmcpermind", - function(object) - { - return(object@weightperm) - } +setMethod( + "getWeightperm", "mcmcpermind", + function(object) { + return(object@weightperm) + } ) -setMethod("getEntropyperm", "mcmcpermind", - function(object) - { - return(object@entropyperm) - } +setMethod( + "getEntropyperm", "mcmcpermind", + function(object) { + return(object@entropyperm) + } ) -setMethod("getSTperm", "mcmcpermind", - function(object) - { - return(object@STperm) - } +setMethod( + "getSTperm", "mcmcpermind", + function(object) { + return(object@STperm) + } ) -setMethod("getSperm", "mcmcpermind", - function(object) - { - return(object@STperm) - } +setMethod( + "getSperm", "mcmcpermind", + function(object) { + return(object@STperm) + } ) -setMethod("getNKperm", "mcmcpermind", - function(object) - { - return(object@STperm) - } +setMethod( + "getNKperm", "mcmcpermind", + function(object) { + return(object@STperm) + } ) ## No setters as users are not intended to modify these ## diff --git a/R/mcmcpermindpost.R b/R/mcmcpermindpost.R index 166e006..4602faa 100644 --- a/R/mcmcpermindpost.R +++ b/R/mcmcpermindpost.R @@ -16,23 +16,22 @@ # along with finmix. If not, see . .mcmcpermindpost <- setClass("mcmcpermindpost", - representation(postperm = "list"), - contains = c("mcmcpermind"), - validity = function(object) - { - ## else: OK - TRUE - }, - prototype(postperm = list()) + representation(postperm = "list"), + contains = c("mcmcpermind"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(postperm = list()) ) ## Getters ## -setMethod("getPostperm", "mcmcpermindpost", - function(object) - { - return(object@postperm) - } +setMethod( + "getPostperm", "mcmcpermindpost", + function(object) { + return(object@postperm) + } ) -## No setters as users are not intended to manipulate +## No setters as users are not intended to manipulate ## this objects diff --git a/R/mcmcpermute.R b/R/mcmcpermute.R index 6bb3ae3..cb32838 100644 --- a/R/mcmcpermute.R +++ b/R/mcmcpermute.R @@ -15,81 +15,83 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -"mcmcpermute" <- function( mcmcout, fdata = NULL, method = "kmeans", opt_ctrl=list(max_iter=200L) ) { - ## Check arguments ## - .check.arg.Mcmcpermute( mcmcout ) - match.arg( method, c( "kmeans", "Stephens1997a", "Stephens1997b" ) ) - if (!is.numeric(opt_ctrl$max_iter)) { - stop("Max. iterations 'max_iter' in list 'opt_ctrl' needs to be of type integer.") - } else { - opt_ctrl$max_iter <- as.integer(opt_ctrl$max_iter) - } - mcmcout <- .coerce.Mcmcpermute( mcmcout ) - if ( method == "kmeans" ) { - .kmeans.Mcmcpermute(mcmcout) - } else if ( method == "Stephens1997a" ) { - .stephens1997a.Mcmcpermute( mcmcout ) - } else { - .stephens1997b.Mcmcpermute( mcmcout, fdata, opt_ctrl$max_iter ) - } +"mcmcpermute" <- function(mcmcout, fdata = NULL, method = "kmeans", opt_ctrl = list(max_iter = 200L)) { + ## Check arguments ## + .check.arg.Mcmcpermute(mcmcout) + match.arg(method, c("kmeans", "Stephens1997a", "Stephens1997b")) + if (!is.numeric(opt_ctrl$max_iter)) { + stop("Max. iterations 'max_iter' in list 'opt_ctrl' needs to be of type integer.") + } else { + opt_ctrl$max_iter <- as.integer(opt_ctrl$max_iter) + } + mcmcout <- .coerce.Mcmcpermute(mcmcout) + if (method == "kmeans") { + .kmeans.Mcmcpermute(mcmcout) + } else if (method == "Stephens1997a") { + .stephens1997a.Mcmcpermute(mcmcout) + } else { + .stephens1997b.Mcmcpermute(mcmcout, fdata, opt_ctrl$max_iter) + } } ### Private functions. ### These functions are not exported. ### Checking -### Check arguments: Checks if the 'mcmcout' object is of -### class 'mcmcoutput' or 'mcmcoutputperm'. If not an +### Check arguments: Checks if the 'mcmcout' object is of +### class 'mcmcoutput' or 'mcmcoutputperm'. If not an ### error is thrown. -".check.arg.Mcmcpermute" <- function( obj ) -{ - if ( !inherits( obj, c( "mcmcoutput", "mcmcoutputperm" ) ) ) { - stop( paste( "Unkown argument: Argument 1 must inherit either from", - "class 'mcmcoutput' or from class 'mcmcoutputperm'.", - sep = "" ) ) - } - if ( obj@model@indicfix ) { - warning( paste( "Slot 'indicfix' of 'model' object is ", - "set to TRUE. For a model with fixed ", - "indicators no permutations can be done.", - sep = "" ) ) - return( obj ) - } - if ( obj@model@K == 1 ) { - warning( paste( "Slot 'K' of model object is set to one. ", - "For a model with only one component no ", - "permutations can be done.", sep = "" ) ) - return( obj ) - } +".check.arg.Mcmcpermute" <- function(obj) { + if (!inherits(obj, c("mcmcoutput", "mcmcoutputperm"))) { + stop(paste("Unkown argument: Argument 1 must inherit either from", + "class 'mcmcoutput' or from class 'mcmcoutputperm'.", + sep = "" + )) + } + if (obj@model@indicfix) { + warning(paste("Slot 'indicfix' of 'model' object is ", + "set to TRUE. For a model with fixed ", + "indicators no permutations can be done.", + sep = "" + )) + return(obj) + } + if (obj@model@K == 1) { + warning(paste("Slot 'K' of model object is set to one. ", + "For a model with only one component no ", + "permutations can be done.", + sep = "" + )) + return(obj) + } } ### Coercing ### Coerces any 'mcmcoutputperm' object to its corresponding ### 'mcmcoutput' object. -".coerce.Mcmcpermute" <- function(obj) -{ - ## If object is of class 'mcmcoutputperm' coerce it - ## to an object of class 'mcmcoutput' - if(inherits(obj, "mcmcoutputperm")) { - if (class(obj) == "mcmcoutputpermfix") { - obj <- as(obj, "mcmcoutputfix") - } else if (class(obj) == "mcmcoutputpermfixhier") { - obj <- as(obj, "mcmcoutputfixhier") - } else if (class(obj) == "mcmcoutputpermfixpost") { - obj <- as(obj, "mcmcoutputfixpost") - } else if (class(obj) == "mcmcoutputpermfixhierpost") { - obj <- as(obj, "mcmcoutputfixhierpost") - } else if (class(obj) == "mcmcoutputpermbase") { - obj <- as(obj, "mcmcoutputbase") - } else if (class(obj) == "mcmcoutputpermhier") { - obj <- as(obj, "mcmcoutputhier") - } else if (class(obj) == "mcmcoutputpermpost") { - obj <- as(obj, "mcmcoutputpost") - } else { - obj <- as(obj, "mcmcoutputhierpost") - } +".coerce.Mcmcpermute" <- function(obj) { + ## If object is of class 'mcmcoutputperm' coerce it + ## to an object of class 'mcmcoutput' + if (inherits(obj, "mcmcoutputperm")) { + if (class(obj) == "mcmcoutputpermfix") { + obj <- as(obj, "mcmcoutputfix") + } else if (class(obj) == "mcmcoutputpermfixhier") { + obj <- as(obj, "mcmcoutputfixhier") + } else if (class(obj) == "mcmcoutputpermfixpost") { + obj <- as(obj, "mcmcoutputfixpost") + } else if (class(obj) == "mcmcoutputpermfixhierpost") { + obj <- as(obj, "mcmcoutputfixhierpost") + } else if (class(obj) == "mcmcoutputpermbase") { + obj <- as(obj, "mcmcoutputbase") + } else if (class(obj) == "mcmcoutputpermhier") { + obj <- as(obj, "mcmcoutputhier") + } else if (class(obj) == "mcmcoutputpermpost") { + obj <- as(obj, "mcmcoutputpost") + } else { + obj <- as(obj, "mcmcoutputhierpost") } - return(obj) + } + return(obj) } ### Permutation @@ -100,307 +102,323 @@ ### and are deleted from the sample. ### If no permutation is possible a warning is thrown. ### See .process.output.empty.Mcmcpermute(). -".kmeans.Mcmcpermute" <- function( obj ) -{ - K <- obj@model@K - M <- obj@M - r <- obj@model@r - dist <- obj@model@dist - ## Calculate maximum a posterior estimate (MAP) - map.index <- .map.Mcmcestimate( obj ) - map <- .extract.Mcmcestimate( obj, map.index ) - if ( dist == "poisson" ) { - clust.par <- sqrt( obj@par$lambda ) - clust.par <- as.vector( clust.par ) - clust.center <- sqrt( map$par$lambda ) - } else if ( dist == "binomial" ) { - clust.par <- sqrt( obj@par$p ) - clust.par <- as.vector( clust.par ) - clust.center <- sqrt( map$par$p ) - } else if ( dist == "normal" ) { - clust.par <- obj@par - clust.par$sigma <- sqrt( clust.par$sigma ) - clust.par <- cbind( as.vector( clust.par$mu ), as.vector( clust.par$sigma ) ) - clust.center <- cbind( map$par$mu, sqrt( map$par$sigma ) ) - } else if ( dist == "student" ) { - clust.par <- obj@par - clust.par$sigma <- sqrt( clust.par$sigma ) - clust.par <- cbind( as.vector( clust.par$mu ), as.vector( clust.par$sigma ), - as.vector( clust.par$df ) ) - clust.center <- cbind( map$par$mu, sqrt( map$par$sigma ), map$par$df ) - } else if ( dist == "normult" ) { - clust.par <- obj@par - indexdiag <- diag( qinmatr( seq( 1, r * ( r + 1 ) / 2 ) ) ) - indexdiag2 <- diag( matrix( seq( 1, r^2 ), nrow = r, byrow = TRUE ) ) - clust.par.sigma <- matrix( aperm( obj@par$sigma[, indexdiag, ], c( 3, 1, 2 ) ), - nrow = K * M ) - clust.par.mu <- matrix( aperm( obj@par$mu, c( 3, 1, 2 ) ), - nrow = K * M ) - clust.par <- cbind( clust.par.mu, clust.par.sigma ) - clust.center <- cbind( t( map$par$mu ), t( qincolmult( map$par$sigma )[indexdiag,] ) ) - } else if ( dist == "studmult" ) { - clust.par <- obj@par - indexdiag <- diag( qinmatr( seq( 1, r * ( r + 1 ) / 2 ) ) ) - indexdiag2 <- diag( matrix( seq( 1, r^2 ), nrow = r, byrow = TRUE ) ) - clust.par.sigma <- matrix( aperm( obj@par$sigma[, indexdiag, ], c( 3, 1, 2 ) ), - nrow = K * M ) - clust.par.mu <- matrix( aperm( obj@par$mu, c( 3, 1, 2 ) ), - nrow = K * M ) - clust.par <- cbind( clust.par.mu, clust.par.sigma ) - clust.center <- cbind( t( map$par$mu ), t( qincolmult( map$par$sigma )[indexdiag,] ) ) - } - ## Apply unsupervised k-means clustering to parameters - if ( dist %in% c( "poisson", "binomial", "exponential" ) ) { - result.clust <- kmeans( clust.par, centers = as.vector( clust.center ) ) - } else { - result.clust <- kmeans( clust.par, centers = clust.center ) - } - ## Parameters have been stacked vertically into a vector. Reorder. - perm.index <- array( result.clust$clust, dim = c( M, K ) ) - ## Check if each cluster has been hit. - comp.index <- as.array( matrix( seq( 1:K ), nrow = M, ncol = K, - byrow = TRUE ) ) - keep.index <- ( t( apply( perm.index, 1, sort, FALSE ) ) - == comp.index ) - is.perm <- array( apply( keep.index, 1, all ) ) - nonperm <- sum( !is.perm ) - if ( nonperm < M ) { - ## Create a subsequence of the MCMC output - obj.subseq <- subseq( obj, is.perm ) - ## Apply permutation suggested by kmeans clustering - obj.swap <- swapElements( obj.subseq, perm.index[is.perm,] ) - ## Create 'mcmcoutputperm' objects - .process.output.Mcmcpermute( obj, obj.swap, method = "kmeans" ) - } else { - .process.output.empty.Mcmcpermute( obj, method = "kmeans" ) - } +".kmeans.Mcmcpermute" <- function(obj) { + K <- obj@model@K + M <- obj@M + r <- obj@model@r + dist <- obj@model@dist + ## Calculate maximum a posterior estimate (MAP) + map.index <- .map.Mcmcestimate(obj) + map <- .extract.Mcmcestimate(obj, map.index) + if (dist == "poisson") { + clust.par <- sqrt(obj@par$lambda) + clust.par <- as.vector(clust.par) + clust.center <- sqrt(map$par$lambda) + } else if (dist == "binomial") { + clust.par <- sqrt(obj@par$p) + clust.par <- as.vector(clust.par) + clust.center <- sqrt(map$par$p) + } else if (dist == "normal") { + clust.par <- obj@par + clust.par$sigma <- sqrt(clust.par$sigma) + clust.par <- cbind(as.vector(clust.par$mu), as.vector(clust.par$sigma)) + clust.center <- cbind(map$par$mu, sqrt(map$par$sigma)) + } else if (dist == "student") { + clust.par <- obj@par + clust.par$sigma <- sqrt(clust.par$sigma) + clust.par <- cbind( + as.vector(clust.par$mu), as.vector(clust.par$sigma), + as.vector(clust.par$df) + ) + clust.center <- cbind(map$par$mu, sqrt(map$par$sigma), map$par$df) + } else if (dist == "normult") { + clust.par <- obj@par + indexdiag <- diag(qinmatr(seq(1, r * (r + 1) / 2))) + indexdiag2 <- diag(matrix(seq(1, r^2), nrow = r, byrow = TRUE)) + clust.par.sigma <- matrix(aperm(obj@par$sigma[, indexdiag, ], c(3, 1, 2)), + nrow = K * M + ) + clust.par.mu <- matrix(aperm(obj@par$mu, c(3, 1, 2)), + nrow = K * M + ) + clust.par <- cbind(clust.par.mu, clust.par.sigma) + clust.center <- cbind(t(map$par$mu), t(qincolmult(map$par$sigma)[indexdiag, ])) + } else if (dist == "studmult") { + clust.par <- obj@par + indexdiag <- diag(qinmatr(seq(1, r * (r + 1) / 2))) + indexdiag2 <- diag(matrix(seq(1, r^2), nrow = r, byrow = TRUE)) + clust.par.sigma <- matrix(aperm(obj@par$sigma[, indexdiag, ], c(3, 1, 2)), + nrow = K * M + ) + clust.par.mu <- matrix(aperm(obj@par$mu, c(3, 1, 2)), + nrow = K * M + ) + clust.par <- cbind(clust.par.mu, clust.par.sigma) + clust.center <- cbind(t(map$par$mu), t(qincolmult(map$par$sigma)[indexdiag, ])) + } + ## Apply unsupervised k-means clustering to parameters + if (dist %in% c("poisson", "binomial", "exponential")) { + result.clust <- kmeans(clust.par, centers = as.vector(clust.center)) + } else { + result.clust <- kmeans(clust.par, centers = clust.center) + } + ## Parameters have been stacked vertically into a vector. Reorder. + perm.index <- array(result.clust$clust, dim = c(M, K)) + ## Check if each cluster has been hit. + comp.index <- as.array(matrix(seq(1:K), + nrow = M, ncol = K, + byrow = TRUE + )) + keep.index <- (t(apply(perm.index, 1, sort, FALSE)) + == comp.index) + is.perm <- array(apply(keep.index, 1, all)) + nonperm <- sum(!is.perm) + if (nonperm < M) { + ## Create a subsequence of the MCMC output + obj.subseq <- subseq(obj, is.perm) + ## Apply permutation suggested by kmeans clustering + obj.swap <- swapElements(obj.subseq, perm.index[is.perm, ]) + ## Create 'mcmcoutputperm' objects + .process.output.Mcmcpermute(obj, obj.swap, method = "kmeans") + } else { + .process.output.empty.Mcmcpermute(obj, method = "kmeans") + } } ### Stephens1997a calling function: Calls the appropriate ### algorithm to perform a relabeling following Stephens (1997a). -### The algorithm maximizes in each iteration the logsum of the +### The algorithm maximizes in each iteration the logsum of the ### posterior likelihoods of all the parameter draws and chooses ### afterwards the best permutation of each parameter draw. ### If the log value does not change anymore, convergence ### is reached. ### If no permutation is possible, a warning is thrown. ### See .process.output.empty.Mcmcpermute(). -".stephens1997a.Mcmcpermute" <- function(obj) -{ - dist <- obj@model@dist - ## Apply Stephens1997a relabeling algorithm - if (dist == "poisson" || dist == "exponential" ) { - index <- .stephens1997a.poisson.Mcmcpermute(obj) - } - if (dist == "binomial") { - index <- .stephens1997a.binomial.Mcmcpermute(obj) - } - ## Create 'mcmcoutputperm' objects - startidx <- matrix(seq(1, obj@model@K), nrow = obj@M, - ncol = obj@model@K, byrow = TRUE) - if (!identical(startidx, index)) { - obj.swap <- swapElements(obj, index) - .process.output.Mcmcpermute(obj, obj.swap, method = "Stephens1997a") - } else { - .process.output.empty.Mcmcpermute(obj, method = "Stephens1997a") - } +".stephens1997a.Mcmcpermute" <- function(obj) { + dist <- obj@model@dist + ## Apply Stephens1997a relabeling algorithm + if (dist == "poisson" || dist == "exponential") { + index <- .stephens1997a.poisson.Mcmcpermute(obj) + } + if (dist == "binomial") { + index <- .stephens1997a.binomial.Mcmcpermute(obj) + } + ## Create 'mcmcoutputperm' objects + startidx <- matrix(seq(1, obj@model@K), + nrow = obj@M, + ncol = obj@model@K, byrow = TRUE + ) + if (!identical(startidx, index)) { + obj.swap <- swapElements(obj, index) + .process.output.Mcmcpermute(obj, obj.swap, method = "Stephens1997a") + } else { + .process.output.empty.Mcmcpermute(obj, method = "Stephens1997a") + } } -### Stephens1997a Poisson: Specific algorithm for Stephens +### Stephens1997a Poisson: Specific algorithm for Stephens ### relabeling of Poisson mixtures. In this case a bounded ### Nelder-Mead algorithm is used from the 'dfoptim' package. -".stephens1997a.poisson.Mcmcpermute" <- function(obj) -{ - M <- obj@M - K <- obj@model@K - w.mean <- apply(obj@post$weight, 2, mean) - a.mean <- apply(obj@post$par$a, 2, mean) - b.mean <- apply(obj@post$par$b, 2, mean) - startpar <- c(w.mean, a.mean, b.mean) - lambda <- obj@par$lambda - weight <- obj@weight - index <- array(integer(), dim = c(M, K)) - storage.mode(index) <- "integer" - index.out <- matrix(seq(1, K), nrow = M, ncol = K, byrow = TRUE) - storage.mode(index.out) <- "integer" - perm <- as.matrix(expand.grid(seq(1, K), seq(1, K))) - ind <- apply(perm, 1, function(x) all(x == x[1])) - perm <- perm[!ind, ] - storage.mode(perm) <- "integer" - stephens1997a_poisson_cc(lambda, weight, startpar, perm) +".stephens1997a.poisson.Mcmcpermute" <- function(obj) { + M <- obj@M + K <- obj@model@K + w.mean <- apply(obj@post$weight, 2, mean) + a.mean <- apply(obj@post$par$a, 2, mean) + b.mean <- apply(obj@post$par$b, 2, mean) + startpar <- c(w.mean, a.mean, b.mean) + lambda <- obj@par$lambda + weight <- obj@weight + index <- array(integer(), dim = c(M, K)) + storage.mode(index) <- "integer" + index.out <- matrix(seq(1, K), nrow = M, ncol = K, byrow = TRUE) + storage.mode(index.out) <- "integer" + perm <- as.matrix(expand.grid(seq(1, K), seq(1, K))) + ind <- apply(perm, 1, function(x) all(x == x[1])) + perm <- perm[!ind, ] + storage.mode(perm) <- "integer" + stephens1997a_poisson_cc(lambda, weight, startpar, perm) } -".stephens1997a.binomial.Mcmcpermute" <- function(obj) -{ - M <- obj@M - K <- obj@model@K - w.mean <- apply(obj@post$weight, 2, mean) - a.mean <- apply(obj@post$par$a, 2, mean) - b.mean <- apply(obj@post$par$b, 2, mean) - startpar <- c(w.mean, a.mean, b.mean) - p <- obj@par$p - weight <- obj@weight - index <- array(integer(), dim = c(M, K)) - storage.mode(index) <- "integer" - index.out <- matrix(seq(1, K), nrow = M, ncol = K, byrow = TRUE) - storage.mode(index.out) <- "integer" - perm <- as.matrix(expand.grid(seq(1, K), seq(1, K))) - ind <- apply(perm, 1, function(x) all(x == x[1])) - perm <- perm[!ind, ] - storage.mode(perm) <- "integer" - stephens1997a_poisson_cc(p, weight, startpar, perm) +".stephens1997a.binomial.Mcmcpermute" <- function(obj) { + M <- obj@M + K <- obj@model@K + w.mean <- apply(obj@post$weight, 2, mean) + a.mean <- apply(obj@post$par$a, 2, mean) + b.mean <- apply(obj@post$par$b, 2, mean) + startpar <- c(w.mean, a.mean, b.mean) + p <- obj@par$p + weight <- obj@weight + index <- array(integer(), dim = c(M, K)) + storage.mode(index) <- "integer" + index.out <- matrix(seq(1, K), nrow = M, ncol = K, byrow = TRUE) + storage.mode(index.out) <- "integer" + perm <- as.matrix(expand.grid(seq(1, K), seq(1, K))) + ind <- apply(perm, 1, function(x) all(x == x[1])) + perm <- perm[!ind, ] + storage.mode(perm) <- "integer" + stephens1997a_poisson_cc(p, weight, startpar, perm) } ### Stephens1997b calling function: Calls the approrpiate -### algorithm to perform a relabeling following Stephens (1997b) to +### algorithm to perform a relabeling following Stephens (1997b) to ### the sample draws and the data. The algorithm computes ### the classification probability matrices for each parameter ### draw from the MCMC sample. It computes then the best estimate ### of the classification probability matrix and the corresponding -### Kullback-Leibler distance of each matrix to this estimate. +### Kullback-Leibler distance of each matrix to this estimate. ### For each parameter an each component of the estimate the ### 'cost' matrix is then minimized and the assignment indicates ### the assignment of a parameter draw to its label. ### This function needs an 'fdata' object and checks within ### if it is valid in regard to the 'model' object carried -### by the 'mcmcoutput' object. +### by the 'mcmcoutput' object. ### If no permutation is possible, a warning is thrown. -".stephens1997b.Mcmcpermute" <- function( obj, fdata.obj, max_iter=200L ) -{ - .check.fdata.model.Mcmcstart( fdata.obj, obj@model ) - dist <- obj@model@dist - if ( dist == "poisson" ) { - index <- .stephens1997b.poisson.Mcmcpermute( obj, fdata.obj, max_iter=max_iter ) - } else if ( dist == "binomial" ) { - index <- .stephens1997b.binomial.Mcmcpermute( obj, fdata.obj ) - } else if ( dist == "exponential" ) { - index <- .stephens1997b.exponential.Mcmcmpermute( obj, fdata.obj ) - } - ## Create 'mcmcoutputperm' objects. - startidx <- matrix( seq( 1, obj@model@K ), nrow = obj@M, - ncol = obj@model@K, byrow = TRUE ) - if ( any( startidx != index ) ) { - obj.swap <- swapElements( obj, index ) - .process.output.Mcmcpermute( obj, obj.swap, method = "Stephens1997b" ) - } else { - .process.output.empty.Mcmcpermute( obj, method = "Stephens1997b" ) - } +".stephens1997b.Mcmcpermute" <- function(obj, fdata.obj, max_iter = 200L) { + .check.fdata.model.Mcmcstart(fdata.obj, obj@model) + dist <- obj@model@dist + if (dist == "poisson") { + index <- .stephens1997b.poisson.Mcmcpermute(obj, fdata.obj, max_iter = max_iter) + } else if (dist == "binomial") { + index <- .stephens1997b.binomial.Mcmcpermute(obj, fdata.obj) + } else if (dist == "exponential") { + index <- .stephens1997b.exponential.Mcmcmpermute(obj, fdata.obj) + } + ## Create 'mcmcoutputperm' objects. + startidx <- matrix(seq(1, obj@model@K), + nrow = obj@M, + ncol = obj@model@K, byrow = TRUE + ) + if (any(startidx != index)) { + obj.swap <- swapElements(obj, index) + .process.output.Mcmcpermute(obj, obj.swap, method = "Stephens1997b") + } else { + .process.output.empty.Mcmcpermute(obj, method = "Stephens1997b") + } } -".stephens1997b.poisson.Mcmcpermute" <- function( obj, fdata.obj, max_iter=200L ) -{ - stephens1997b_poisson_cc( fdata.obj@y, obj@par$lambda, - obj@weight, max_iter=max_iter ) +".stephens1997b.poisson.Mcmcpermute" <- function(obj, fdata.obj, max_iter = 200L) { + stephens1997b_poisson_cc(fdata.obj@y, obj@par$lambda, + obj@weight, + max_iter = max_iter + ) } -".stephens1997b.binomial.Mcmcpermute" <- function( obj, fdata.obj ) -{ - stephens1997b_binomial_cc( fdata.obj@y, fdata.obj@T, obj@par$p, - obj@weight ) +".stephens1997b.binomial.Mcmcpermute" <- function(obj, fdata.obj) { + stephens1997b_binomial_cc( + fdata.obj@y, fdata.obj@T, obj@par$p, + obj@weight + ) } -".stephens1997b.exponential.Mcmcpermute" <- function( obj, fdata.obj ) -{ - stephens1997b_exponential_cc( fdata.obj@y, obj@par$lambda, - obj@ weight ) +".stephens1997b.exponential.Mcmcpermute" <- function(obj, fdata.obj) { + stephens1997b_exponential_cc( + fdata.obj@y, obj@par$lambda, + obj@ weight + ) } -".process.output.Mcmcpermute" <- function( obj, obj.swap, method ) -{ - ## Create 'mcmcoutputperm' objects ## - if ( class( obj ) == "mcmcoutputfix" ) { - .mcmcoutputpermfix( obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - logperm = obj.swap@log ) - } else if ( class( obj ) == "mcmcoutputfixhier" ) { - .mcmcoutputpermfixhier( obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - logperm = obj.swap@log ) - } else if (class(obj) == "mcmcoutputfixpost") { - .mcmcoutputpermfixpost(obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - logperm = obj.swap@log, - postperm = obj.swap@post) - } else if (class(obj) == "mcmcoutputfixhierpost") { - .mcmcoutputpermfixhierpost(obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - logperm = obj.swap@log, - postperm = obj.swap@post) - } else if (class(obj) == "mcmcoutputbase") { - .mcmcoutputpermbase(obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - relabel = method, - weightperm = obj.swap@weight, - logperm = obj.swap@log, - entropyperm = obj.swap@entropy, - STperm = obj.swap@ST, - Sperm = obj.swap@S, - NKperm = obj.swap@NK) - } else if (class(obj) == "mcmcoutputhier") { - .mcmcoutputpermhier(obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - relabel = method, - weightperm = obj.swap@weight, - logperm = obj.swap@log, - entropyperm = obj.swap@entropy, - STperm = obj.swap@ST, - Sperm = obj.swap@S, - NKperm = obj.swap@NK) - } else if (class(obj) == "mcmcoutputpost") { - .mcmcoutputpermpost(obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - relabel = method, - weightperm = obj.swap@weight, - logperm = obj.swap@log, - postperm = obj.swap@post, - entropyperm = obj.swap@entropy, - STperm = obj.swap@ST, - Sperm = obj.swap@S, - NKperm = obj.swap@NK) - } else { - .mcmcoutputpermhierpost(obj, - Mperm = obj.swap@M, - parperm = obj.swap@par, - relabel = method, - weightperm = obj.swap@weight, - logperm = obj.swap@log, - postperm = obj.swap@post, - entropyperm = obj.swap@entropy, - STperm = obj.swap@ST, - Sperm = obj.swap@S, - NKperm = obj.swap@NK) - } +".process.output.Mcmcpermute" <- function(obj, obj.swap, method) { + ## Create 'mcmcoutputperm' objects ## + if (class(obj) == "mcmcoutputfix") { + .mcmcoutputpermfix(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + logperm = obj.swap@log + ) + } else if (class(obj) == "mcmcoutputfixhier") { + .mcmcoutputpermfixhier(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + logperm = obj.swap@log + ) + } else if (class(obj) == "mcmcoutputfixpost") { + .mcmcoutputpermfixpost(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + logperm = obj.swap@log, + postperm = obj.swap@post + ) + } else if (class(obj) == "mcmcoutputfixhierpost") { + .mcmcoutputpermfixhierpost(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + logperm = obj.swap@log, + postperm = obj.swap@post + ) + } else if (class(obj) == "mcmcoutputbase") { + .mcmcoutputpermbase(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + relabel = method, + weightperm = obj.swap@weight, + logperm = obj.swap@log, + entropyperm = obj.swap@entropy, + STperm = obj.swap@ST, + Sperm = obj.swap@S, + NKperm = obj.swap@NK + ) + } else if (class(obj) == "mcmcoutputhier") { + .mcmcoutputpermhier(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + relabel = method, + weightperm = obj.swap@weight, + logperm = obj.swap@log, + entropyperm = obj.swap@entropy, + STperm = obj.swap@ST, + Sperm = obj.swap@S, + NKperm = obj.swap@NK + ) + } else if (class(obj) == "mcmcoutputpost") { + .mcmcoutputpermpost(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + relabel = method, + weightperm = obj.swap@weight, + logperm = obj.swap@log, + postperm = obj.swap@post, + entropyperm = obj.swap@entropy, + STperm = obj.swap@ST, + Sperm = obj.swap@S, + NKperm = obj.swap@NK + ) + } else { + .mcmcoutputpermhierpost(obj, + Mperm = obj.swap@M, + parperm = obj.swap@par, + relabel = method, + weightperm = obj.swap@weight, + logperm = obj.swap@log, + postperm = obj.swap@post, + entropyperm = obj.swap@entropy, + STperm = obj.swap@ST, + Sperm = obj.swap@S, + NKperm = obj.swap@NK + ) + } } -".process.output.empty.Mcmcpermute" <- function(obj, method) -{ - warning(paste("Not a single draw is a permutation in the ", - "function 'mcmcpermute()'.", sep = "")) - ## Create 'mcmcoutputperm' objects ## - if (class(obj) == "mcmcoutputfix") { - .mcmcoutputpermfix(obj, Mperm = as.integer(0)) - } else if (class(obj) == "mcmcoutputfixhier") { - .mcmcoutputpermfixhier(obj, Mperm = as.integer(0)) - } else if (class(obj) == "mcmcoutputfixpost") { - .mcmcoutputpermfixpost(obj, Mperm = as.integer(0)) - } else if (class(obj) == "mcmcoutputfixhierpost") { - .mcmcoutputpermfixhierpost(obj, Mperm = as.integer(0)) - } else if (class(obj) == "mcmcoutputbase") { - .mcmcoutputpermbase(obj, Mperm = as.integer(0), relabel = method) - } else if (class(obj) == "mcmcoutputhier") { - .mcmcoutputpermhier(obj, Mperm = as.integer(0), relabel = method) - } else if (class(obj) == "mcmcoutputpost") { - .mcmcoutputpermpost(obj, Mperm = as.integer(0), relabel = method) - } else { - .mcmcoutputpermhierpost(obj, Mperm = as.integer(0), relabel = method) - } +".process.output.empty.Mcmcpermute" <- function(obj, method) { + warning(paste("Not a single draw is a permutation in the ", + "function 'mcmcpermute()'.", + sep = "" + )) + ## Create 'mcmcoutputperm' objects ## + if (class(obj) == "mcmcoutputfix") { + .mcmcoutputpermfix(obj, Mperm = as.integer(0)) + } else if (class(obj) == "mcmcoutputfixhier") { + .mcmcoutputpermfixhier(obj, Mperm = as.integer(0)) + } else if (class(obj) == "mcmcoutputfixpost") { + .mcmcoutputpermfixpost(obj, Mperm = as.integer(0)) + } else if (class(obj) == "mcmcoutputfixhierpost") { + .mcmcoutputpermfixhierpost(obj, Mperm = as.integer(0)) + } else if (class(obj) == "mcmcoutputbase") { + .mcmcoutputpermbase(obj, Mperm = as.integer(0), relabel = method) + } else if (class(obj) == "mcmcoutputhier") { + .mcmcoutputpermhier(obj, Mperm = as.integer(0), relabel = method) + } else if (class(obj) == "mcmcoutputpost") { + .mcmcoutputpermpost(obj, Mperm = as.integer(0), relabel = method) + } else { + .mcmcoutputpermhierpost(obj, Mperm = as.integer(0), relabel = method) + } } - - diff --git a/R/mcmcstart.R b/R/mcmcstart.R index 6d81fea..0a53a81 100644 --- a/R/mcmcstart.R +++ b/R/mcmcstart.R @@ -15,49 +15,49 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -"mcmcstart" <- function( fdata, model, varargin ) -{ - ## Check arguments - .check.fdata.model.Mcmcstart( fdata, model ) - ## Check if mcmc object was given in arguments - if( nargs() == 2 ) { - mcmc <- mcmc() - } - else { - .check.mcmc.Mcmcstart( varargin ) - mcmc <- varargin - } - K <- model@K - dist <- model@dist - ## If @startpar is - ## TRUE (default): Start by sampling the parameters - ## -> it needs starting indicators S - ## In this case staring indicators are generated - ## by kmeans-clustering independently of - ## the model. - ## FALSE: Start by sampling the indicators - ## -> it needs starting parameters model@par - ## In this case starting parameters are generated - ## dependent on the data in @y of 'fdata' and the - ## the model. - ## If the model has fixed indicators (@indicfix = TRUE), no indicators - ## are generated. - if ( !model@indicfix ) { - if ( mcmc@startpar ) { - if ( K > 1 ) { - fdata <- .indicators.Mcmcstart( fdata, model ) - } - } else { - model <- .parameters.Mcmcstart( fdata, model, mcmc ) - } +"mcmcstart" <- function(fdata, model, varargin) { + ## Check arguments + .check.fdata.model.Mcmcstart(fdata, model) + ## Check if mcmc object was given in arguments + if (nargs() == 2) { + mcmc <- mcmc() + } else { + .check.mcmc.Mcmcstart(varargin) + mcmc <- varargin + } + K <- model@K + dist <- model@dist + ## If @startpar is + ## TRUE (default): Start by sampling the parameters + ## -> it needs starting indicators S + ## In this case staring indicators are generated + ## by kmeans-clustering independently of + ## the model. + ## FALSE: Start by sampling the indicators + ## -> it needs starting parameters model@par + ## In this case starting parameters are generated + ## dependent on the data in @y of 'fdata' and the + ## the model. + ## If the model has fixed indicators (@indicfix = TRUE), no indicators + ## are generated. + if (!model@indicfix) { + if (mcmc@startpar) { + if (K > 1) { + fdata <- .indicators.Mcmcstart(fdata, model) + } } else { - warning( paste( "Slot 'indicfix' of 'model' object is ", - "set to TRUE. 'mcmcstart()' does not ", - "generate indicators nor starting parameters ", - "for models with fixed indicators.", sep = "" ) ) + model <- .parameters.Mcmcstart(fdata, model, mcmc) } - obj.list <- list( fdata = fdata, model = model, mcmc = mcmc ) - return( obj.list ) + } else { + warning(paste("Slot 'indicfix' of 'model' object is ", + "set to TRUE. 'mcmcstart()' does not ", + "generate indicators nor starting parameters ", + "for models with fixed indicators.", + sep = "" + )) + } + obj.list <- list(fdata = fdata, model = model, mcmc = mcmc) + return(obj.list) } ### Private functions. @@ -65,354 +65,359 @@ ### Checking ### Check fdata/model: 'fdata' must be a valid 'fdata' object and 'model' -### must be a valid 'model' object. Furthermore, 'fdata' must have a -### non-empty data slot @y. +### must be a valid 'model' object. Furthermore, 'fdata' must have a +### non-empty data slot @y. ### If the distributions in 'model' do not correspond to the dimensions ### @r in 'fdata' an error is thrown. -".check.fdata.model.Mcmcstart" <- function( fdata.obj, model.obj ) -{ - .valid.Fdata( fdata.obj ) - .valid.Model( model.obj ) - hasY( fdata.obj, verbose = TRUE ) - if ( fdata.obj@r > 1 && model.obj@dist %in% .get.univ.Model() ) { - stop( paste( "Wrong specification of slot 'r' in 'fdata' object. ", - "Univariate distribution in slot 'dist' of 'model' ", - "object but dimension in slot 'r' of 'fdata' object ", - "greater 1.", sep = "" ) ) - } else if ( fdata.obj@r < 2 && model.obj@dist %in% .get.multiv.Model() ) { - stop( paste( "Wrong specification of slot 'r' ind 'fdata' object ", - "Multivariate distribution in slot 'dist' if 'model' ", - "object but dimension in slot 'r' of 'fdata' object ", - "less than two.", sep = "" ) ) - } +".check.fdata.model.Mcmcstart" <- function(fdata.obj, model.obj) { + .valid.Fdata(fdata.obj) + .valid.Model(model.obj) + hasY(fdata.obj, verbose = TRUE) + if (fdata.obj@r > 1 && model.obj@dist %in% .get.univ.Model()) { + stop(paste("Wrong specification of slot 'r' in 'fdata' object. ", + "Univariate distribution in slot 'dist' of 'model' ", + "object but dimension in slot 'r' of 'fdata' object ", + "greater 1.", + sep = "" + )) + } else if (fdata.obj@r < 2 && model.obj@dist %in% .get.multiv.Model()) { + stop(paste("Wrong specification of slot 'r' ind 'fdata' object ", + "Multivariate distribution in slot 'dist' if 'model' ", + "object but dimension in slot 'r' of 'fdata' object ", + "less than two.", + sep = "" + )) + } } ### Check varargin: Argument 'varargin' must be an object of class 'mcmc'. -".check.mcmc.Mcmcstart" <- function(mcmc.obj) -{ - if (class(mcmc.obj) != "mcmc") { - stop(paste("Wrong argument. 'mcmc' must be an object of class ", - "'mcmc'.", sep = "")) - } - .valid.MCMC(mcmc.obj) +".check.mcmc.Mcmcstart" <- function(mcmc.obj) { + if (class(mcmc.obj) != "mcmc") { + stop(paste("Wrong argument. 'mcmc' must be an object of class ", + "'mcmc'.", + sep = "" + )) + } + .valid.MCMC(mcmc.obj) } ### Logic -### Logic parameters: Generates starting parameters for @dist in -### 'model.obj'. Returns a 'model' object with starting parameters -### in @par. -".parameters.Mcmcstart" <- function( fdata.obj, model.obj, mcmc.obj ) -{ - K <- model.obj@K - dist <- model.obj@dist - ## Check if model object for student-t distributions has - ## a parameter 'df'. - if ( dist %in% c( "student", "studmult" ) ) { - .mcmcstart.Student.Df(model.obj) - } - ## Check if weights have been already initialized - if ( K > 1 ) { - if ( model.obj@indicmod == "multinomial" ) { - model.obj <- .parameters.multinomial.Mcmcstart( model.obj ) - } ## else: Markov model, implemented later. - } - if ( dist %in% c( "poisson", "cond.poisson" ) ) { - .parameters.poisson.Mcmcstart( fdata.obj, model.obj ) - } else if ( dist == "exponential" ) { - .mcmcstart.exponential.Model( fdata.obj, model.obj, mcmc.obj ) - } else if ( dist == "binomial" ) { - .parameters.binomial.Mcmcstart(fdata.obj, model.obj) - } else if ( dist == "normal" || dist == "student" ) { - .mcmcstart.Norstud.Model(fdata.obj, model.obj, mcmc.obj) - } else if ( dist %in% c("normult", "studmult" ) ) { - .mcmcstart.Norstudmult.Model( fdata.obj, model.obj, mcmc.obj ) - } +### Logic parameters: Generates starting parameters for @dist in +### 'model.obj'. Returns a 'model' object with starting parameters +### in @par. +".parameters.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { + K <- model.obj@K + dist <- model.obj@dist + ## Check if model object for student-t distributions has + ## a parameter 'df'. + if (dist %in% c("student", "studmult")) { + .mcmcstart.Student.Df(model.obj) + } + ## Check if weights have been already initialized + if (K > 1) { + if (model.obj@indicmod == "multinomial") { + model.obj <- .parameters.multinomial.Mcmcstart(model.obj) + } ## else: Markov model, implemented later. + } + if (dist %in% c("poisson", "cond.poisson")) { + .parameters.poisson.Mcmcstart(fdata.obj, model.obj) + } else if (dist == "exponential") { + .mcmcstart.exponential.Model(fdata.obj, model.obj, mcmc.obj) + } else if (dist == "binomial") { + .parameters.binomial.Mcmcstart(fdata.obj, model.obj) + } else if (dist == "normal" || dist == "student") { + .mcmcstart.Norstud.Model(fdata.obj, model.obj, mcmc.obj) + } else if (dist %in% c("normult", "studmult")) { + .mcmcstart.Norstudmult.Model(fdata.obj, model.obj, mcmc.obj) + } } -".mcmcstart.Exp" <- function(data.obj) -{ - r <- data.obj@r - N <- data.obj@N - has.exp <- (length(data.obj@exp) > 0) - if (has.exp) { - if (data.obj@bycolumn) { - if (nrow(data.obj@exp) != N && nrow(data.obj@exp) != 1) { - stop(paste("Dimension of slot 'exp' of 'data' object", - "does not match dimension of slot 'y' of", - "'data' object."), - sep = "") - } else if (nrow(data.obj@exp) == N) { - exp <- data.obj@exp - } else { - exp <- matrix(data.obj@exp[1, 1], nrow = N, ncol = 1) - } - } else { - if (ncol(data.obj@exp) != N && ncol(data.obj@exp) != 1) { - stop(paste("Dimension of slot 'exp' of 'data' object", - "does not match dimension of slot 'y' of", - "'data' object."), - sep = "") - } else if (ncol(data.obj@exp) == N) { - exp <- t(data.obj@exp) - } else { - exp <- matrix(data.obj@exp[1, 1], nrow = N, ncol = 1) - } - } +".mcmcstart.Exp" <- function(data.obj) { + r <- data.obj@r + N <- data.obj@N + has.exp <- (length(data.obj@exp) > 0) + if (has.exp) { + if (data.obj@bycolumn) { + if (nrow(data.obj@exp) != N && nrow(data.obj@exp) != 1) { + stop(paste( + "Dimension of slot 'exp' of 'data' object", + "does not match dimension of slot 'y' of", + "'data' object." + ), + sep = "" + ) + } else if (nrow(data.obj@exp) == N) { + exp <- data.obj@exp + } else { + exp <- matrix(data.obj@exp[1, 1], nrow = N, ncol = 1) + } } else { - exp <- matrix(1, nrow = N, ncol = 1) + if (ncol(data.obj@exp) != N && ncol(data.obj@exp) != 1) { + stop(paste( + "Dimension of slot 'exp' of 'data' object", + "does not match dimension of slot 'y' of", + "'data' object." + ), + sep = "" + ) + } else if (ncol(data.obj@exp) == N) { + exp <- t(data.obj@exp) + } else { + exp <- matrix(data.obj@exp[1, 1], nrow = N, ncol = 1) + } } - return(exp) + } else { + exp <- matrix(1, nrow = N, ncol = 1) + } + return(exp) } -".parameters.multinomial.Mcmcstart" <- function(model.obj) -{ - K <- model.obj@K - if (!hasWeight(model.obj)) { - model.obj@weight <- matrix(1/K, nrow = 1, ncol = K) - } - return(model.obj) +".parameters.multinomial.Mcmcstart" <- function(model.obj) { + K <- model.obj@K + if (!hasWeight(model.obj)) { + model.obj@weight <- matrix(1 / K, nrow = 1, ncol = K) + } + return(model.obj) } -".parameters.poisson.Mcmcstart" <- function(fdata.obj, model.obj) -{ - K <- model.obj@K - datam <- getColY(fdata.obj) - if (!hasPar(model.obj)) { - if (K == 1) { - pm <- max(mean(datam/exp, na.rm = TRUE), 0.1) - pm <- array(pm, dim = c(1, K)) - } else { ## K > 1 - if (hasExp(fdata.obj)) { - expos <- getColExp(fdata.obj) - pm <- (mean(datam/expos, na.rm = TRUE)) * exp(runif(K)) - } else { - pm <- (mean(datam, na.rm = TRUE)) * exp(runif(K)) - } - pm <- pmax(pm, 0.1) - } - model.obj@par <- list(lambda = pm) +".parameters.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { + K <- model.obj@K + datam <- getColY(fdata.obj) + if (!hasPar(model.obj)) { + if (K == 1) { + pm <- max(mean(datam / exp, na.rm = TRUE), 0.1) + pm <- array(pm, dim = c(1, K)) + } else { ## K > 1 + if (hasExp(fdata.obj)) { + expos <- getColExp(fdata.obj) + pm <- (mean(datam / expos, na.rm = TRUE)) * exp(runif(K)) + } else { + pm <- (mean(datam, na.rm = TRUE)) * exp(runif(K)) + } + pm <- pmax(pm, 0.1) } - return(model.obj) + model.obj@par <- list(lambda = pm) + } + return(model.obj) } -".parameters.exponential.Mcmcstart" <- function( fdata.obj, model.obj, - mcmc.obj ) -{ - if ( !hasPar( model.obj ) ) { - datam <- getColY( fdata.obj ) - K <- model.obj@K - if (K == 1) { - pm <- 1/mean( datam, na.rm = TRUE ) - } else { ## K > 1 - pm <- exp( runif( K ) )/mean( datam, na.rm = TRUE ) - } - model.obj@par <- list( lambda = pm ) +".parameters.exponential.Mcmcstart" <- function(fdata.obj, model.obj, + mcmc.obj) { + if (!hasPar(model.obj)) { + datam <- getColY(fdata.obj) + K <- model.obj@K + if (K == 1) { + pm <- 1 / mean(datam, na.rm = TRUE) + } else { ## K > 1 + pm <- exp(runif(K)) / mean(datam, na.rm = TRUE) } - return( model.obj ) + model.obj@par <- list(lambda = pm) + } + return(model.obj) } -".parameters.binomial.Mcmcstart" <- function(fdata.obj, model.obj) -{ - if (!hasPar(model.obj) && hasT(fdata.obj, verbose = TRUE)) { - datam <- getColY(fdata.obj) - K <- model.obj@K - if (K == 1) { - pm <- mean(datam/fdata.obj@T, na.rm = TRUE) - pm <- pmin(pmax(pm, 0.1),0.9) - } else { ## K > 1 - pm <- mean(datam/fdata.obj@T, na.rm = TRUE) * exp(.2 * runif(K)) - pm <- pmin(pmax(pm, 0.1), 0.9) - } - model.obj@par <- list(p = pm) +".parameters.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { + if (!hasPar(model.obj) && hasT(fdata.obj, verbose = TRUE)) { + datam <- getColY(fdata.obj) + K <- model.obj@K + if (K == 1) { + pm <- mean(datam / fdata.obj@T, na.rm = TRUE) + pm <- pmin(pmax(pm, 0.1), 0.9) + } else { ## K > 1 + pm <- mean(datam / fdata.obj@T, na.rm = TRUE) * exp(.2 * runif(K)) + pm <- pmin(pmax(pm, 0.1), 0.9) } - return(model.obj) + model.obj@par <- list(p = pm) + } + return(model.obj) } -".mcmcstart.Norstud.Model" <- function( fdata.obj, model.obj, - mcmc.obj ) -{ - datam <- getColY( fdata.obj ) - K <- model.obj@K - has.par <- ( length( model.obj@par ) > 0 ) - start.mu <- FALSE - start.sigma <- FALSE - if( !has.par ) { - start.mu <- TRUE - start.sigma <- TRUE - } else { ## has already parameters - start.mu <- !"mu" %in% names( model.obj@par ) - start.sigma <- !"sigma" %in% names( model.obj@par ) - } - if( start.mu ) { - if( K == 1 ) { - pm <- mean( datam, na.rm = TRUE ) - } else { ## K > 1 - pm <- mean( datam, na.rm = TRUE ) + - sd( datam, na.rm = TRUE ) * runif( K ) - pm <- matrix( pm, nrow = 1, ncol = K ) - } - if( start.sigma ) { - model.obj@par <- list( mu = pm ) - } else { - model.obj@par$mu <- pm - } +".mcmcstart.Norstud.Model" <- function(fdata.obj, model.obj, + mcmc.obj) { + datam <- getColY(fdata.obj) + K <- model.obj@K + has.par <- (length(model.obj@par) > 0) + start.mu <- FALSE + start.sigma <- FALSE + if (!has.par) { + start.mu <- TRUE + start.sigma <- TRUE + } else { ## has already parameters + start.mu <- !"mu" %in% names(model.obj@par) + start.sigma <- !"sigma" %in% names(model.obj@par) + } + if (start.mu) { + if (K == 1) { + pm <- mean(datam, na.rm = TRUE) + } else { ## K > 1 + pm <- mean(datam, na.rm = TRUE) + + sd(datam, na.rm = TRUE) * runif(K) + pm <- matrix(pm, nrow = 1, ncol = K) } - if( start.sigma ) { - pm <- sd( datam, na.rm = TRUE ) - pm <- matrix( pm, nrow = 1, ncol = K ) - model.obj@par$sigma <- pm + if (start.sigma) { + model.obj@par <- list(mu = pm) + } else { + model.obj@par$mu <- pm } - - return( model.obj ) + } + if (start.sigma) { + pm <- sd(datam, na.rm = TRUE) + pm <- matrix(pm, nrow = 1, ncol = K) + model.obj@par$sigma <- pm + } + + return(model.obj) } -".mcmcstart.Norstudmult.Model" <- function( fdata.obj, model.obj, - mcmc.obj ) -{ - K <- model.obj@K - r <- model.obj@r - has.par <- ( length( model.obj@par ) > 0 ) - datam <- getColY( fdata.obj ) - ## Check if parameters are already provided ## - start.mu <- FALSE - start.sigma <- FALSE - if ( !has.par ) { - start.mu <- TRUE - start.sigma <- TRUE - } else { - has.mu <- "mu" %in% names( model.obj@par ) - has.sigma <- "sigma" %in% names( model.obj@par ) - if ( !has.mu ) { - start.mu <- TRUE - } - if ( !has.sigma ) { - start.sigma <- TRUE - } - } - cov.m <- cov( datam ) - if (start.mu) { - if (K == 1) { - pm.mu <- apply(datam, 2, mean, na.rm = TRUE) - pm.mu <- array(pm.mu, dim = c(1, K)) - } - else { ## K > 1 - mean <- apply(datam, 2, mean, na.rm = TRUE) - pm.mu <- matrix(0, nrow = r, ncol = K) - for(i in 1:K) { - pm.mu[,i] <- matrix(mean) + t(chol(cov.m)) %*% matrix(runif(K)) - } - } - if (!has.par) { - model.obj@par <- list(mu = pm.mu) - } - else { - model.obj@par$mu <- pm.mu - } +".mcmcstart.Norstudmult.Model" <- function(fdata.obj, model.obj, + mcmc.obj) { + K <- model.obj@K + r <- model.obj@r + has.par <- (length(model.obj@par) > 0) + datam <- getColY(fdata.obj) + ## Check if parameters are already provided ## + start.mu <- FALSE + start.sigma <- FALSE + if (!has.par) { + start.mu <- TRUE + start.sigma <- TRUE + } else { + has.mu <- "mu" %in% names(model.obj@par) + has.sigma <- "sigma" %in% names(model.obj@par) + if (!has.mu) { + start.mu <- TRUE } - if (start.sigma) { - model.obj@par$sigma <- array(cov.m, dim = c(r, r, K)) + if (!has.sigma) { + start.sigma <- TRUE + } + } + cov.m <- cov(datam) + if (start.mu) { + if (K == 1) { + pm.mu <- apply(datam, 2, mean, na.rm = TRUE) + pm.mu <- array(pm.mu, dim = c(1, K)) + } else { ## K > 1 + mean <- apply(datam, 2, mean, na.rm = TRUE) + pm.mu <- matrix(0, nrow = r, ncol = K) + for (i in 1:K) { + pm.mu[, i] <- matrix(mean) + t(chol(cov.m)) %*% matrix(runif(K)) + } + } + if (!has.par) { + model.obj@par <- list(mu = pm.mu) + } else { + model.obj@par$mu <- pm.mu } - return(model.obj) + } + if (start.sigma) { + model.obj@par$sigma <- array(cov.m, dim = c(r, r, K)) + } + return(model.obj) } -".mcmcstart.Student.Df" <- function(model.obj) -{ - has.par <- (length(model.obj@par) > 0) - if (has.par) { - has.df <- "df" %in% names(model.obj@par) - if (!df.in.model) { - model.obj@pari$df <- array(10, dim = c(1, K)) - validObject(model.obj) - } - } else { - model@par <- list(df = array(10, dim = c(1, K))) +".mcmcstart.Student.Df" <- function(model.obj) { + has.par <- (length(model.obj@par) > 0) + if (has.par) { + has.df <- "df" %in% names(model.obj@par) + if (!df.in.model) { + model.obj@pari$df <- array(10, dim = c(1, K)) + validObject(model.obj) } - return(model.obj) + } else { + model@par <- list(df = array(10, dim = c(1, K))) + } + return(model.obj) } -### Logic indicators: Returns an 'fdata' object with generated -### indicators. -".indicators.Mcmcstart" <- function(fdata.obj, model.obj) -{ - dist <- model.obj@dist - if ( dist %in% c( "poisson", "cond.poisson", "exponential" ) ) { - .indicators.poisson.Mcmcstart(fdata.obj, model.obj) - } else if ( dist == "binomial" ) { - .indicators.binomial.Mcmcstart(fdata.obj, model.obj) - } else if( dist %in% c( "normal", "normult", - "student", "studmult" ) ) { - .mcmcstart.Ind.Norstud( fdata.obj, model.obj ) - } +### Logic indicators: Returns an 'fdata' object with generated +### indicators. +".indicators.Mcmcstart" <- function(fdata.obj, model.obj) { + dist <- model.obj@dist + if (dist %in% c("poisson", "cond.poisson", "exponential")) { + .indicators.poisson.Mcmcstart(fdata.obj, model.obj) + } else if (dist == "binomial") { + .indicators.binomial.Mcmcstart(fdata.obj, model.obj) + } else if (dist %in% c( + "normal", "normult", + "student", "studmult" + )) { + .mcmcstart.Ind.Norstud(fdata.obj, model.obj) + } } ### Logic indicators for Poisson: If it is started by sampling ### the parameters a simple kmeans-clustering is performed ### to find initial indicators. If indicators are already ### in slot @S of the 'fdata' object, the 'fdata' object is -### immediately returned. -".indicators.poisson.Mcmcstart" <- function(fdata.obj, model.obj) -{ - K <- model.obj@K - if ( !hasS( fdata.obj ) ) { - datam <- getColY( fdata.obj ) - S <- matrix(kmeans( datam^.5, centers = K, - nstart = K )$cluster ) - if ( fdata.obj@bycolumn ) { - fdata.obj@S <- S - } else { - fdata.obj@S <- t( S ) - } +### immediately returned. +".indicators.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { + K <- model.obj@K + if (!hasS(fdata.obj)) { + datam <- getColY(fdata.obj) + S <- matrix(kmeans(datam^.5, + centers = K, + nstart = K + )$cluster) + if (fdata.obj@bycolumn) { + fdata.obj@S <- S + } else { + fdata.obj@S <- t(S) } - return( fdata.obj ) + } + return(fdata.obj) } -".indicators.binomial.Mcmcstart" <- function( fdata.obj, model.obj ) -{ - if ( !hasS( fdata.obj ) ) { - K <- model.obj@K - datam <- getColY( fdata.obj ) - if( ( max( datam ) - min( datam ) ) > 2 * K ) { - ## use k-means to determine a starting classification - if ( fdata.obj@bycolumn ) { - fdata.obj@S <- as.matrix( kmeans( datam^.5, - centers = K, - nstart = K )$cluster ) - } else { - fdata.obj@S <- t( as.matrix( kmeans( datam^.5, - centers = K, - nstart = K )$cluster ) ) - } - } else { - ## random classification - N <- fdata.obj@N - if ( fdata.obj@bycolumn ) { - fdata.obj@S <- as.matrix( sample( c( 1:K ), N, - replace = TRUE) ) - } else { - fdata.obj@S <- t( as.matrix( sample( c( 1:K ), N, - replace = TRUE ) ) ) - } - } +".indicators.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { + if (!hasS(fdata.obj)) { + K <- model.obj@K + datam <- getColY(fdata.obj) + if ((max(datam) - min(datam)) > 2 * K) { + ## use k-means to determine a starting classification + if (fdata.obj@bycolumn) { + fdata.obj@S <- as.matrix(kmeans(datam^.5, + centers = K, + nstart = K + )$cluster) + } else { + fdata.obj@S <- t(as.matrix(kmeans(datam^.5, + centers = K, + nstart = K + )$cluster)) + } + } else { + ## random classification + N <- fdata.obj@N + if (fdata.obj@bycolumn) { + fdata.obj@S <- as.matrix(sample(c(1:K), N, + replace = TRUE + )) + } else { + fdata.obj@S <- t(as.matrix(sample(c(1:K), N, + replace = TRUE + ))) + } } - return( fdata.obj ) + } + return(fdata.obj) } -".mcmcstart.Ind.Norstud" <- function( data.obj, model.obj ) -{ - K <- model.obj@K - has.S <- .mcmcstart.valid.Ind( data.obj ) - datam <- .mcmcstart.Data( data.obj ) - if ( has.S ) { - return( data.obj ) +".mcmcstart.Ind.Norstud" <- function(data.obj, model.obj) { + K <- model.obj@K + has.S <- .mcmcstart.valid.Ind(data.obj) + datam <- .mcmcstart.Data(data.obj) + if (has.S) { + return(data.obj) + } else { + if (data.obj@bycolumn) { + data.obj@S <- as.matrix(kmeans(datam^.5, + centers = K, + nstart = K + )$cluster) } else { - if ( data.obj@bycolumn ) { - data.obj@S <- as.matrix( kmeans( datam^.5, - centers = K, - nstart = K )$cluster ) - } else { - data.obj@S <- t( as.matrix( kmeans( datam^.5, - centers = K, - nstart = K )$cluster ) ) - } - return( data.obj ) + data.obj@S <- t(as.matrix(kmeans(datam^.5, + centers = K, + nstart = K + )$cluster)) } + return(data.obj) + } } diff --git a/R/mincol.R b/R/mincol.R index 3bf3c33..997f534 100644 --- a/R/mincol.R +++ b/R/mincol.R @@ -1,49 +1,46 @@ -"qinmatr" <- function( q ) -{ - if ( length( dim( q ) ) > 0 ) { - stop( paste( "The argument 'q' has to be an object of dimension 1 x r or r x 1.", - sep = ""), - call. = TRUE ) - } - r <- -.5 + sqrt( .25 + 2 * length( q ) ) - tmp <- matrix( numeric(), nrow = r, ncol = r ) - tmp[upper.tri( tmp, diag = TRUE )] <- q - tmp[lower.tri( tmp )] <- t( tmp[upper.tri( tmp )] ) - return( tmp ) +"qinmatr" <- function(q) { + if (length(dim(q)) > 0) { + stop(paste("The argument 'q' has to be an object of dimension 1 x r or r x 1.", + sep = "" + ), + call. = TRUE + ) + } + r <- -.5 + sqrt(.25 + 2 * length(q)) + tmp <- matrix(numeric(), nrow = r, ncol = r) + tmp[upper.tri(tmp, diag = TRUE)] <- q + tmp[lower.tri(tmp)] <- t(tmp[upper.tri(tmp)]) + return(tmp) } -"qinmatrmult" <- function( m ) -{ - r <- -.5 + sqrt( .25 + 2 * nrow( m ) ) - tmp.array <- array( numeric(), dim = c( r, r, ncol( m ) ) ) - for (k in 1:ncol( m ) ) { - tmp.array[,, k] <- qinmatr( m[, k] ) - } - return( tmp.array ) +"qinmatrmult" <- function(m) { + r <- -.5 + sqrt(.25 + 2 * nrow(m)) + tmp.array <- array(numeric(), dim = c(r, r, ncol(m))) + for (k in 1:ncol(m)) { + tmp.array[, , k] <- qinmatr(m[, k]) + } + return(tmp.array) } -"qincol" <- function( m ) -{ - r <- ncol( m ) - index <- 0 - s <- r * ( r + 1 ) / 2 - qcol <- vector( "numeric", s ) - for (rr in 1:r ) { - qcol[( index + 1 ) : ( index + rr )] <- m[1:rr, rr] - index <- index + rr - } - return( qcol ) +"qincol" <- function(m) { + r <- ncol(m) + index <- 0 + s <- r * (r + 1) / 2 + qcol <- vector("numeric", s) + for (rr in 1:r) { + qcol[(index + 1):(index + rr)] <- m[1:rr, rr] + index <- index + rr + } + return(qcol) } -"qincolmult" <- function( a ) -{ - r <- dim( a )[1] - K <- dim( a )[3] - s <- r * ( r + 1 ) / 2 - tmp.mat <- matrix( numeric(), nrow = s, ncol = K) - for ( k in 1:K ) { - tmp.mat[, k] <- qincol( a[,, k] ) - } - return( tmp.mat ) +"qincolmult" <- function(a) { + r <- dim(a)[1] + K <- dim(a)[3] + s <- r * (r + 1) / 2 + tmp.mat <- matrix(numeric(), nrow = s, ncol = K) + for (k in 1:K) { + tmp.mat[, k] <- qincol(a[, , k]) + } + return(tmp.mat) } - diff --git a/R/mixturemcmc.R b/R/mixturemcmc.R index d9e6904..96f274e 100644 --- a/R/mixturemcmc.R +++ b/R/mixturemcmc.R @@ -15,235 +15,265 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -"mixturemcmc" <- function( fdata, model, prior, mcmc ) { - ## Check arguments - mcmc <- .check.args.Mixturemcmc( fdata, model, prior, mcmc, nargs() ) +"mixturemcmc" <- function(fdata, model, prior, mcmc) { + ## Check arguments + mcmc <- .check.args.Mixturemcmc(fdata, model, prior, mcmc, nargs()) - ## Default ordering for MCMC: bycolumn - setBycolumn( fdata ) <- TRUE - ######################### MCMC SAMPLING ############################# - ## Set the indicators as a default to one for K == 1 - if ( model@K == 1 ) { - fdata@S <- matrix( 1, nrow = fdata@N, ncol = 1 ) - } - dist <- model@dist - if ( dist == "poisson" ) { - .do.MCMC.Poisson( fdata, model, prior, mcmc ) - } else if ( dist == "cond.poisson" ) { - .do.MCMC.CondPoisson( fdata, model, prior, mcmc ) - } else if ( dist == "binomial" ) { - .do.MCMC.Binomial( fdata, model, prior, mcmc ) - } else if ( dist == "exponential" ) { - .do.MCMC.Exponential( fdata, model, prior, mcmc ) - } else if ( dist == "normal" ) { - .do.MCMC.Normal( fdata, model, prior, mcmc ) - } else if ( dist == "student" ) { - .do.MCMC.Student( fdata, model, prior, mcmc ) - } else if ( dist == "normult" ) { - .do.MCMC.Normult( fdata, model, prior, mcmc ) - } else if ( dist == "studmult" ) { - .do.MCMC.Studmult( fdata, model, prior, mcmc ) - } + ## Default ordering for MCMC: bycolumn + setBycolumn(fdata) <- TRUE + ######################### MCMC SAMPLING ############################# + ## Set the indicators as a default to one for K == 1 + if (model@K == 1) { + fdata@S <- matrix(1, nrow = fdata@N, ncol = 1) + } + dist <- model@dist + if (dist == "poisson") { + .do.MCMC.Poisson(fdata, model, prior, mcmc) + } else if (dist == "cond.poisson") { + .do.MCMC.CondPoisson(fdata, model, prior, mcmc) + } else if (dist == "binomial") { + .do.MCMC.Binomial(fdata, model, prior, mcmc) + } else if (dist == "exponential") { + .do.MCMC.Exponential(fdata, model, prior, mcmc) + } else if (dist == "normal") { + .do.MCMC.Normal(fdata, model, prior, mcmc) + } else if (dist == "student") { + .do.MCMC.Student(fdata, model, prior, mcmc) + } else if (dist == "normult") { + .do.MCMC.Normult(fdata, model, prior, mcmc) + } else if (dist == "studmult") { + .do.MCMC.Studmult(fdata, model, prior, mcmc) + } } ## end mixturemcmc ### Private functions ### These functions are not exported ### Checking -### Check arguments: 'fdata' must contain valid data in @y and in case of +### Check arguments: 'fdata' must contain valid data in @y and in case of ### starting with sampling the parameters indicators in @S. Further, ### the data in @y must match with the specified distribution in @dist ### of 'model'. ### If it should started with sampling the indicators, 'model' must ### contain valid starting parameters in @par and @weight. ### The 'prior' object must contain valid parameters for the prior -### distribution. +### distribution. ### Further, if a fixed indicator model is used, @startpar in 'mcmc' ### must be TRUE and @ranperm must be FALSE. -".check.args.Mixturemcmc" <- function( fdata.obj, model.obj, - prior.obj, mcmc.obj, n.args ) -{ - ## Check if all arguments are provided - if ( n.args < 4 ) { - stop( "All arguments must be provided.", call. = FALSE ) - } - ## Check if 'fdata' object is valid - if ( class( fdata.obj ) != "fdata" ) { - stop( paste( "Unkown argument. Argument 1 must be an ", - "object of class 'fdata'.", sep = "" ), call. = FALSE ) - } - hasY( fdata.obj, verbose = TRUE ) - ## Check if 'model' was provided: - if ( class( model.obj ) != "model" ) { - stop( paste( "Unknown argument. Argument 2 must be an ", - "object of class 'model'.", sep = "" ), call. = FALSE ) - } - ## Check if 'prior' was provided: - if ( class( prior.obj ) != "prior" ) { - stop( paste( "Unknown argument. Argument 3 must be an ", - "object of class 'prior'.", sep = "" ), call. = FALSE ) - } - ## Check if 'mcmc' was provided: - if ( class( mcmc.obj ) != "mcmc" ) { - stop( paste( "Unkown argument. Argument 4 must be an ", - "object of class 'mcmc'.", sep = "" ), call. = FALSE ) - } - ## Check if @startpar in 'mcmc' object and @indicfix in - ## 'model' object match. - ## For fixed indicator models indicators are not sampled. - if ( model.obj@indicfix && !mcmc.obj@startpar ) { - mcmc.obj@startpar <- TRUE - } - ## Check if @K in 'model' object is one. For a model with - ## only one component indicators are not sampled. - if ( model.obj@K == 1 ) { - mcmc.obj@startpar <- TRUE - } - ## If @startpar in 'mcmc.obj' is TRUE, it should be started - ## by sampling the parameters. In this case starting - ## indicators must be provided in the 'fdata.obj' object. - ## If @startpar in 'mcmc.obj' is FALSE it should be started - ## by sampling the indicators. In this case starting - ## parameters must be provided in the 'model.obj' object. - if ( model.obj@K > 1 ) { - if ( mcmc.obj@startpar ) { - if ( !hasS( fdata.obj ) ) { - stop( paste( "For starting with sampling the parameters ", - "the 'fdata' object must contain starting ", - "indicator values. See ?mcmcstart for ", - "generating valid starting values.", sep = "" ), - call. = FALSE ) - } - } else { - if ( !hasPar( model.obj ) ) { - stop( paste( "For starting with sampling the indicators ", - "the 'model' object must contain starting ", - "parameter values. See ?mcmcstart for ", - "generating valid starting values.", sep = "" ), - call. = FALSE ) - } - if ( !hasWeight( model.obj ) ) { - stop( paste( "For starting with sampling the indicators ", - "the 'model' object must contain starting ", - "weight values. See ?mcmcstart for ", - "generating valid starting values.", sep = "" ), - call. = FALSE ) - } - } - } - ## Check if 'fdata' object and 'model' objects match - ## Call '.check.fdata.model.Mcmcstart()' from 'mcmcstart.R'. - .check.fdata.model.Mcmcstart( fdata.obj, model.obj ) - ## Check if 'prior' object is valid - if ( !hasPriorPar( prior.obj, model.obj ) ) { - stop( paste( "Slot @par in 'prior' object is empty. ", - "For MCMC sampling the prior needs fully ", - "specified parameters. See ?priordefine for ", - "generating valid prior parameters.", sep = "" ), - call. = FALSE ) - } - if ( !model.obj@indicfix && model.obj@K > 1 ) { - if( !hasPriorWeight( prior.obj, model.obj ) ) { - stop( paste( "Slot @weight of 'prior' object is empty. ", - "For MCMC sampling the prior needs specified ", - "parameters for the prior of the weights. See ", - "?priordefine for generating valid prior ", - "parameters.", sep = "" ), call. = FALSE ) - } - } - ## Check if @indicfix in 'model' object and - ## @ranperm in 'mcmc' object match. - ## For a fixed indicator model random permutation - ## sampling is senseless. - if ( model.obj@indicfix && mcmc.obj@ranperm ) { - mcmc.obj@ranperm <- FALSE +".check.args.Mixturemcmc" <- function(fdata.obj, model.obj, + prior.obj, mcmc.obj, n.args) { + ## Check if all arguments are provided + if (n.args < 4) { + stop("All arguments must be provided.", call. = FALSE) + } + ## Check if 'fdata' object is valid + if (class(fdata.obj) != "fdata") { + stop(paste("Unkown argument. Argument 1 must be an ", + "object of class 'fdata'.", + sep = "" + ), call. = FALSE) + } + hasY(fdata.obj, verbose = TRUE) + ## Check if 'model' was provided: + if (class(model.obj) != "model") { + stop(paste("Unknown argument. Argument 2 must be an ", + "object of class 'model'.", + sep = "" + ), call. = FALSE) + } + ## Check if 'prior' was provided: + if (class(prior.obj) != "prior") { + stop(paste("Unknown argument. Argument 3 must be an ", + "object of class 'prior'.", + sep = "" + ), call. = FALSE) + } + ## Check if 'mcmc' was provided: + if (class(mcmc.obj) != "mcmc") { + stop(paste("Unkown argument. Argument 4 must be an ", + "object of class 'mcmc'.", + sep = "" + ), call. = FALSE) + } + ## Check if @startpar in 'mcmc' object and @indicfix in + ## 'model' object match. + ## For fixed indicator models indicators are not sampled. + if (model.obj@indicfix && !mcmc.obj@startpar) { + mcmc.obj@startpar <- TRUE + } + ## Check if @K in 'model' object is one. For a model with + ## only one component indicators are not sampled. + if (model.obj@K == 1) { + mcmc.obj@startpar <- TRUE + } + ## If @startpar in 'mcmc.obj' is TRUE, it should be started + ## by sampling the parameters. In this case starting + ## indicators must be provided in the 'fdata.obj' object. + ## If @startpar in 'mcmc.obj' is FALSE it should be started + ## by sampling the indicators. In this case starting + ## parameters must be provided in the 'model.obj' object. + if (model.obj@K > 1) { + if (mcmc.obj@startpar) { + if (!hasS(fdata.obj)) { + stop(paste("For starting with sampling the parameters ", + "the 'fdata' object must contain starting ", + "indicator values. See ?mcmcstart for ", + "generating valid starting values.", + sep = "" + ), + call. = FALSE + ) + } + } else { + if (!hasPar(model.obj)) { + stop(paste("For starting with sampling the indicators ", + "the 'model' object must contain starting ", + "parameter values. See ?mcmcstart for ", + "generating valid starting values.", + sep = "" + ), + call. = FALSE + ) + } + if (!hasWeight(model.obj)) { + stop(paste("For starting with sampling the indicators ", + "the 'model' object must contain starting ", + "weight values. See ?mcmcstart for ", + "generating valid starting values.", + sep = "" + ), + call. = FALSE + ) + } } - ## For a model with only one component random permutation - ## is senseless as well. - if ( model.obj@K == 1 && mcmc.obj@ranperm ) { - mcmc.obj@ranperm <- FALSE + } + ## Check if 'fdata' object and 'model' objects match + ## Call '.check.fdata.model.Mcmcstart()' from 'mcmcstart.R'. + .check.fdata.model.Mcmcstart(fdata.obj, model.obj) + ## Check if 'prior' object is valid + if (!hasPriorPar(prior.obj, model.obj)) { + stop(paste("Slot @par in 'prior' object is empty. ", + "For MCMC sampling the prior needs fully ", + "specified parameters. See ?priordefine for ", + "generating valid prior parameters.", + sep = "" + ), + call. = FALSE + ) + } + if (!model.obj@indicfix && model.obj@K > 1) { + if (!hasPriorWeight(prior.obj, model.obj)) { + stop(paste("Slot @weight of 'prior' object is empty. ", + "For MCMC sampling the prior needs specified ", + "parameters for the prior of the weights. See ", + "?priordefine for generating valid prior ", + "parameters.", + sep = "" + ), call. = FALSE) } - return( mcmc.obj ) + } + ## Check if @indicfix in 'model' object and + ## @ranperm in 'mcmc' object match. + ## For a fixed indicator model random permutation + ## sampling is senseless. + if (model.obj@indicfix && mcmc.obj@ranperm) { + mcmc.obj@ranperm <- FALSE + } + ## For a model with only one component random permutation + ## is senseless as well. + if (model.obj@K == 1 && mcmc.obj@ranperm) { + mcmc.obj@ranperm <- FALSE + } + return(mcmc.obj) } - + ### Validity ### For a Binomial model either the 'data' object -### or the 'model' object must have specified -### repetitions 'T'. This can be either a 'matrix' -### object of dimension N x 1 or 1 x 1 (if all +### or the 'model' object must have specified +### repetitions 'T'. This can be either a 'matrix' +### object of dimension N x 1 or 1 x 1 (if all ### repetitions are the same) -".valid.Reps.Binomial" <- function( data, model ) -{ - has.reps <- !all( is.na( data@T ) ) - if ( has.reps ) { - if ( data@bycolumn ) { - if ( nrow( data@T ) != N && nrow(data@T) != 1) { - stop( paste( "Number of repetitions in slot @T of 'data' object ", - "does not match number of observations in slot @N.", - sep = "" ), call. = FALSE ) - } else if ( nrow( data@T ) == N ) { - T <- data@T - } else { ## dimension of T is 1 x 1 - T <- matrix( data@T[1, 1], nrow = N, ncol = 1 ) - } - } else { ## data stored by row - if ( ncol( data@T ) != N && ncol( data@T ) != 1 ) { - stop( paste( "Number of repetitions in slot @T of 'data' object ", - "does not match number of observations slot @N.", - sep = "" ), call. = FALSE ) - } else if( ncol( data@T ) == N ) { - T <- t( data@T ) - } else { ## dimension of T is 1 x 1 - T <- matrix( data@T[1, 1], nrow = N, ncol = 1 ) - } - } - } else { ## then check in model - has.reps <- !all( is.na( model@T ) ) - if ( has.reps ) { - if( nrow( model@T ) != N && nrow( model@T ) != 1 ) { - stop( paste( "Neither 'data' nor 'model' has correctly ", - "specified repetitions in slot @T for a binomial model.", - sep = ""), call. = FALSE ) - } else if( nrow( model@T ) == N ) { - T <- model@T - } else { ## dimension of T is 1 x 1 - T <- matrix( model@T[1, 1], nrow = N, ncol = 1 ) - } - } else { - stop( paste( "Neither 'data' object nor 'model' object has ", - "repetitions in slot @T for a binomial model specified.", - sep = "" ), call. = FALSE ) - } +".valid.Reps.Binomial" <- function(data, model) { + has.reps <- !all(is.na(data@T)) + if (has.reps) { + if (data@bycolumn) { + if (nrow(data@T) != N && nrow(data@T) != 1) { + stop(paste("Number of repetitions in slot @T of 'data' object ", + "does not match number of observations in slot @N.", + sep = "" + ), call. = FALSE) + } else if (nrow(data@T) == N) { + T <- data@T + } else { ## dimension of T is 1 x 1 + T <- matrix(data@T[1, 1], nrow = N, ncol = 1) + } + } else { ## data stored by row + if (ncol(data@T) != N && ncol(data@T) != 1) { + stop(paste("Number of repetitions in slot @T of 'data' object ", + "does not match number of observations slot @N.", + sep = "" + ), call. = FALSE) + } else if (ncol(data@T) == N) { + T <- t(data@T) + } else { ## dimension of T is 1 x 1 + T <- matrix(data@T[1, 1], nrow = N, ncol = 1) + } } - ## Check for identifiability ## - ## Reference: Teicher (1961) ## - rep.occ <- table( T ) - if ( dim( unique( T ) )[1] == 1 ) { - if ( T[1, 1] < 2 * model@K - 1 ) { - warning( paste( "This binomial mixture model is not identifiable. ", - "For equal repetitions in slot @T it must hold T >= 2K - 1. ", - "See Teicher (1961) for reference.", sep = "" ), call. = FALSE ) - } + } else { ## then check in model + has.reps <- !all(is.na(model@T)) + if (has.reps) { + if (nrow(model@T) != N && nrow(model@T) != 1) { + stop(paste("Neither 'data' nor 'model' has correctly ", + "specified repetitions in slot @T for a binomial model.", + sep = "" + ), call. = FALSE) + } else if (nrow(model@T) == N) { + T <- model@T + } else { ## dimension of T is 1 x 1 + T <- matrix(model@T[1, 1], nrow = N, ncol = 1) + } } else { - if ( length( rep.occ ) != nrow( T ) ) { - if ( all( dimnames( rep.occ )$T < rep.occ - 1 ) ) { - warning( paste( "This binomial mixture model is not identifiable. ", - "For varying repetitions 'T_i' in slot @T it must hold T_h ", - "> r_h - 1, for unique repetitions 'T_h' and their ", - "respective occurences 'r_h'. See Teicher (1961) ", - "for reference", sep = "" ), call. = FALSE ) - } else { - diff <- diff( sort( unique( T ) ) ) - if ( any( diff < rep.occ[1:( length( diff ) )] ) ) { - warning( paste( "This binomial mixture model is not identifiable. ", - "For varying repetitions 'T_i' in slot @T it must hold T_h ", - "- T_(h+1) >= r_h for unique repetitions 'T_h' and ", - "respective occurrences 'r_h'. See Teicher (1961) ", - "for reference.", sep = "" ), call. = FALSE ) - } - } + stop(paste("Neither 'data' object nor 'model' object has ", + "repetitions in slot @T for a binomial model specified.", + sep = "" + ), call. = FALSE) + } + } + ## Check for identifiability ## + ## Reference: Teicher (1961) ## + rep.occ <- table(T) + if (dim(unique(T))[1] == 1) { + if (T[1, 1] < 2 * model@K - 1) { + warning(paste("This binomial mixture model is not identifiable. ", + "For equal repetitions in slot @T it must hold T >= 2K - 1. ", + "See Teicher (1961) for reference.", + sep = "" + ), call. = FALSE) + } + } else { + if (length(rep.occ) != nrow(T)) { + if (all(dimnames(rep.occ)$T < rep.occ - 1)) { + warning(paste("This binomial mixture model is not identifiable. ", + "For varying repetitions 'T_i' in slot @T it must hold T_h ", + "> r_h - 1, for unique repetitions 'T_h' and their ", + "respective occurences 'r_h'. See Teicher (1961) ", + "for reference", + sep = "" + ), call. = FALSE) + } else { + diff <- diff(sort(unique(T))) + if (any(diff < rep.occ[1:(length(diff))])) { + warning(paste("This binomial mixture model is not identifiable. ", + "For varying repetitions 'T_i' in slot @T it must hold T_h ", + "- T_(h+1) >= r_h for unique repetitions 'T_h' and ", + "respective occurrences 'r_h'. See Teicher (1961) ", + "for reference.", + sep = "" + ), call. = FALSE) } + } } + } } ### MCMC @@ -251,184 +281,217 @@ ### MCMC Poisson: Prepares all data containers for MCMC sampling for ### Poisson mixture models regarding the specifications in 'prior.obj' ### 'model.obj' and 'mcmc.obj'. -".do.MCMC.Poisson" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) -{ - ## Base slots inherited to every derived class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - ranperm <- mcmc.obj@ranperm - burnin <- mcmc.obj@burnin - ## Set for MCMC default exposures: - if (!hasExp(fdata.obj)) { - fdata.obj@exp <- matrix(1, nrow = N, ncol = 1) +".do.MCMC.Poisson" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { + ## Base slots inherited to every derived class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + ranperm <- mcmc.obj@ranperm + burnin <- mcmc.obj@burnin + ## Set for MCMC default exposures: + if (!hasExp(fdata.obj)) { + fdata.obj@exp <- matrix(1, nrow = N, ncol = 1) + } + pars <- list(lambda = array(numeric(), dim = c(M, K))) + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + post.a <- array(numeric(), dim = c(M, K)) + post.b <- array(numeric(), dim = c(M, K)) + post.par <- list(a = post.a, b = post.b) + posts <- list(par = post.par) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - pars <- list(lambda = array(numeric(), dim = c(M, K))) - log.mixlik <- array(numeric(), dim = c(M, 1)) - log.mixprior <- array(numeric(), dim = c(M, 1)) - if (mcmc.obj@storepost) { - post.a <- array(numeric(), dim = c(M, K)) - post.b <- array(numeric(), dim = c(M, K)) - post.par <- list(a = post.a, b = post.b) - posts <- list(par = post.par) - if (!model.obj@indicfix) { - posts$weight <- array(numeric(), dim = c(M, K)) - } + } + ## Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## Model output with posterior parameters stored ## + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior ## + hypers <- list(b = array(numeric(), dim = c(M, 1))) + ## Model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfixhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## Model output with posterior parameters stored ## + mcmcout <- .mcmcoutputfixhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end hier } - ## Model with fixed indicators - if (model.obj@indicfix || K == 1) { - logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) - ## Model with simple prior - if (!prior.obj@hier) { - ## Model output with NO posterior parameters stored - if (!mcmc.obj@storepost) { - mcmcout <- .mcmcoutputfix(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - model = model.obj, - prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - return(mcmcout) - } else { - ## Model output with posterior parameters stored ## - mcmcout <- .mcmcoutputfixpost(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - post = posts, - model = model.obj, - prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - return(mcmcout) - } - ## end no hier - } else { - ## Model with hierarchical prior ## - hypers <- list(b = array(numeric(), dim = c(M, 1))) - ## Model output with NO posterior parameters stored ## - if (!mcmc.obj@storepost) { - mcmcout <- .mcmcoutputfixhier(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - model = model.obj, - prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - return(mcmcout) - } else { - ## Model output with posterior parameters stored ## - mcmcout <- .mcmcoutputfixhierpost(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, post = posts, - model = model.obj, - prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - return(mcmcout) - } - ## end hier - } - ## end indicfix - } else if (!model.obj@indicfix && K > 1) { + ## end indicfix + } else if (!model.obj@indicfix && K > 1) { ## Model with simulated indicators ## - log.cdpost <- array(numeric(), dim = c(M, 1)) - logs <- list(mixlik = log.mixlik, - mixprior = log.mixprior, - cdpost = log.cdpost) - weights <- array(numeric(), dim = c(M, K)) - entropies <- array(numeric(), dim = c(M, 1)) - STm <- array(integer(), dim = c(M, 1)) - Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) - NKm <- array(integer(), dim = c(M, K)) - clustm <- array(integer(), dim = c(N, 1)) - if (!mcmc.obj@startpar) { - ## First sample for the indicators - datac <- dataclass(fdata.obj, model.obj, simS = TRUE) - Sm[,1] <- as.integer(datac$S) + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, + mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$S) + } + ## Model with simple prior ## + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } else { + ## Model output with posterior parameters stored ## + mcmcout <- .mcmcoutputpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) } - ## Model with simple prior ## - if (!prior.obj@hier) { - ## Model output with NO posterior parameters stored ## - if (!mcmc.obj@storepost) { - mcmcout <- .mcmcoutputbase(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, model = model.obj, - prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(NA) - } - return(mcmcout) - } else { - ## Model output with posterior parameters stored ## - mcmcout <- .mcmcoutputpost(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, post = posts, - model = model.obj, prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(NA) - } - return(mcmcout) - } - ## end no hier - } else { - ## model with hierarchical prior ## - hypers <- list(b = array(numeric(), dim = c(M, 1))) - ## model output with NO posterior parameters stored ## - if (!mcmc.obj@storepost) { - mcmcout <- .mcmcoutputhier(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - model = model.obj, prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(NA) - } - return(mcmcout) - } else { - ## model output with posterior parameters stored ## - mcmcout <- .mcmcoutputhierpost(M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - post = posts, - model = model.obj, prior = prior.obj) - .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(NA) - } - return(mcmcout) - } - } ## end hier - } ## end no indicfix + return(mcmcout) + } + ## end no hier + } else { + ## model with hierarchical prior ## + hypers <- list(b = array(numeric(), dim = c(M, 1))) + ## model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } else { + ## model output with posterior parameters stored ## + mcmcout <- .mcmcoutputhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_poisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } + } ## end hier + } ## end no indicfix } ### ---------------------------------------------------------------------------- ### .do.MCMC.Binomial -### @description Performs MCMC simulation for A Binomial mixture model using +### @description Performs MCMC simulation for A Binomial mixture model using ### the Gibbs Sampler. ### @par fdata.obj an S4 object of class 'fdata' ### @par model.obj an S4 object of class 'model' @@ -438,1103 +501,1305 @@ ### @see ?mixturemcmc, ?fdata, ?model, ?prior, ?mcmc, ?mcmcoutput ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".do.MCMC.Binomial" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) -{ - ## Base slots inherited to every derived 'mcmcoutput' class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - burnin <- mcmc.obj@burnin - ranperm <- mcmc.obj@ranperm - pars <- list(p = array(numeric(), dim = c(c(M, K)))) - log.mixlik <- array(numeric(), dim = c(M, 1)) - log.mixprior <- array(numeric(), dim = c(M, 1)) - if (mcmc.obj@storepost) { - post.a <- array(numeric(), dim = c(M, K)) - post.b <- array(numeric(), dim = c(M, K)) - post.par <- list(a = post.a, b = post.b) - posts <- list(par = post.par) - if (!model.obj@indicfix) { - posts$weight <- array(numeric(), dim = c(M, K)) - } +".do.MCMC.Binomial" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { + ## Base slots inherited to every derived 'mcmcoutput' class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + burnin <- mcmc.obj@burnin + ranperm <- mcmc.obj@ranperm + pars <- list(p = array(numeric(), dim = c(c(M, K)))) + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + post.a <- array(numeric(), dim = c(M, K)) + post.b <- array(numeric(), dim = c(M, K)) + post.par <- list(a = post.a, b = post.b) + posts <- list(par = post.par) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - ## Model with fixed indicators - if (model.obj@indicfix || K == 1) { - logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) - if (!mcmc.obj@storepost) { - mcmcout <- .mcmcoutputfix(M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, model = model.obj, - prior = prior.obj) - .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - return(mcmcout) - } else { - ## MCMC output with posterior hyper parameters stored - mcmcout <- .mcmcoutputfixpost(M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, post = posts, - model = model.obj, prior = prior.obj) - .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix") - return(mcmcout) - } - ## End: indicfix - } else if (!model.obj@indicfix && K > 1) { - ## Model with simulated indicators - log.cdpost <- array(numeric(), dim = c(M, 1)) - logs <-list(mixlik = log.mixlik, mixprior = log.mixprior, - cdpost = log.cdpost) - weights <- array(numeric(), dim = c(M, K)) - entropies <- array(numeric(), dim = c(M, 1)) - STm <- array(integer(), dim = c(M, 1)) - Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) - NKm <- array(integer(), dim = c(M, K)) - clustm <- array(integer(), dim = c(N, 1)) - if (!mcmc.obj@startpar) { - ## First sample for the indicators - datac <- dataclass(fdata.obj, model.obj, simS = TRUE) - Sm[, 1] <- as.integer(datac$S) - } - if (!mcmc.obj@storepost) { - mcmcout <- .mcmcoutputbase(M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, weight = weights, - entropy = entropies, ST = STm, S = Sm, - NK = NKm, clust = clustm, - model = model.obj, prior = prior.obj) - .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, mcmc.obj, - mcmcout, PACKAGE = "finmix") - if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(NA) - } - return(mcmcout) - } else { - ## MCMC output with posterior hyper parameters stored - mcmcout <- .mcmcoutputpost(M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, weight = weights, - entropy = entropies, ST = STm, S = Sm, - NK = NKm, clust = clustm, post = posts, - model = model.obj, prior = prior.obj) - .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, mcmc.obj, - mcmcout, PACKAGE = "finmix") - if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(NA) - } - return(mcmcout) - } - } ## End no indicfix + } + ## Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## MCMC output with posterior hyper parameters stored + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## End: indicfix + } else if (!model.obj@indicfix && K > 1) { + ## Model with simulated indicators + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$S) + } + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, weight = weights, + entropy = entropies, ST = STm, S = Sm, + NK = NKm, clust = clustm, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, mcmc.obj, + mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } else { + ## MCMC output with posterior hyper parameters stored + mcmcout <- .mcmcoutputpost( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, weight = weights, + entropy = entropies, ST = STm, S = Sm, + NK = NKm, clust = clustm, post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_binomial_cc", fdata.obj, model.obj, prior.obj, mcmc.obj, + mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } + } ## End no indicfix } ### ------------------------------------------------------------------------- -### .do.MCMC.Exponential -### @description Prepares all object for the MCMC simulation of an -### Exponential model. +### .do.MCMC.Exponential +### @description Prepares all object for the MCMC simulation of an +### Exponential model. ### @param fdata.obj an S4 object of class 'fdata.obj' ### @param model.obj an S4 object of class 'model' ### @param prior.obj an S4 object of class 'prior' ### @param mcmc.obj an S4 object of class 'mcmc' ### @return an S4 object of class union 'mcmcoutput' -### @detail Internally the C++ routine 'mcmc_exponential_cc' is called +### @detail Internally the C++ routine 'mcmc_exponential_cc' is called ### @see ?mixturemcmc, mcmc_exponential_cc ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------- -".do.MCMC.Exponential" <- function( fdata.obj, model.obj, prior.obj, mcmc.obj ) -{ - # Base slots inherited to each derived class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - ranperm <- FALSE - burnin <- mcmc.obj@burnin - pars <- list( lambda = array( numeric(), dim = c( M, K) ) ) - log.mixlik <- array( numeric(), dim = c( M, 1 ) ) - log.mixprior <- array( numeric(), dim = c( M, 1 ) ) - if ( mcmc.obj@storepost ) { - post.a <- array( numeric(), dim = c( M, K ) ) - post.b <- array( numeric(), dim = c( M, K ) ) - post.par <- list( a = post.a, b = post.b ) - posts <- list( par = post.par ) - if ( !model.obj@indicfix ) { - posts$weight <- array( numeric(), dim = c( M, K ) ) - } +".do.MCMC.Exponential" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { + # Base slots inherited to each derived class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + ranperm <- FALSE + burnin <- mcmc.obj@burnin + pars <- list(lambda = array(numeric(), dim = c(M, K))) + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + post.a <- array(numeric(), dim = c(M, K)) + post.b <- array(numeric(), dim = c(M, K)) + post.par <- list(a = post.a, b = post.b) + posts <- list(par = post.par) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - # Model with fixed indicators - if ( model.obj@indicfix || K == 1 ) { - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior ) - # Model with simple prior - if ( !mcmc.obj@storepost ) { - # Model output with NO posterior parameters stored - mcmcout <- .mcmcoutputfix( M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, model = model.obj, - prior = prior.obj ) - } else { - # Model output with posterior parameters stored - mcmcout <- .mcmcoutputfixpost( M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, post = posts, - model = model.obj, prior = prior.obj ) - } - } else if ( !model.obj@indicfix && K > 1 ) { - # Model with simulated indicators - log.cdpost <- array( numeric(), dim = c( M, 1 ) ) - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior, - cdpost = log.cdpost ) - weights <- array( numeric(), dim = c( M, K ) ) - entropies <- array( numeric(), dim = c( M, 1 ) ) - STm <- array( integer(), dim = c( M, 1 ) ) - Sm <- array( integer(), dim = c( N, mcmc.obj@storeS ) ) - NKm <- array( integer(), dim = c( M, K ) ) - clustm <- array( integer(), dim = c( N, 1 ) ) - if ( !mcmc.obj@startpar ) { - # First sample for the indicators - datac <- dataclass( fdata.obj, model.obj, simS = TRUE ) - SM[, 1] <- as.integer( datac$S ) - } - # Model with simple prior - # Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputbase( M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, weight = weights, - entropy = entropies, ST = STm, S = Sm, - NK = NKm, clust = clustm, model = model.obj, - prior = prior.obj ) - } else { - # Model output with posterior parameters stored - mcmcout <- .mcmcoutputpost( M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logs, weight = weights, - entropy = entropies, ST = STm, S = Sm, - NK = NKm, clust = clustm, post = posts, - model = model.obj, prior = prior.obj ) - } - } - .Call( "mcmc_exponential_cc", fdata.obj, model.obj, prior.obj, mcmc.obj, - mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( NA ) + } + # Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + # Model with simple prior + if (!mcmc.obj@storepost) { + # Model output with NO posterior parameters stored + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, model = model.obj, + prior = prior.obj + ) + } else { + # Model output with posterior parameters stored + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, post = posts, + model = model.obj, prior = prior.obj + ) + } + } else if (!model.obj@indicfix && K > 1) { + # Model with simulated indicators + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + # First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + SM[, 1] <- as.integer(datac$S) } - return( mcmcout ) + # Model with simple prior + # Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, weight = weights, + entropy = entropies, ST = STm, S = Sm, + NK = NKm, clust = clustm, model = model.obj, + prior = prior.obj + ) + } else { + # Model output with posterior parameters stored + mcmcout <- .mcmcoutputpost( + M = M, burnin = burnin, ranperm = ranperm, + par = pars, log = logs, weight = weights, + entropy = entropies, ST = STm, S = Sm, + NK = NKm, clust = clustm, post = posts, + model = model.obj, prior = prior.obj + ) + } + } + .Call("mcmc_exponential_cc", fdata.obj, model.obj, prior.obj, mcmc.obj, + mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) } -".do.MCMC.CondPoisson" <- function( fdata.obj, model.obj, prior.obj, mcmc.obj ) -{ - if ( nrow( fdata.obj@exp ) == 1 ) { - if ( is.na( fdata.obj@exp ) ) { - fdata.obj@exp <- matrix( 1, nrow = fdata.obj@N, ncol = 1 ) - } else { - fdata.obj@exp <- matrix( fdata.obj@exp, nrow = fdata.obj@N, ncol = 1 ) - } +".do.MCMC.CondPoisson" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { + if (nrow(fdata.obj@exp) == 1) { + if (is.na(fdata.obj@exp)) { + fdata.obj@exp <- matrix(1, nrow = fdata.obj@N, ncol = 1) + } else { + fdata.obj@exp <- matrix(fdata.obj@exp, nrow = fdata.obj@N, ncol = 1) } - if ( mcmc.obj@ranperm ) { - mcmc.obj@ranperm <- FALSE + } + if (mcmc.obj@ranperm) { + mcmc.obj@ranperm <- FALSE + } + ## base slots inherited to every derived class ## + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + burnin <- mcmc.obj@burnin + ranperm <- mcmc.obj@ranperm + pars <- list( + lambda = array(numeric(), dim = c(M, K)), + acc = 0.0 + ) + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + post.Q <- array(numeric(), dim = c(M, K)) + post.N <- array(numeric(), dim = c(M, K)) + post.par <- list(Q = post.Q, N = post.N) + posts <- list(par = post.par) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - ## base slots inherited to every derived class ## - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - burnin <- mcmc.obj@burnin - ranperm <- mcmc.obj@ranperm - pars <- list( lambda = array( numeric(), dim = c( M, K ) ), - acc = 0.0 ) - log.mixlik <- array( numeric(), dim = c( M, 1 ) ) - log.mixprior <- array( numeric(), dim = c( M, 1 ) ) - if (mcmc.obj@storepost) { - post.Q <- array( numeric(), dim = c( M, K ) ) - post.N <- array( numeric(), dim = c( M, K ) ) - post.par <- list( Q = post.Q, N = post.N ) - posts <- list( par = post.par ) - if ( !model.obj@indicfix ) { - posts$weight <- array( numeric(), dim = c( M, K ) ) - } + } + ## model with fixed indicators ## + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + ## model with simple prior ## + if (!prior.obj@hier) { + ## model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## model output with posterior parameters stored ## + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end no hier + } else { + ## model with hierarchical prior ## + hypers <- list(b = array(numeric(), dim = c(M, 1))) + ## model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfixhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## model output with posterior parameters stored ## + mcmcout <- .mcmcoutputfixhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end hier } - ## model with fixed indicators ## - if ( model.obj@indicfix || K == 1 ) { - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior ) - ## model with simple prior ## - if ( !prior.obj@hier ) { - ## model output with NO posterior parameters stored ## - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfix( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } else { - ## model output with posterior parameters stored ## - mcmcout <- .mcmcoutputfixpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } - ## end no hier - } else { - ## model with hierarchical prior ## - hypers <- list( b = array( numeric(), dim = c( M, 1 ) ) ) - ## model output with NO posterior parameters stored ## - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfixhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } else { - ## model output with posterior parameters stored ## - mcmcout <- .mcmcoutputfixhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } - ## end hier - } - ## end indicfix - } else if ( !model.obj@indicfix && K > 1 ) { + ## end indicfix + } else if (!model.obj@indicfix && K > 1) { ## model with simulated indicators ## - log.cdpost <- array( numeric(), dim = c( M, 1 ) ) - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior, - cdpost = log.cdpost ) - weights <- array( numeric(), dim = c( M, K ) ) - entropies <- array( numeric(), dim = c( M, 1 ) ) - STm <- array( integer(), dim = c( M, 1 ) ) - Sm <- array( integer(), dim = c( N, mcmc.obj@storeS ) ) - NKm <- array( integer(), dim = c( M, K ) ) - clustm <- array( integer(), dim = c( N, 1 ) ) - if ( !mcmc.obj@startpar ) { - ## First sample for the indicators - datac <- dataclass( fdata.obj, model.obj, simS = TRUE ) - Sm[,1] <- as.integer( datac$S ) + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$S) + } + ## model with simple prior ## + if (!prior.obj@hier) { + ## model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } else { + ## model output with posterior parameters stored ## + mcmcout <- .mcmcoutputpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } + ## end no hier + } else { + ## model with hierarchical prior ## + hypers <- list(b = array(numeric(), dim = c(M, 1))) + ## model output with NO posterior parameters stored ## + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) } - ## model with simple prior ## - if ( !prior.obj@hier ) { - ## model output with NO posterior parameters stored ## - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputbase( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( NA ) - } - return( mcmcout ) - } else { - ## model output with posterior parameters stored ## - mcmcout <- .mcmcoutputpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, post = posts, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( NA ) - } - return( mcmcout ) - } - ## end no hier - } else { - ## model with hierarchical prior ## - hypers <- list( b = array( numeric(), dim = c( M, 1 ) ) ) - ## model output with NO posterior parameters stored ## - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( NA ) - } - return( mcmcout ) - } else { - ## model output with posterior parameters stored ## - mcmcout <- .mcmcoutputhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - post = posts, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( NA ) - } - return( mcmcout ) - } - } ## end hier - } ## end no indicfix + return(mcmcout) + } else { + ## model output with posterior parameters stored ## + mcmcout <- .mcmcoutputhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_condpoisson_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(NA) + } + return(mcmcout) + } + } ## end hier + } ## end no indicfix } -".do.MCMC.Normal" <- function( fdata.obj, model.obj, prior.obj, - mcmc.obj ) -{ - ## Base slots inherited to each derived class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - ranperm <- mcmc.obj@ranperm - burnin <- mcmc.obj@burnin - ## Set for MCMC default exposures: - pars <- list( mu = array( numeric(), dim = c( M, K ) ), - sigma = array( numeric(), dim = c( M, K ) ) ) - log.mixlik <- array( numeric(), dim = c( M, 1 ) ) - log.mixprior <- array( numeric(), dim = c( M, 1 ) ) - if ( mcmc.obj@storepost ) { - b.post <- array( numeric(), dim = c( M, K ) ) - B.post <- array( numeric(), dim = c( M, K ) ) - mu.post <- list( b = b.post, B = B.post ) - c.post <- array( numeric(), dim = c( M, K ) ) - C.post <- array( numeric(), dim = c( M, K ) ) - sigma.post <- list( c = c.post, C = C.post ) - par.post <- list( mu = mu.post, sigma = sigma.post ) - posts <- list( par = par.post ) - if ( !model.obj@indicfix ) { - posts$weight <- array( numeric(), dim = c( M, K ) ) - } +".do.MCMC.Normal" <- function(fdata.obj, model.obj, prior.obj, + mcmc.obj) { + ## Base slots inherited to each derived class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + ranperm <- mcmc.obj@ranperm + burnin <- mcmc.obj@burnin + ## Set for MCMC default exposures: + pars <- list( + mu = array(numeric(), dim = c(M, K)), + sigma = array(numeric(), dim = c(M, K)) + ) + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + b.post <- array(numeric(), dim = c(M, K)) + B.post <- array(numeric(), dim = c(M, K)) + mu.post <- list(b = b.post, B = B.post) + c.post <- array(numeric(), dim = c(M, K)) + C.post <- array(numeric(), dim = c(M, K)) + sigma.post <- list(c = c.post, C = C.post) + par.post <- list(mu = mu.post, sigma = sigma.post) + posts <- list(par = par.post) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) + } + } + ## Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, 1))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- mcmcoutputfixhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- mcmcoutputfixhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logd, + hyper = hypers, post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end hier + } + ## end indicfix + } else if (!model.obj@indicfix && K > 1) { + ## Model with simulated indicators + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, + mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$s) } - ## Model with fixed indicators - if ( model.obj@indicfix || K == 1 ) { - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior ) - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfix( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } else { - mcmcout <- .mcmcoutputfixpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, 1 ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- mcmcoutputfixhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- mcmcoutputfixhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logd, - hyper = hypers, post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } - ## end hier - } - ## end indicfix - } else if ( !model.obj@indicfix && K > 1 ) { - ## Model with simulated indicators - log.cdpost <- array( numeric(), dim = c( M, 1 ) ) - logs <- list( mixlik = log.mixlik, - mixprior = log.mixprior, - cdpost = log.cdpost ) - weights <- array( numeric(), dim = c( M, K ) ) - entropies <- array( numeric(), dim = c( M, 1 ) ) - STm <- array( integer(), dim = c( M, 1 ) ) - Sm <- array( integer(), dim = c( N, mcmc.obj@storeS ) ) - NKm <- array( integer(), dim = c( M, K ) ) - clustm <- array( integer(), dim = c( N, 1 ) ) - if ( !mcmc.obj@startpar ) { - ## First sample for the indicators - datac <- dataclass( fdata.obj, model.obj, simS = TRUE ) - Sm[, 1] <- as.integer( datac$s ) + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) } - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputbase( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if( mcmc.obj@storeS == 0 ){ - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } else { - ## Model output with posterior parameters stored - mcmcout <- .mcmcoutputpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, post = posts, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, 1 ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( ias.integer( NA ) ) - } - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- .mcmcoutputhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - post = posts, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normal_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } - } ## end hier - } ## end no indicfix + return(mcmcout) + } else { + ## Model output with posterior parameters stored + mcmcout <- .mcmcoutputpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, 1))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(ias.integer(NA)) + } + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- .mcmcoutputhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + post = posts, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normal_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + return(mcmcout) + } + } ## end hier + } ## end no indicfix } -".do.MCMC.Student" <- function( fdata.obj, model.obj, prior.obj, - mcmc.obj ) -{ - ## Base slots inherited to each derived class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - ranperm <- mcmc.obj@ranperm - burnin <- mcmc.obj@burnin - ## Set for MCMC default exposures: - pars <- list( mu = array( numeric(), dim = c( M, K ) ), - sigma = array( numeric(), dim = c( M, K ) ), - df = array( numeric(), dim = c( M, K ) ), - acc = array( 0.0, dim = c( 1, K ) ) ) - log.mixlik <- array( numeric(), dim = c( M, 1 ) ) - log.mixprior <- array( numeric(), dim = c( M, 1 ) ) - if ( mcmc.obj@storepost ) { - b.post <- array( numeric(), dim = c( M, K ) ) - B.post <- array( numeric(), dim = c( M, K ) ) - mu.post <- list( b = b.post, B = B.post ) - c.post <- array( numeric(), dim = c( M, K ) ) - C.post <- array( numeric(), dim = c( M, K ) ) - sigma.post <- list( c = c.post, C = C.post ) - par.post <- list( mu = mu.post, sigma = sigma.post ) - posts <- list( par = par.post ) - if ( !model.obj@indicfix ) { - posts$weight <- array( numeric(), dim = c( M, K ) ) - } +".do.MCMC.Student" <- function(fdata.obj, model.obj, prior.obj, + mcmc.obj) { + ## Base slots inherited to each derived class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + ranperm <- mcmc.obj@ranperm + burnin <- mcmc.obj@burnin + ## Set for MCMC default exposures: + pars <- list( + mu = array(numeric(), dim = c(M, K)), + sigma = array(numeric(), dim = c(M, K)), + df = array(numeric(), dim = c(M, K)), + acc = array(0.0, dim = c(1, K)) + ) + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + b.post <- array(numeric(), dim = c(M, K)) + B.post <- array(numeric(), dim = c(M, K)) + mu.post <- list(b = b.post, B = B.post) + c.post <- array(numeric(), dim = c(M, K)) + C.post <- array(numeric(), dim = c(M, K)) + sigma.post <- list(c = c.post, C = C.post) + par.post <- list(mu = mu.post, sigma = sigma.post) + posts <- list(par = par.post) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - ## Model with fixed indicators - if ( model.obj@indicfix || K == 1 ) { - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior ) - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfix( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } else { - mcmcout <- .mcmcoutputfixpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, 1 ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- mcmcoutputfixhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- mcmcoutputfixhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logd, - hyper = hypers, post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - return( mcmcout ) - } - ## end hier - } - ## end indicfix - } else if ( !model.obj@indicfix && K > 1 ) { - ## Model with simulated indicators - log.cdpost <- array( numeric(), dim = c( M, 1 ) ) - logs <- list( mixlik = log.mixlik, - mixprior = log.mixprior, - cdpost = log.cdpost ) - weights <- array( numeric(), dim = c( M, K ) ) - entropies <- array( numeric(), dim = c( M, 1 ) ) - STm <- array( integer(), dim = c( M, 1 ) ) - Sm <- array( integer(), dim = c( N, mcmc.obj@storeS ) ) - NKm <- array( integer(), dim = c( M, K ) ) - clustm <- array( integer(), dim = c( N, 1 ) ) - if ( !mcmc.obj@startpar ) { - ## First sample for the indicators - datac <- dataclass( fdata.obj, model.obj, simS = TRUE ) - Sm[, 1] <- as.integer( datac$s ) + } + ## Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, 1))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- mcmcoutputfixhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- mcmcoutputfixhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logd, + hyper = hypers, post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + return(mcmcout) + } + ## end hier + } + ## end indicfix + } else if (!model.obj@indicfix && K > 1) { + ## Model with simulated indicators + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, + mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$s) + } + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + return(mcmcout) + } else { + ## Model output with posterior parameters stored + mcmcout <- .mcmcoutputpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, post = posts, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, 1))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- .mcmcoutputhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + post = posts, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_student_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) } - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputbase( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if( mcmc.obj@storeS == 0 ){ - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } else { - ## Model output with posterior parameters stored - mcmcout <- .mcmcoutputpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, post = posts, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, 1 ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- .mcmcoutputhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - post = posts, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_student_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - return( mcmcout ) - } - } ## end hier - } ## end no indicfix + return(mcmcout) + } + } ## end hier + } ## end no indicfix } -".do.MCMC.Normult" <- function( fdata.obj, model.obj, prior.obj, mcmc.obj ) -{ - ## Base slots inherited to each derived class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - ranperm <- mcmc.obj@ranperm - burnin <- mcmc.obj@burnin +".do.MCMC.Normult" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { + ## Base slots inherited to each derived class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + ranperm <- mcmc.obj@ranperm + burnin <- mcmc.obj@burnin - ## Constants simplifying construction - r <- fdata.obj@r - s <- r * (r + 1) / 2 + ## Constants simplifying construction + r <- fdata.obj@r + s <- r * (r + 1) / 2 - ## Set for MCMC default expousres - pars <- list( mu = array( numeric(), dim = c( M, r, K ) ), - sigma = array( numeric(), dim = c( M, s, K ) ), - storeinv = mcmc.obj@storeinv ) - if ( mcmc.obj@storeinv ) { - pars$sigmainv <- array( numeric(), dim = c( M, s, K ) ) + ## Set for MCMC default expousres + pars <- list( + mu = array(numeric(), dim = c(M, r, K)), + sigma = array(numeric(), dim = c(M, s, K)), + storeinv = mcmc.obj@storeinv + ) + if (mcmc.obj@storeinv) { + pars$sigmainv <- array(numeric(), dim = c(M, s, K)) + } + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + b.post <- array(numeric(), dim = c(M, r, K)) + B.post <- array(numeric(), dim = c(M, s, K)) + mu.post <- list(b = b.post, B = B.post) + c.post <- array(numeric(), dim = c(M, K)) + C.post <- array(numeric(), dim = c(M, s, K)) + sigma.post <- list(c = c.post, C = C.post) + par.post <- list(mu = mu.post, sigma = sigma.post) + posts <- list(par = par.post) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - log.mixlik <- array( numeric(), dim = c( M, 1 ) ) - log.mixprior <- array( numeric(), dim = c( M, 1 ) ) - if ( mcmc.obj@storepost ) { - b.post <- array( numeric(), dim = c( M, r, K ) ) - B.post <- array( numeric(), dim = c( M, s, K ) ) - mu.post <- list( b = b.post, B = B.post ) - c.post <- array( numeric(), dim = c( M, K ) ) - C.post <- array( numeric(), dim = c( M, s, K ) ) - sigma.post <- list( c = c.post, C = C.post ) - par.post <- list( mu = mu.post, sigma = sigma.post ) - posts <- list( par = par.post ) - if ( !model.obj@indicfix ) { - posts$weight <- array( numeric(), dim = c( M, K ) ) - } + } + ## Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, s))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfixhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- .mcmcoutputfixhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + ## end hier + } + ## end indicfix + } else if (!model.obj@indicfix && K > 1) { + ## Model with simulated indicators + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, + mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$s) } - ## Model with fixed indicators - if ( model.obj@indicfix || K == 1 ) { - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior ) - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfix( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - mcmcout <- .mcmcoutputfixpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, s ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfixhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- .mcmcoutputfixhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - ## end hier + ## Model with simple prior + if (!prior.obj@hier) { + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) } - ## end indicfix - } else if ( !model.obj@indicfix && K > 1 ) { - ## Model with simulated indicators - log.cdpost <- array( numeric(), dim = c( M, 1 ) ) - logs <- list( mixlik = log.mixlik, - mixprior = log.mixprior, - cdpost = log.cdpost ) - weights <- array( numeric(), dim = c( M, K ) ) - entropies <- array( numeric(), dim = c( M, 1 ) ) - STm <- array( integer(), dim = c( M, 1 ) ) - Sm <- array( integer(), dim = c( N, mcmc.obj@storeS ) ) - NKm <- array( integer(), dim = c( M, K ) ) - clustm <- array( integer(), dim = c( N, 1 ) ) - if ( !mcmc.obj@startpar ) { - ## First sample for the indicators - datac <- dataclass( fdata.obj, model.obj, simS = TRUE ) - Sm[, 1] <- as.integer( datac$s ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + ## Model output with posterior parameters stored + mcmcout <- .mcmcoutpupost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, post = postm, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) } - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model with NO posterior parameters stored - if (!mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputbase( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - ## Model output with posterior parameters stored - mcmcout <- .mcmcoutpupost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, post = postm, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, s ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- .mcmcoutputhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - post = posts, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_normult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - } ## end hier - } ## end no indicfix + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, s))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- .mcmcoutputhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + post = posts, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + } ## end hier + } ## end no indicfix } -".do.MCMC.Studmult" <- function( fdata.obj, model.obj, prior.obj, mcmc.obj ) -{ - ## Base slots inherited to each derived class - K <- model.obj@K - N <- fdata.obj@N - M <- mcmc.obj@M - ranperm <- mcmc.obj@ranperm - burnin <- mcmc.obj@burnin +".do.MCMC.Studmult" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { + ## Base slots inherited to each derived class + K <- model.obj@K + N <- fdata.obj@N + M <- mcmc.obj@M + ranperm <- mcmc.obj@ranperm + burnin <- mcmc.obj@burnin - ## Constants simplifying construction - r <- fdata.obj@r - s <- r * (r + 1) / 2 + ## Constants simplifying construction + r <- fdata.obj@r + s <- r * (r + 1) / 2 - ## Set for MCMC default expousres - pars <- list( mu = array( numeric(), dim = c( M, r, K ) ), - sigma = array( numeric(), dim = c( M, s, K ) ), - df = array( numeric(), dim = c( M, K ) ), - acc = array( 0.0 , dim = c( 1, K ) ), - storeinv = mcmc.obj@storeinv ) - if ( mcmc.obj@storeinv ) { - pars$sigmainv <- array( numeric(), dim = c( M, s, K ) ) + ## Set for MCMC default expousres + pars <- list( + mu = array(numeric(), dim = c(M, r, K)), + sigma = array(numeric(), dim = c(M, s, K)), + df = array(numeric(), dim = c(M, K)), + acc = array(0.0, dim = c(1, K)), + storeinv = mcmc.obj@storeinv + ) + if (mcmc.obj@storeinv) { + pars$sigmainv <- array(numeric(), dim = c(M, s, K)) + } + log.mixlik <- array(numeric(), dim = c(M, 1)) + log.mixprior <- array(numeric(), dim = c(M, 1)) + if (mcmc.obj@storepost) { + b.post <- array(numeric(), dim = c(M, r, K)) + B.post <- array(numeric(), dim = c(M, s, K)) + mu.post <- list(b = b.post, B = B.post) + c.post <- array(numeric(), dim = c(M, K)) + C.post <- array(numeric(), dim = c(M, s, K)) + sigma.post <- list(c = c.post, C = C.post) + par.post <- list(mu = mu.post, sigma = sigma.post) + posts <- list(par = par.post) + if (!model.obj@indicfix) { + posts$weight <- array(numeric(), dim = c(M, K)) } - log.mixlik <- array( numeric(), dim = c( M, 1 ) ) - log.mixprior <- array( numeric(), dim = c( M, 1 ) ) - if ( mcmc.obj@storepost ) { - b.post <- array( numeric(), dim = c( M, r, K ) ) - B.post <- array( numeric(), dim = c( M, s, K ) ) - mu.post <- list( b = b.post, B = B.post ) - c.post <- array( numeric(), dim = c( M, K ) ) - C.post <- array( numeric(), dim = c( M, s, K ) ) - sigma.post <- list( c = c.post, C = C.post ) - par.post <- list( mu = mu.post, sigma = sigma.post ) - posts <- list( par = par.post ) - if ( !model.obj@indicfix ) { - posts$weight <- array( numeric(), dim = c( M, K ) ) - } + } + ## Model with fixed indicators + if (model.obj@indicfix || K == 1) { + logs <- list(mixlik = log.mixlik, mixprior = log.mixprior) + ## Model with simple prior + if (!prior.obj@hier) { + ## Model output with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfix( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + mcmcout <- .mcmcoutputfixpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, s))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputfixhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- .mcmcoutputfixhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + hyper = hypers, post = posts, + model = model.obj, + prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + ## end hier } - ## Model with fixed indicators - if ( model.obj@indicfix || K == 1 ) { - logs <- list( mixlik = log.mixlik, mixprior = log.mixprior ) - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model output with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfix( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - mcmcout <- .mcmcoutputfixpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, s ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputfixhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- .mcmcoutputfixhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - hyper = hypers, post = posts, - model = model.obj, - prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - ## end hier + ## end indicfix + } else if (!model.obj@indicfix && K > 1) { + ## Model with simulated indicators + log.cdpost <- array(numeric(), dim = c(M, 1)) + logs <- list( + mixlik = log.mixlik, + mixprior = log.mixprior, + cdpost = log.cdpost + ) + weights <- array(numeric(), dim = c(M, K)) + entropies <- array(numeric(), dim = c(M, 1)) + STm <- array(integer(), dim = c(M, 1)) + Sm <- array(integer(), dim = c(N, mcmc.obj@storeS)) + NKm <- array(integer(), dim = c(M, K)) + clustm <- array(integer(), dim = c(N, 1)) + if (!mcmc.obj@startpar) { + ## First sample for the indicators + datac <- dataclass(fdata.obj, model.obj, simS = TRUE) + Sm[, 1] <- as.integer(datac$s) + } + ## Model with simple prior + if (!prior.obj@hier) { + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputbase( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + ## Model output with posterior parameters stored + mcmcout <- .mcmcoutpupost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, post = postm, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) } - ## end indicfix - } else if ( !model.obj@indicfix && K > 1 ) { - ## Model with simulated indicators - log.cdpost <- array( numeric(), dim = c( M, 1 ) ) - logs <- list( mixlik = log.mixlik, - mixprior = log.mixprior, - cdpost = log.cdpost ) - weights <- array( numeric(), dim = c( M, K ) ) - entropies <- array( numeric(), dim = c( M, 1 ) ) - STm <- array( integer(), dim = c( M, 1 ) ) - Sm <- array( integer(), dim = c( N, mcmc.obj@storeS ) ) - NKm <- array( integer(), dim = c( M, K ) ) - clustm <- array( integer(), dim = c( N, 1 ) ) - if ( !mcmc.obj@startpar ) { - ## First sample for the indicators - datac <- dataclass( fdata.obj, model.obj, simS = TRUE ) - Sm[, 1] <- as.integer( datac$s ) + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + ## end no hier + } else { + ## Model with hierarchical prior + hypers <- list(C = array(numeric(), dim = c(M, s))) + ## Model with NO posterior parameters stored + if (!mcmc.obj@storepost) { + mcmcout <- .mcmcoutputhier( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + model = model.obj, prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) } - ## Model with simple prior - if ( !prior.obj@hier ) { - ## Model with NO posterior parameters stored - if (!mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputbase( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - ## Model output with posterior parameters stored - mcmcout <- .mcmcoutpupost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, post = postm, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - ## end no hier - } else { - ## Model with hierarchical prior - hypers <- list( C = array( numeric(), dim = c( M, s ) ) ) - ## Model with NO posterior parameters stored - if ( !mcmc.obj@storepost ) { - mcmcout <- .mcmcoutputhier( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - model = model.obj, prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } else { - ## Model with posterior parameters stored - mcmcout <- .mcmcoutputhierpost( M = M, burnin = burnin, - ranperm = ranperm, - par = pars, log = logs, - weight = weights, - entropy = entropies, - ST = STm, S = Sm, NK = NKm, - clust = clustm, hyper = hypers, - post = posts, model = model.obj, - prior = prior.obj ) - .Call( "mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, - mcmc.obj, mcmcout, PACKAGE = "finmix" ) - if ( mcmc.obj@storeS == 0 ) { - mcmcout@S <- as.array( as.integer( NA ) ) - } - mcmcout@par$storeinv <- NULL - return( mcmcout ) - } - } ## end hier - } ## end no indicfix + mcmcout@par$storeinv <- NULL + return(mcmcout) + } else { + ## Model with posterior parameters stored + mcmcout <- .mcmcoutputhierpost( + M = M, burnin = burnin, + ranperm = ranperm, + par = pars, log = logs, + weight = weights, + entropy = entropies, + ST = STm, S = Sm, NK = NKm, + clust = clustm, hyper = hypers, + post = posts, model = model.obj, + prior = prior.obj + ) + .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, + mcmc.obj, mcmcout, + PACKAGE = "finmix" + ) + if (mcmc.obj@storeS == 0) { + mcmcout@S <- as.array(as.integer(NA)) + } + mcmcout@par$storeinv <- NULL + return(mcmcout) + } + } ## end hier + } ## end no indicfix } - diff --git a/R/mixturemoments.R b/R/mixturemoments.R index 88d4505..30b26d9 100644 --- a/R/mixturemoments.R +++ b/R/mixturemoments.R @@ -16,76 +16,74 @@ # along with finmix. If not, see . ".mixturemoments.normal" <- function(model, J, meanm) { - - zm <- array(0, dim = c(J, 1)) - zm[seq(2,J, by = 2)] <- exp(cumsum(log(seq(1,(J-1), by = 2)))) - moments <- array(0, dim = c(J, 1)) + zm <- array(0, dim = c(J, 1)) + zm[seq(2, J, by = 2)] <- exp(cumsum(log(seq(1, (J - 1), by = 2)))) + moments <- array(0, dim = c(J, 1)) - for(m in 2:J) { ## first higher moment is always zero - diff <- model@par$mu - meanm - moments[m] <- sum(model@weight * diff^m) - for(n in 1:m) { - cm = diff^(m - n) * model@par$sigma^(n/2)*zm[n] - moments[m] = moments[m] + choose(m, n) * sum(model@weight * cm) - } - } - - return(moments) + for (m in 2:J) { ## first higher moment is always zero + diff <- model@par$mu - meanm + moments[m] <- sum(model@weight * diff^m) + for (n in 1:m) { + cm <- diff^(m - n) * model@par$sigma^(n / 2) * zm[n] + moments[m] <- moments[m] + choose(m, n) * sum(model@weight * cm) + } + } + + return(moments) } ".mixturemoments.student" <- function(model, J, meanm) { - moments <- array(0, dim = c(J, 1)) - sigma <- model@par$sigma - mu <- model@par$mu - degrees <- model@par$df - weight <- model@weight - diff <- mu - meanm - raw.moments <- array(0, dim = c(1, model@K)) - for(j in seq(1, J)) { - moments[j] <- sum(diff^j * weight) - for(n in seq(1, j)) { - raw.moments <- .raw.moments.student(n, sigma, degrees) - moments[j] <- moments[j] + sum(choose(j, n) * - diff^(j - n) * raw.moments * weight) - } + moments <- array(0, dim = c(J, 1)) + sigma <- model@par$sigma + mu <- model@par$mu + degrees <- model@par$df + weight <- model@weight + diff <- mu - meanm + raw.moments <- array(0, dim = c(1, model@K)) + for (j in seq(1, J)) { + moments[j] <- sum(diff^j * weight) + for (n in seq(1, j)) { + raw.moments <- .raw.moments.student(n, sigma, degrees) + moments[j] <- moments[j] + sum(choose(j, n) * + diff^(j - n) * raw.moments * weight) } - return(moments) + } + return(moments) } ".mixturemoments.exponential" <- function(model, J, meanm) { - moments <- array(0, dim = c(J, 1)) - lambda <- model@par$lambda - weight <- model@weight - diff <- 1/lambda - meanm - for(j in seq(1, J)) { - moments[j] <- sum(diff^j * weight) ## case E[(X-mu)^0] - for(n in seq(1, j)) { - raw.moments <- .raw.moments.exponential(n, lambda) - moments[j] <- moments[j] + sum(choose(j, n) * - diff^(j - n) * raw.moments * weight) - } + moments <- array(0, dim = c(J, 1)) + lambda <- model@par$lambda + weight <- model@weight + diff <- 1 / lambda - meanm + for (j in seq(1, J)) { + moments[j] <- sum(diff^j * weight) ## case E[(X-mu)^0] + for (n in seq(1, j)) { + raw.moments <- .raw.moments.exponential(n, lambda) + moments[j] <- moments[j] + sum(choose(j, n) * + diff^(j - n) * raw.moments * weight) } - return(moments) + } + return(moments) } -".raw.moments.student" <- function(n, sigma, degrees) -{ - value <- array(0, dim = c(1, length(degrees))) - if (n > 0 && n %% 2 == 0) { - for(i in seq(1, n/2)) { - value <- (2 * i - 1)/(degrees - 2 * i) * degrees^(n/2) * sqrt(sigma)^n - } - value[degrees <= n] <- Inf - } else { - value[degrees <= n] <- NaN +".raw.moments.student" <- function(n, sigma, degrees) { + value <- array(0, dim = c(1, length(degrees))) + if (n > 0 && n %% 2 == 0) { + for (i in seq(1, n / 2)) { + value <- (2 * i - 1) / (degrees - 2 * i) * degrees^(n / 2) * sqrt(sigma)^n } - return(value) + value[degrees <= n] <- Inf + } else { + value[degrees <= n] <- NaN + } + return(value) } ".raw.moments.exponential" <- function(n, lambda) { - values <- rep(0, length(lambda)) - for(i in seq(0, n)) { - values <- values + factorial(n)/lambda^n * (-1)^i/factorial(i) - } - return(values) + values <- rep(0, length(lambda)) + for (i in seq(0, n)) { + values <- values + factorial(n) / lambda^n * (-1)^i / factorial(i) + } + return(values) } diff --git a/R/model.R b/R/model.R index e63895f..1fa9b5f 100644 --- a/R/model.R +++ b/R/model.R @@ -15,375 +15,392 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.model <- setClass( "model", - representation( dist = "character", - r = "integer", - K = "integer", - weight = "matrix", - par = "list", - indicmod = "character", - indicfix = "logical", - T = "matrix"), - validity = function( object ) { - .init.valid.Model( object ) - ## else: OK ## - TRUE - }, - prototype( dist = character(), - r = integer(), - K = integer(), - weight = matrix(), - par = list(), - indicmod = character(), - indicfix = logical(), - T = matrix() - ) +.model <- setClass("model", + representation( + dist = "character", + r = "integer", + K = "integer", + weight = "matrix", + par = "list", + indicmod = "character", + indicfix = "logical", + T = "matrix" + ), + validity = function(object) { + .init.valid.Model(object) + ## else: OK ## + TRUE + }, + prototype( + dist = character(), + r = integer(), + K = integer(), + weight = matrix(), + par = list(), + indicmod = character(), + indicfix = logical(), + T = matrix() + ) ) ## Constructor for class 'model' ## -"model" <- function( dist = "poisson", r, K, - weight = matrix(), par = list(), - indicmod = "multinomial", - indicfix = FALSE, T = matrix() ) -{ - if ( missing( K ) ) { - K <- .check.K.Model( weight ) - } else { - K <- as.integer( K ) - if ( K == 1 && dist == "cond.poisson" ) { - dist <- "poisson" - } +"model" <- function(dist = "poisson", r, K, + weight = matrix(), par = list(), + indicmod = "multinomial", + indicfix = FALSE, T = matrix()) { + if (missing(K)) { + K <- .check.K.Model(weight) + } else { + K <- as.integer(K) + if (K == 1 && dist == "cond.poisson") { + dist <- "poisson" } - if ( missing( r ) ) { - r <- .check.r.Model( dist ) - } else { - r <- as.integer( r ) + } + if (missing(r)) { + r <- .check.r.Model(dist) + } else { + r <- as.integer(r) + } + if (missing(weight) && K > 1) { + weight <- .check.weight.Model(K) + } else { + weight <- as.matrix(weight) + } + if (!missing(T)) { + T <- .check.T.Model(T) + } else { + if (dist == "binomial") { + T <- matrix(as.integer(1)) } - if ( missing( weight ) && K > 1 ) { - weight <- .check.weight.Model( K ) - } else { - weight <- as.matrix( weight ) - } - if ( !missing( T ) ) { - T <- .check.T.Model( T ) - } else { - if ( dist == "binomial" ) { - T <- matrix( as.integer( 1 ) ) - } - } - - .model( dist = dist, r = r, K = K, weight = weight, - par = par, indicmod = indicmod, - indicfix = indicfix, T = T ) + } + + .model( + dist = dist, r = r, K = K, weight = weight, + par = par, indicmod = indicmod, + indicfix = indicfix, T = T + ) } -setMethod( "hasWeight", "model", - function( object, verbose = FALSE) - { - if ( !all( is.na(object@weight ) ) ) { - if ( ncol( object@weight ) == object@K ) { - return( TRUE ) - } else { - if ( verbose ) { - stop( paste("Wrong dimension of ", - "slot 'weight' of ", - "'model' object." , - "Weights must be of ", - "dimension 1 x K.", - sep = "" ) ) - } else { - return( FALSE ) - } - } - } else { - if ( verbose ) { - stop( paste( "Slot 'weight' of 'model' ", - "object is empty.", - sep = "" ) ) - } else { - return( FALSE ) - } - } - } +setMethod( + "hasWeight", "model", + function(object, verbose = FALSE) { + if (!all(is.na(object@weight))) { + if (ncol(object@weight) == object@K) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Wrong dimension of ", + "slot 'weight' of ", + "'model' object.", + "Weights must be of ", + "dimension 1 x K.", + sep = "" + )) + } else { + return(FALSE) + } + } + } else { + if (verbose) { + stop(paste("Slot 'weight' of 'model' ", + "object is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) -setMethod( "hasT", "model", - function( object, verbose = FALSE ) - { - if ( !all( is.na( object@T ) ) ) { - return( TRUE ) - } else { - if ( verbose ) { - stop( paste( "Slot 'T' of 'model' ", - "object is empty.", - sep = "" ) ) - } else { - return( FALSE ) - } - } - } +setMethod( + "hasT", "model", + function(object, verbose = FALSE) { + if (!all(is.na(object@T))) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Slot 'T' of 'model' ", + "object is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) -setMethod( "hasPar", "model", - function( object, verbose = FALSE ) - { - .haspar.Model( object, verbose ) - } +setMethod( + "hasPar", "model", + function(object, verbose = FALSE) { + .haspar.Model(object, verbose) + } ) ### ---------------------------------------------------------------------- ### Simulate method ### @description Simulates values for a specified model in an 'model' ### object. -### @par model an S4 'model' object; with specified parameters +### @par model an S4 'model' object; with specified parameters ### @par N an R 'integer' value specifying the number of ### values to be simulated -### @par varargin an S4 'fdata' object; with specified variable +### @par varargin an S4 'fdata' object; with specified variable ### dimension @r and repetitions @T ### @return an S4 object of class 'fdata' holding the simulated ### @see ?simulate ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------- -setMethod( "simulate", "model", - function( model, N = 100, varargin, seed = 0 ) - { -## TODO: CHeck model for parameters. Check varargin for dimension. Check -## model anf varargin for consistency. - if ( !missing( seed ) ) { - set.seed( seed ) - } ## Implemented maybe finmixOptions with a state variable seed - if ( !hasWeight( model ) ) { - model@weight <- matrix( 1 / model@K, nrow = 1, ncol = model@K ) - } - ## Start simulating the allocations - S <- .simulate.indicators.Model( model, N ) - if ( missing( varargin ) ) { - varargin <- fdata( r = model@r, T = matrix( 1, nrow = N ), - exp = matrix( 1, nrow = N ), S = S ) - } else { - varargin@S <- S - } - if ( hasPar( model, verbose = TRUE ) ) { - .simulate.data.Model( model, N, varargin ) - } - } +setMethod( + "simulate", "model", + function(model, N = 100, varargin, seed = 0) { + ## TODO: CHeck model for parameters. Check varargin for dimension. Check + ## model anf varargin for consistency. + if (!missing(seed)) { + set.seed(seed) + } ## Implemented maybe finmixOptions with a state variable seed + if (!hasWeight(model)) { + model@weight <- matrix(1 / model@K, nrow = 1, ncol = model@K) + } + ## Start simulating the allocations + S <- .simulate.indicators.Model(model, N) + if (missing(varargin)) { + varargin <- fdata( + r = model@r, T = matrix(1, nrow = N), + exp = matrix(1, nrow = N), S = S + ) + } else { + varargin@S <- S + } + if (hasPar(model, verbose = TRUE)) { + .simulate.data.Model(model, N, varargin) + } + } ) ## plot ## -setMethod("plot", "model", - function(x, y, dev = TRUE, ...) - { - dist <- x@dist - if(dist == "normal") { - .plot.Normal.Model(x, dev, ...) - } else if (dist == "normult") { - .plot.Normult.Model(x, dev, ...) - } else if (dist == "exponential") { - .plot.Exponential.Model(x, dev, ...) - } else if (dist == "student") { - .plot.Student.Model(x, dev, ...) - } else if (dist == "studmult") { - .plot.Studmult.Model(x, dev, ...) - } else if (dist %in% c("poisson", "cond.poisson")) { - .plot.Poisson.Model(x, dev, ...) - } else if (dist == "binomial") { - if( abs( max( x@T ) - min( x@T ) ) > 1e-6 ) { - stop("Plotting a binomial distribution with varying +setMethod( + "plot", "model", + function(x, y, dev = TRUE, ...) { + dist <- x@dist + if (dist == "normal") { + .plot.Normal.Model(x, dev, ...) + } else if (dist == "normult") { + .plot.Normult.Model(x, dev, ...) + } else if (dist == "exponential") { + .plot.Exponential.Model(x, dev, ...) + } else if (dist == "student") { + .plot.Student.Model(x, dev, ...) + } else if (dist == "studmult") { + .plot.Studmult.Model(x, dev, ...) + } else if (dist %in% c("poisson", "cond.poisson")) { + .plot.Poisson.Model(x, dev, ...) + } else if (dist == "binomial") { + if (abs(max(x@T) - min(x@T)) > 1e-6) { + stop("Plotting a binomial distribution with varying repetitions in slot 'T' is not possible.") - } - .plot.Binomial.Model(x, dev, ...) - } - } + } + .plot.Binomial.Model(x, dev, ...) + } + } ) -setMethod("plotPointProc", signature(x = "model", - dev = "ANY"), - function(x, dev = TRUE, ...) - { - hasPar(x, verbose = TRUE) - hasWeight(x, verbose = TRUE) - if (x@dist == "poisson") { - .plotpointproc.Poisson(x, dev) - } - } +setMethod( + "plotPointProc", signature( + x = "model", + dev = "ANY" + ), + function(x, dev = TRUE, ...) { + hasPar(x, verbose = TRUE) + hasWeight(x, verbose = TRUE) + if (x@dist == "poisson") { + .plotpointproc.Poisson(x, dev) + } + } ) ## Marginal Mixture ## -setMethod("mixturemar", "model", - function(object, J) - { - .mixturemar.Model(object, J) - } +setMethod( + "mixturemar", "model", + function(object, J) { + .mixturemar.Model(object, J) + } ) - + ## Show ## -setMethod("show", "model", - function(object) - { - cat("Object 'model'\n") - cat(" class :", class(object), "\n") - cat(" dist :", object@dist, "\n") - cat(" r :", object@r, "\n") - cat(" K :", object@K, "\n") - if (hasPar(object)) { - cat(" par : List of", - length(object@par), "\n") - } - if (!object@indicfix) { - cat(" weight :", - paste(dim(object@weight), collapse = "x"), - "\n") - } - cat(" indicmod :", object@indicmod, "\n") - cat(" indicfix :", object@indicfix, "\n") - if (object@dist == "binomial" && !all(is.na(object@T))) { - cat(" T :", - paste(dim(object@T), collapse = "x"), "\n") - } - } +setMethod( + "show", "model", + function(object) { + cat("Object 'model'\n") + cat(" class :", class(object), "\n") + cat(" dist :", object@dist, "\n") + cat(" r :", object@r, "\n") + cat(" K :", object@K, "\n") + if (hasPar(object)) { + cat( + " par : List of", + length(object@par), "\n" + ) + } + if (!object@indicfix) { + cat( + " weight :", + paste(dim(object@weight), collapse = "x"), + "\n" + ) + } + cat(" indicmod :", object@indicmod, "\n") + cat(" indicfix :", object@indicfix, "\n") + if (object@dist == "binomial" && !all(is.na(object@T))) { + cat( + " T :", + paste(dim(object@T), collapse = "x"), "\n" + ) + } + } ) ## Getters ## -setMethod( "getDist", "model", - function( object ) - { - return( object@dist ) - } +setMethod( + "getDist", "model", + function(object) { + return(object@dist) + } ) -setMethod( "getR", "model", - function( object ) - { - return( object@r ) - } +setMethod( + "getR", "model", + function(object) { + return(object@r) + } ) -setMethod( "getK", "model", - function( object ) - { - return( object@K ) - } +setMethod( + "getK", "model", + function(object) { + return(object@K) + } ) -setMethod( "getWeight", "model", - function( object ) - { - return( object@weight ) - } +setMethod( + "getWeight", "model", + function(object) { + return(object@weight) + } ) -setMethod( "getPar", "model", - function( object ) - { - return( object@par ) - } +setMethod( + "getPar", "model", + function(object) { + return(object@par) + } ) -setMethod( "getIndicmod", "model", - function( object ) - { - return( object@indicmod ) - } +setMethod( + "getIndicmod", "model", + function(object) { + return(object@indicmod) + } ) -setMethod( "getIndicfix", "model", - function( object ) - { - return( object@indicfix ) - } +setMethod( + "getIndicfix", "model", + function(object) { + return(object@indicfix) + } ) -setMethod( "getT", "model", - function( object ) - { - return( object@T ) - } +setMethod( + "getT", "model", + function(object) { + return(object@T) + } ) ## Setters ## -setReplaceMethod( "setDist", "model", - function( object, value ) - { - object@dist <- value - .valid.dist.Model( object ) - return( object ) - } +setReplaceMethod( + "setDist", "model", + function(object, value) { + object@dist <- value + .valid.dist.Model(object) + return(object) + } ) -setReplaceMethod( "setR", "model", - function( object, value ) - { - object@r <- as.integer( value ) - validObject( object ) - return( object ) - } +setReplaceMethod( + "setR", "model", + function(object, value) { + object@r <- as.integer(value) + validObject(object) + return(object) + } ) -setReplaceMethod( "setK", "model", - function( object, value ) - { - object@K <- as.integer( value ) - .valid.K.Model( object ) - if ( object@K > 1 ) { - object@weight <- .check.weight.Model( object@K ) - } else { - weight <- matrix() - storage.mode( weight ) <- "numeric" - object@weight <- weight - } - return( object ) - } +setReplaceMethod( + "setK", "model", + function(object, value) { + object@K <- as.integer(value) + .valid.K.Model(object) + if (object@K > 1) { + object@weight <- .check.weight.Model(object@K) + } else { + weight <- matrix() + storage.mode(weight) <- "numeric" + object@weight <- weight + } + return(object) + } ) -setReplaceMethod( "setWeight", "model", - function( object, value ) - { - object@weight <- as.matrix( value ) - object@K <- ncol( object@weight ) - .valid.weight.Model( object ) - return( object ) - } +setReplaceMethod( + "setWeight", "model", + function(object, value) { + object@weight <- as.matrix(value) + object@K <- ncol(object@weight) + .valid.weight.Model(object) + return(object) + } ) -setReplaceMethod( "setPar", "model", - function( object, value ) - { - object@par <- value - .valid.par.Model( object ) - return( object ) - } +setReplaceMethod( + "setPar", "model", + function(object, value) { + object@par <- value + .valid.par.Model(object) + return(object) + } ) -setReplaceMethod( "setIndicmod", "model", - function( object, value ) - { - object@indicmod <- value - return( object ) - } +setReplaceMethod( + "setIndicmod", "model", + function(object, value) { + object@indicmod <- value + return(object) + } ) -setReplaceMethod( "setIndicfix", "model", - function( object, value ) - { - object@indicfix <- value - return( object ) - } +setReplaceMethod( + "setIndicfix", "model", + function(object, value) { + object@indicfix <- value + return(object) + } ) -setReplaceMethod( "setT", "model", - function( object, value ) - { - object@T <- matrix( value ) - .valid.T.Model( object ) - return( object ) - } +setReplaceMethod( + "setT", "model", + function(object, value) { + object@T <- matrix(value) + .valid.T.Model(object) + return(object) + } ) ### Private functions ### These functions are not exported ### Checking. -### Checking is used for in the constructor. +### Checking is used for in the constructor. ### Arguments for the slots are checked for validity and ### if missing are given by default values. Altogether the ### constructor tries to construct a fully specified model @@ -392,111 +409,111 @@ setReplaceMethod( "setT", "model", ### Check K: If weights are provided by the user, the number ### of components is set to the number of columns of the weights. ### If argument 'weight' is missing from the call, the number of -### components is assumed to be one. -".check.K.Model" <- function( weight ) -{ - if ( !all( is.na( weight ) ) ) { - return( NCOL( weight ) ) - } else { - return( as.integer( 1 ) ) - } +### components is assumed to be one. +".check.K.Model" <- function(weight) { + if (!all(is.na(weight))) { + return(NCOL(weight)) + } else { + return(as.integer(1)) + } } -### Check r: The dimension of the model is determined in regard to -### the defined distribution in argument 'dist' (if missing the +### Check r: The dimension of the model is determined in regard to +### the defined distribution in argument 'dist' (if missing the ### default is 'poisson'). For univariate distributions it is set ### to one and for multivariate distribution as a default to two. -".check.r.Model" <- function( dist ) -{ - univ <- .get.univ.Model() - multiv <- .get.multiv.Model() - if ( dist %in% univ ) { - return( as.integer( 1 ) ) - } else if ( dist %in% multiv ) { - return( as.integer( 2 ) ) - } else { - stop( paste( "Unknown distribution in slot ", - "'dist' of 'model' object.", - sep = "" ) ) - } +".check.r.Model" <- function(dist) { + univ <- .get.univ.Model() + multiv <- .get.multiv.Model() + if (dist %in% univ) { + return(as.integer(1)) + } else if (dist %in% multiv) { + return(as.integer(2)) + } else { + stop(paste("Unknown distribution in slot ", + "'dist' of 'model' object.", + sep = "" + )) + } } -### Check weight: If argument 'weight' is missing from the call -### equally balanced weights are given as a default. -".check.weight.Model" <- function( K ) -{ - weight <- matrix( 1 / K, nrow = 1, ncol = K ) - return( weight ) -} +### Check weight: If argument 'weight' is missing from the call +### equally balanced weights are given as a default. +".check.weight.Model" <- function(K) { + weight <- matrix(1 / K, nrow = 1, ncol = K) + return(weight) +} ### Check T: If repetitions are given they are checked in regard ### to validity. In case of non-numeric objects an error is thrown. -### In case of objects of type 'numeric' it is implicitly converted +### In case of objects of type 'numeric' it is implicitly converted ### to type 'integer'. -".check.T.Model" <- function( T ) -{ - if ( !all( is.na( T ) ) ) { - if ( !is.numeric( T ) ) { - stop (paste( "Wrong specification of slot 'T' in ", - "'model' object. Repetitions must be of ", - "type 'integer'.", sep = "" ) ) - } else { - storage.mode( T ) <- "integer" - return( T ) - } +".check.T.Model" <- function(T) { + if (!all(is.na(T))) { + if (!is.numeric(T)) { + stop(paste("Wrong specification of slot 'T' in ", + "'model' object. Repetitions must be of ", + "type 'integer'.", + sep = "" + )) + } else { + storage.mode(T) <- "integer" + return(T) } + } } ### Marginal model -".mixturemar.Model" <- function( obj, J ) -{ - if ( object@dist == "normult" ) { - .mixturemar.normult.Model( obj, J ) - } else if ( object@dist == "studmult" ) { - .mixturemar.studmult.Model(obj, J ) - } else { - stop( "A marginal distribution can only be obtained from - multivariate distributions." ) - } +".mixturemar.Model" <- function(obj, J) { + if (object@dist == "normult") { + .mixturemar.normult.Model(obj, J) + } else if (object@dist == "studmult") { + .mixturemar.studmult.Model(obj, J) + } else { + stop("A marginal distribution can only be obtained from + multivariate distributions.") + } } -".mixturemar.normult.Model" <- function( obj, J ) -{ - dist <- ifelse( length( J ) == 1, "normal", "normult" ) - r <- length( J ) - K <- obj@K - weight <- obj@weight - mu <- obj@par$mu[J, ] - sigma <- obj@par$sigma[J, J, ] - par <- list( mu = mu, sigma = sigma ) - indicmod <- "multinomial" - indicfix <- TRUE - margin.model <- .model( dist = dist, r = r, K = K, - weight = weight, par = par, - indicmod = indicmod, - indicfix = indicfix ) - validObject( margin.model ) - return( margin.model ) +".mixturemar.normult.Model" <- function(obj, J) { + dist <- ifelse(length(J) == 1, "normal", "normult") + r <- length(J) + K <- obj@K + weight <- obj@weight + mu <- obj@par$mu[J, ] + sigma <- obj@par$sigma[J, J, ] + par <- list(mu = mu, sigma = sigma) + indicmod <- "multinomial" + indicfix <- TRUE + margin.model <- .model( + dist = dist, r = r, K = K, + weight = weight, par = par, + indicmod = indicmod, + indicfix = indicfix + ) + validObject(margin.model) + return(margin.model) } -".mixturemar.studmult.Model" <- function( obj, J ) -{ - dist <- ifelse( length( J ) == 1, "student", "studmult" ) - r <- length( J ) - K <- obj@K - weight <- obj@weight - mu <- obj@par$mu[J, ] - sigma <- obj@par$sigma[J, J, ] - df <- obj@par$df - par <- list( mu = mu, sigma = sigma, df = df ) - indicmod <- "multinomial" - indicfix <- TRUE - margin.model <- .model( dist = dist, r = r, K = K, - weight = weight, par = par, - indicmod = indicmod, - indicfix = indicfix ) - validObject( margin.model ) - return( margin.model ) +".mixturemar.studmult.Model" <- function(obj, J) { + dist <- ifelse(length(J) == 1, "student", "studmult") + r <- length(J) + K <- obj@K + weight <- obj@weight + mu <- obj@par$mu[J, ] + sigma <- obj@par$sigma[J, J, ] + df <- obj@par$df + par <- list(mu = mu, sigma = sigma, df = df) + indicmod <- "multinomial" + indicfix <- TRUE + margin.model <- .model( + dist = dist, r = r, K = K, + weight = weight, par = par, + indicmod = indicmod, + indicfix = indicfix + ) + validObject(margin.model) + return(margin.model) } ### ============================================================== @@ -506,7 +523,7 @@ setReplaceMethod( "setT", "model", ### -------------------------------------------------------------- ### .simulate.indicators.Model ### @description Simulates the indicators. -### @par obj an S4 object of class 'model' +### @par obj an S4 object of class 'model' ### @par N an R 'integer' object ### @return an R 'matrix' object with N simulated indi- ### cators. @@ -517,25 +534,26 @@ setReplaceMethod( "setT", "model", ### -------------------------------------------------------------- ### TODO: Implement C++ function. -".simulate.indicators.Model" <- function( obj, N ) -{ - K <- obj@K - if ( K == 1 ) { - S <- matrix(as.integer( 1 ), nrow = N, ncol = K ) - } else { - ## if (model@indicmod = "") -> "Multinomial" - ## if Markov else - if ( obj@indicmod == "multinomial" ) { - rnd <- runif( N ) - rnd <- matrix( rnd, nrow = N, ncol = K ) - weightm <- matrix( obj@weight, nrow = N, ncol = K, - byrow = TRUE ) - S <- apply( ( t( apply( weightm, 1, cumsum ) ) < rnd ), 1, sum ) + 1 - S <- matrix( S, nrow = N ) - storage.mode( S ) <- "integer" - } +".simulate.indicators.Model" <- function(obj, N) { + K <- obj@K + if (K == 1) { + S <- matrix(as.integer(1), nrow = N, ncol = K) + } else { + ## if (model@indicmod = "") -> "Multinomial" + ## if Markov else + if (obj@indicmod == "multinomial") { + rnd <- runif(N) + rnd <- matrix(rnd, nrow = N, ncol = K) + weightm <- matrix(obj@weight, + nrow = N, ncol = K, + byrow = TRUE + ) + S <- apply((t(apply(weightm, 1, cumsum)) < rnd), 1, sum) + 1 + S <- matrix(S, nrow = N) + storage.mode(S) <- "integer" } - return( S ) + } + return(S) } ### -------------------------------------------------------------------- @@ -548,22 +566,21 @@ setReplaceMethod( "setT", "model", ### @see ?fdata, ?simulate ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- -".simulate.data.Model" <- function( obj, N, fdata.obj ) -{ - dist <- obj@dist - if ( dist == "poisson" || dist == "cond.poisson" ) { - .simulate.data.poisson.Model(obj, N, fdata.obj) - } else if ( dist == "binomial" ) { - .simulate.data.binomial.Model(obj, N, fdata.obj) - } else if ( dist == "exponential" ) { - .simulate.data.exponential.Model( obj, N, fdata.obj ) - } else if ( dist == "normal" ) { - .simulate.data.normal.Model( obj, N, fdata.obj ) - } else if ( dist == "student" ) { - .simulate.data.student.Model ( obj, N, fdata.obj ) - } else if ( dist == "normult" ) { - .simulate.data.normult.Model( obj, N, fdata.obj ) - } +".simulate.data.Model" <- function(obj, N, fdata.obj) { + dist <- obj@dist + if (dist == "poisson" || dist == "cond.poisson") { + .simulate.data.poisson.Model(obj, N, fdata.obj) + } else if (dist == "binomial") { + .simulate.data.binomial.Model(obj, N, fdata.obj) + } else if (dist == "exponential") { + .simulate.data.exponential.Model(obj, N, fdata.obj) + } else if (dist == "normal") { + .simulate.data.normal.Model(obj, N, fdata.obj) + } else if (dist == "student") { + .simulate.data.student.Model(obj, N, fdata.obj) + } else if (dist == "normult") { + .simulate.data.normult.Model(obj, N, fdata.obj) + } } ### --------------------------------------------------------------------- @@ -577,13 +594,11 @@ setReplaceMethod( "setT", "model", ### @see ?simulate, model:::.simulate.data.Model, ?rpois ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- -".simulate.data.poisson.Model" <- function( obj, N, fdata.obj ) -{ - fdata.obj@type <- "discrete" - fdata.obj@sim <- TRUE - fdata.obj@y <- matrix( rpois( N, fdata.obj@exp * obj@par$lambda[fdata.obj@S] ) ) - return( fdata.obj ) - +".simulate.data.poisson.Model" <- function(obj, N, fdata.obj) { + fdata.obj@type <- "discrete" + fdata.obj@sim <- TRUE + fdata.obj@y <- matrix(rpois(N, fdata.obj@exp * obj@par$lambda[fdata.obj@S])) + return(fdata.obj) } ### --------------------------------------------------------------------- @@ -597,15 +612,14 @@ setReplaceMethod( "setT", "model", ### @see ?simulate, model:::.simulate.data.Model, ?rbinom ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- -".simulate.data.binomial.Model" <- function( obj, N, fdata.obj ) -{ - if ( !hasT(fdata.obj ) ) { - fdata.obj@T <- as.matrix( 1 ) - } - fdata.obj@type <- "discrete" - fdata.obj@sim <- TRUE - fdata.obj@y <- matrix( rbinom( N, fdata.obj@T, obj@par$p[fdata.obj@S] ) ) - return( fdata.obj ) +".simulate.data.binomial.Model" <- function(obj, N, fdata.obj) { + if (!hasT(fdata.obj)) { + fdata.obj@T <- as.matrix(1) + } + fdata.obj@type <- "discrete" + fdata.obj@sim <- TRUE + fdata.obj@y <- matrix(rbinom(N, fdata.obj@T, obj@par$p[fdata.obj@S])) + return(fdata.obj) } ### --------------------------------------------------------------------- @@ -619,12 +633,11 @@ setReplaceMethod( "setT", "model", ### @see ?simulate, model:::.simulate.data.Model, ?rexp ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- -".simulate.data.exponential.Model" <- function( obj, N, fdata.obj ) -{ - fdata.obj@type <- "continuous" - fdata.obj@sim <- TRUE - fdata.obj@y <- matrix( rexp( N, obj@par$lambda[fdata.obj@S] ) ) - return( fdata.obj ) +".simulate.data.exponential.Model" <- function(obj, N, fdata.obj) { + fdata.obj@type <- "continuous" + fdata.obj@sim <- TRUE + fdata.obj@y <- matrix(rexp(N, obj@par$lambda[fdata.obj@S])) + return(fdata.obj) } ### --------------------------------------------------------------------- @@ -638,423 +651,487 @@ setReplaceMethod( "setT", "model", ### @see ?simulate, model:::.simulate.data.Model, ?rnorm ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- -".simulate.data.normal.Model" <- function( obj, N, fdata.obj ) -{ - fdata.obj@type <- "continuous" - fdata.obj@sim <- TRUE - fdata.obj@y <- matrix( rnorm( N, obj@par$mu[fdata.obj@S], - obj@par$sigma[fdata.obj@S] ) ) - return( fdata.obj ) +".simulate.data.normal.Model" <- function(obj, N, fdata.obj) { + fdata.obj@type <- "continuous" + fdata.obj@sim <- TRUE + fdata.obj@y <- matrix(rnorm( + N, obj@par$mu[fdata.obj@S], + obj@par$sigma[fdata.obj@S] + )) + return(fdata.obj) } -".simulate.data.student.Model" <- function( obj, N, fdata.obj ) -{ - fdata.obj@type <- "continuous" - fdata.obj@sim <- TRUE - omega <- rgamma( N, obj@par$df[fdata.obj@S] / 2, - rate = 2 / obj@par$df[fdata.obj@S] ) - fdata.obj@y <- as.matrix( obj@par$mu[fdata.obj@S] + - sqrt( obj@par$sigma[fdata.obj@S] / omega ) * - rnorm( N, 0.0, 1.0 ) ) - return( fdata.obj ) +".simulate.data.student.Model" <- function(obj, N, fdata.obj) { + fdata.obj@type <- "continuous" + fdata.obj@sim <- TRUE + omega <- rgamma(N, obj@par$df[fdata.obj@S] / 2, + rate = 2 / obj@par$df[fdata.obj@S] + ) + fdata.obj@y <- as.matrix(obj@par$mu[fdata.obj@S] + + sqrt(obj@par$sigma[fdata.obj@S] / omega) * + rnorm(N, 0.0, 1.0)) + return(fdata.obj) } -".simulate.data.normult.Model" <- function( obj, N, fdata.obj ) -{ - fdata.obj@type <- "continuous" - fdata.obj@sim <- TRUE - fdata.obj@y <- matrix( numeric(), nrow = N, ncol = obj@r ) - fdata.obj@r <- obj@r - for ( i in 1:N ) { - fdata.obj@y[i, ] <- rmvnorm( 1, mean = obj@par$mu[, fdata.obj@S[i]], - sigma = obj@par$sigma[,, fdata.obj@S[i]], - method = "chol" ) - } - return( fdata.obj ) +".simulate.data.normult.Model" <- function(obj, N, fdata.obj) { + fdata.obj@type <- "continuous" + fdata.obj@sim <- TRUE + fdata.obj@y <- matrix(numeric(), nrow = N, ncol = obj@r) + fdata.obj@r <- obj@r + for (i in 1:N) { + fdata.obj@y[i, ] <- rmvnorm(1, + mean = obj@par$mu[, fdata.obj@S[i]], + sigma = obj@par$sigma[, , fdata.obj@S[i]], + method = "chol" + ) + } + return(fdata.obj) } ### Plotting ### Plot Poisson models: Poisson models are discrete -### models and a barplot is used. -### The range for the x-axis is determined via the +### models and a barplot is used. +### The range for the x-axis is determined via the ### quantiles of the largest and smallest Poisson model -### in the mixture. -".plot.Poisson.Model" <- function(model.obj, dev, ...) -{ - - if (.check.grDevice() && dev) { - dev.new(title = "Model plot") - } - lambda <- model.obj@par$lambda - weight <- model.obj@weight - xlim.up <- qpois(.9999, lambda = max(lambda)) - xlim.low <- qpois(.0001, lambda = min(lambda)) - x.grid <- seq(xlim.low, xlim.up, by = 1) - y.grid <- sapply(x.grid, dpois, lambda = lambda) - y.grid <- weight %*% y.grid - main.title <- paste("Poisson Mixture K = ", - model.obj@K, sep="") - label.grid <- axisTicks(c(xlim.low, xlim.up), log = FALSE, - nint = 10) - bp <- barplot(y.grid, main = main.title, axes = F, - col = "gray65", border = "gray65", ...) - axis(side = 2, cex = .7, cex.axis = .7) - axis(side = 1, tick = FALSE, at = bp[which(x.grid %in% label.grid)], - labels = label.grid, cex.axis = .7) - mtext(side = 1, "x", cex = .7, cex.axis = .7, line = 3) - mtext(side = 2, "P(x)", cex = .7, cex.axis = .7, line = 3) +### in the mixture. +".plot.Poisson.Model" <- function(model.obj, dev, ...) { + if (.check.grDevice() && dev) { + dev.new(title = "Model plot") + } + lambda <- model.obj@par$lambda + weight <- model.obj@weight + xlim.up <- qpois(.9999, lambda = max(lambda)) + xlim.low <- qpois(.0001, lambda = min(lambda)) + x.grid <- seq(xlim.low, xlim.up, by = 1) + y.grid <- sapply(x.grid, dpois, lambda = lambda) + y.grid <- weight %*% y.grid + main.title <- paste("Poisson Mixture K = ", + model.obj@K, + sep = "" + ) + label.grid <- axisTicks(c(xlim.low, xlim.up), + log = FALSE, + nint = 10 + ) + bp <- barplot(y.grid, + main = main.title, axes = F, + col = "gray65", border = "gray65", ... + ) + axis(side = 2, cex = .7, cex.axis = .7) + axis( + side = 1, tick = FALSE, at = bp[which(x.grid %in% label.grid)], + labels = label.grid, cex.axis = .7 + ) + mtext(side = 1, "x", cex = .7, cex.axis = .7, line = 3) + mtext(side = 2, "P(x)", cex = .7, cex.axis = .7, line = 3) } -### Plot Binomial models: Binomial models are discrete -### models and line model is used. -### The grid for the x-axis is determined by taking -### the -".plot.Binomial.Model" <- function(model.obj, dev, ...) -{ - if (.check.grDevice() && dev) { - dev.new(title = "Model plot") - } - n <- model.obj@T[1] - p <- model.obj@par$p - weight <- model.obj@weight - xlim <- max(n, na.rm = TRUE) - x.grid <- seq(0, xlim, by = 1) - y.grid <- sapply(x.grid, dbinom, size = n, p = p) - y.grid <- weight %*% y.grid - main.title <- paste("Binomial Mixture K = ", - model.obj@K, sep = "") - plot(x.grid, y.grid, main = main.title, type = "h", - xlab = "x", ylab = "P(x)", ...) - points(x.grid, y.grid, pch = 20) +### Plot Binomial models: Binomial models are discrete +### models and line model is used. +### The grid for the x-axis is determined by taking +### the +".plot.Binomial.Model" <- function(model.obj, dev, ...) { + if (.check.grDevice() && dev) { + dev.new(title = "Model plot") + } + n <- model.obj@T[1] + p <- model.obj@par$p + weight <- model.obj@weight + xlim <- max(n, na.rm = TRUE) + x.grid <- seq(0, xlim, by = 1) + y.grid <- sapply(x.grid, dbinom, size = n, p = p) + y.grid <- weight %*% y.grid + main.title <- paste("Binomial Mixture K = ", + model.obj@K, + sep = "" + ) + plot(x.grid, y.grid, + main = main.title, type = "h", + xlab = "x", ylab = "P(x)", ... + ) + points(x.grid, y.grid, pch = 20) } -".plot.Exponential.Model" <- function(model.obj, dev, ...) -{ - if (.check.grDevice() && dev) { - dev.new(title = "Model plot") - } - lambda <- model.obj@par$lambda - weight <- model.obj@weight - min.lambda <- min(lambda, na.rm = TRUE) - xlim <- qexp(.9999, rate = min.lambda) - x.grid <- seq(0, ceiling(xlim), length = - as.integer(100 * lambda^(-2))) - y.grid <- sapply(x.grid, dexp, rate = lambda) - y.grid <- weight %*% y.grid - main.title <- paste("Exponential Mixture K = ", - model.obj@K, sep = "") - plot(x.grid, y.grid, main = main.title, type = "l", - xlab = "x", ylab = "P(x)", ...) +".plot.Exponential.Model" <- function(model.obj, dev, ...) { + if (.check.grDevice() && dev) { + dev.new(title = "Model plot") + } + lambda <- model.obj@par$lambda + weight <- model.obj@weight + min.lambda <- min(lambda, na.rm = TRUE) + xlim <- qexp(.9999, rate = min.lambda) + x.grid <- seq(0, ceiling(xlim), + length = + as.integer(100 * lambda^(-2)) + ) + y.grid <- sapply(x.grid, dexp, rate = lambda) + y.grid <- weight %*% y.grid + main.title <- paste("Exponential Mixture K = ", + model.obj@K, + sep = "" + ) + plot(x.grid, y.grid, + main = main.title, type = "l", + xlab = "x", ylab = "P(x)", ... + ) } -".plot.Student.Model" <- function(model.obj, dev, ...) -{ - if (.check.grDevice() && dev) { - dev.new(title = "Model plot") - } - mu <- model.obj@par$mu - sigma <- model.obj@par$sigma - df <- model.obj@par$df - weight <- model.obj@weight - max.mu <- max(mu, na.rm = TRUE) - max.sigma <- max(sigma, na.rm = TRUE) - min.df <- min(df, na.rm = TRUE) - xlim <- max.mu + max.sigma * qt(.9999, min.df) - x.grid <- seq(-xlim, xlim, length = 1000) + max.mu - y.grid <- sapply(x.grid, "-", mu) - y.grid <- apply(y.grid, 2, "/", sigma) - y.grid <- apply(y.grid, 2, dt, df = df) - y.grid <- apply(y.grid, 2, "/", sqrt(sigma)) - y.grid <- t(weight %*% y.grid) - main.title <- paste("Student-t Mixture K = ", - model.obj@K, sep="") - plot(x.grid, y.grid, main = main.title, type = "l", - xlab = "x", ylab = "P(x)", ...) +".plot.Student.Model" <- function(model.obj, dev, ...) { + if (.check.grDevice() && dev) { + dev.new(title = "Model plot") + } + mu <- model.obj@par$mu + sigma <- model.obj@par$sigma + df <- model.obj@par$df + weight <- model.obj@weight + max.mu <- max(mu, na.rm = TRUE) + max.sigma <- max(sigma, na.rm = TRUE) + min.df <- min(df, na.rm = TRUE) + xlim <- max.mu + max.sigma * qt(.9999, min.df) + x.grid <- seq(-xlim, xlim, length = 1000) + max.mu + y.grid <- sapply(x.grid, "-", mu) + y.grid <- apply(y.grid, 2, "/", sigma) + y.grid <- apply(y.grid, 2, dt, df = df) + y.grid <- apply(y.grid, 2, "/", sqrt(sigma)) + y.grid <- t(weight %*% y.grid) + main.title <- paste("Student-t Mixture K = ", + model.obj@K, + sep = "" + ) + plot(x.grid, y.grid, + main = main.title, type = "l", + xlab = "x", ylab = "P(x)", ... + ) } -".plot.Normal.Model" <- function(model.obj, dev, ...) -{ - if (.check.grDevice() && dev) { - dev.new(title = "Model Plot") - } - mu <- model.obj@par$mu - sigma <- model.obj@par$sigma - weight <- model.obj@weight - max.mu <- max(mu, na.rm = TRUE) - max.sigma <- max(mu, na.rm = TRUE) - xlim <- qnorm(.9999, mean = max.mu, - sd = max.sigma) - x.grid <- seq(-xlim, xlim, length = 1000) + max.mu - y.grid <- sapply(x.grid, dnorm, mean = mu, - sd = sigma) - y.grid <- weight %*% y.grid - main.title <- paste("Normal Mixture K = ", - model.obj@K, sep = "") - plot(x.grid, y.grid, main = main.title, type = "l", - xlab = "x", ylab = "P(x)", ...) +".plot.Normal.Model" <- function(model.obj, dev, ...) { + if (.check.grDevice() && dev) { + dev.new(title = "Model Plot") + } + mu <- model.obj@par$mu + sigma <- model.obj@par$sigma + weight <- model.obj@weight + max.mu <- max(mu, na.rm = TRUE) + max.sigma <- max(mu, na.rm = TRUE) + xlim <- qnorm(.9999, + mean = max.mu, + sd = max.sigma + ) + x.grid <- seq(-xlim, xlim, length = 1000) + max.mu + y.grid <- sapply(x.grid, dnorm, + mean = mu, + sd = sigma + ) + y.grid <- weight %*% y.grid + main.title <- paste("Normal Mixture K = ", + model.obj@K, + sep = "" + ) + plot(x.grid, y.grid, + main = main.title, type = "l", + xlab = "x", ylab = "P(x)", ... + ) } -".plot.Normult.Model" <- function(model.obj, dev, ...) -{ - K <- model.obj@K - r <- model.obj@r - if (r == 2) { - if (.check.gr.Device() && dev) { - dev.new(title = "Model: Perspective plot") - } - xyz.grid <- .generate.Grid.Normal(model.obj) - main.title = paste("Multivariate Normal Mixture K = ", - K, sep = "") - persp(xyz.grid$x, xyz.grid$y, xyz.grid$z, col = "gray65", - border = "gray47", theta = 55, phi = 30, expand = 0.5, - lphi = 180, ltheta = 90, r = 40, d = 0.1, - ticktype = "detailed", zlab = "P(x)", xlab = "r = 1", - ylab = "r = 2", cex = 0.7, cex.lab = 0.7, cex.axis = 0.7) - } else if (r > 2 && r < 6) { - if (.check.grDevice() && dev) { - dev.new(title = "Model: Contour plots") - } - if (r == 3) { - par(mfrow = c(1, r), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - } else if (r == 4) { - par(mfrow = c(2, 3), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - } else { - par(mfrow = c(2, 5), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - } - for (i in seq(1, r - 1)) { - for (j in seq(1, r)) { - marmodel <- mixturemar(model.obj, J = c(i, j)) - xyz.grid <- .generate.Grid.Normal(marmodel) - contour(xyz.grid$x, xyz.grid$y, xyz.grid$z, - col = "gray47", cex = 0.7, cex.axis = 0.7, - xlab = paste("r = ", i, sep = ""), - ylab = paste("r = ", j, sep = "")) - } - } +".plot.Normult.Model" <- function(model.obj, dev, ...) { + K <- model.obj@K + r <- model.obj@r + if (r == 2) { + if (.check.gr.Device() && dev) { + dev.new(title = "Model: Perspective plot") + } + xyz.grid <- .generate.Grid.Normal(model.obj) + main.title <- paste("Multivariate Normal Mixture K = ", + K, + sep = "" + ) + persp(xyz.grid$x, xyz.grid$y, xyz.grid$z, + col = "gray65", + border = "gray47", theta = 55, phi = 30, expand = 0.5, + lphi = 180, ltheta = 90, r = 40, d = 0.1, + ticktype = "detailed", zlab = "P(x)", xlab = "r = 1", + ylab = "r = 2", cex = 0.7, cex.lab = 0.7, cex.axis = 0.7 + ) + } else if (r > 2 && r < 6) { + if (.check.grDevice() && dev) { + dev.new(title = "Model: Contour plots") + } + if (r == 3) { + par( + mfrow = c(1, r), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + } else if (r == 4) { + par( + mfrow = c(2, 3), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) } else { - stop("Method 'plot' for 'model' objects is not implemented for - model dimensions of r > 5.") + par( + mfrow = c(2, 5), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + } + for (i in seq(1, r - 1)) { + for (j in seq(1, r)) { + marmodel <- mixturemar(model.obj, J = c(i, j)) + xyz.grid <- .generate.Grid.Normal(marmodel) + contour(xyz.grid$x, xyz.grid$y, xyz.grid$z, + col = "gray47", cex = 0.7, cex.axis = 0.7, + xlab = paste("r = ", i, sep = ""), + ylab = paste("r = ", j, sep = "") + ) + } } + } else { + stop("Method 'plot' for 'model' objects is not implemented for + model dimensions of r > 5.") + } } -".plot.Normult.Model" <- function(model.obj, dev, ...) -{ - K <- model.obj@K - r <- model.obj@r - if (r == 2) { - if (.check.gr.Device() && dev) { - dev.new(title = "Model: Perspective plot") - } - xyz.grid <- .generate.Grid.Student(model.obj) - main.title = paste("Multivariate Student-t Mixture K = ", - K, sep = "") - persp(xyz.grid$x, xyz.grid$y, xyz.grid$z, col = "gray65", - border = "gray47", theta = 55, phi = 30, expand = 0.5, - lphi = 180, ltheta = 90, r = 40, d = 0.1, - ticktype = "detailed", zlab = "P(x)", xlab = "r = 1", - ylab = "r = 2", cex = 0.7, cex.lab = 0.7, cex.axis = 0.7) - } else if (r > 2 && r < 6) { - if (.check.grDevice() && dev) { - dev.new(title = "Model: Contour plots") - } - if (r == 3) { - par(mfrow = c(1, r), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - } else if (r == 4) { - par(mfrow = c(2, 3), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - } else { - par(mfrow = c(2, 5), mar = c(2, 2, 2, 2), - oma = c(4, 5, 1, 5)) - } - for (i in seq(1, r - 1)) { - for (j in seq(1, r)) { - marmodel <- mixturemar(model.obj, J = c(i, j)) - xyz.grid <- .generate.Grid.Student(marmodel) - contour(xyz.grid$x, xyz.grid$y, xyz.grid$z, - col = "gray47", cex = 0.7, cex.axis = 0.7, - xlab = paste("r = ", i, sep = ""), - ylab = paste("r = ", j, sep = "")) - } - } +".plot.Normult.Model" <- function(model.obj, dev, ...) { + K <- model.obj@K + r <- model.obj@r + if (r == 2) { + if (.check.gr.Device() && dev) { + dev.new(title = "Model: Perspective plot") + } + xyz.grid <- .generate.Grid.Student(model.obj) + main.title <- paste("Multivariate Student-t Mixture K = ", + K, + sep = "" + ) + persp(xyz.grid$x, xyz.grid$y, xyz.grid$z, + col = "gray65", + border = "gray47", theta = 55, phi = 30, expand = 0.5, + lphi = 180, ltheta = 90, r = 40, d = 0.1, + ticktype = "detailed", zlab = "P(x)", xlab = "r = 1", + ylab = "r = 2", cex = 0.7, cex.lab = 0.7, cex.axis = 0.7 + ) + } else if (r > 2 && r < 6) { + if (.check.grDevice() && dev) { + dev.new(title = "Model: Contour plots") + } + if (r == 3) { + par( + mfrow = c(1, r), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) + } else if (r == 4) { + par( + mfrow = c(2, 3), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) } else { - stop("Method 'plot' for 'model' objects is not implemented for - model dimensions of r > 5.") + par( + mfrow = c(2, 5), mar = c(2, 2, 2, 2), + oma = c(4, 5, 1, 5) + ) } + for (i in seq(1, r - 1)) { + for (j in seq(1, r)) { + marmodel <- mixturemar(model.obj, J = c(i, j)) + xyz.grid <- .generate.Grid.Student(marmodel) + contour(xyz.grid$x, xyz.grid$y, xyz.grid$z, + col = "gray47", cex = 0.7, cex.axis = 0.7, + xlab = paste("r = ", i, sep = ""), + ylab = paste("r = ", j, sep = "") + ) + } + } + } else { + stop("Method 'plot' for 'model' objects is not implemented for + model dimensions of r > 5.") + } } -".generate.Grid.Normal" <- function(model.obj) -{ - mu <- model.obj@par$mu - sigma <- model.obj@par$sigma - weight <- model.obj@weight - func <- function(s, t) - { - value <- 0 - for (k in seq(1, K)) { - value <- value + weight[k] * - dmvnorm(cbind(s, t), mean = mu[, k], - sigma = sigma[,, k]) - } - } - mu.norm <- apply(mu, 2, function(x) sqrt(sum(x^2))) - max.mu.index <- tail(sort(mu.norm, index = TRUE)$ix, 1) - max.mu <- mu[, max.mu.index] - sigma.det <- apply(sigma, 3, det) - max.sigma.index <- tail(sort(sigma.det, index = TRUE)$ix, 1) - max.sigma <- sigma[,, max.sigma.index] - xylim <- qmvnorm(.9999, mean = max.mu, - sigma = max.sigma)$quantile - x.grid <- seq(-xylim, xylim, length = 100) - xy.grid <- cbind(x.grid, x.grid) - xy.grid <- t(apply(xy.grid, 1, "+", max.mu)) - z.grid <- outer(xy.grid[, 1], xy.grid[, 2], func) - grid.list <- list(x = xy.grid[, 1], y = y.grid[, 2], - z = z.grid) - return(grid.list) +".generate.Grid.Normal" <- function(model.obj) { + mu <- model.obj@par$mu + sigma <- model.obj@par$sigma + weight <- model.obj@weight + func <- function(s, t) { + value <- 0 + for (k in seq(1, K)) { + value <- value + weight[k] * + dmvnorm(cbind(s, t), + mean = mu[, k], + sigma = sigma[, , k] + ) + } + } + mu.norm <- apply(mu, 2, function(x) sqrt(sum(x^2))) + max.mu.index <- tail(sort(mu.norm, index = TRUE)$ix, 1) + max.mu <- mu[, max.mu.index] + sigma.det <- apply(sigma, 3, det) + max.sigma.index <- tail(sort(sigma.det, index = TRUE)$ix, 1) + max.sigma <- sigma[, , max.sigma.index] + xylim <- qmvnorm(.9999, + mean = max.mu, + sigma = max.sigma + )$quantile + x.grid <- seq(-xylim, xylim, length = 100) + xy.grid <- cbind(x.grid, x.grid) + xy.grid <- t(apply(xy.grid, 1, "+", max.mu)) + z.grid <- outer(xy.grid[, 1], xy.grid[, 2], func) + grid.list <- list( + x = xy.grid[, 1], y = y.grid[, 2], + z = z.grid + ) + return(grid.list) } -".generate.Grid.Student" <- function(model.obj) -{ - mu <- model.obj@par$mu - sigma <- model.obj@par$sigma - df <- model.obj@par$df - weight <- model.obj@weight - func <- function(s, t) - { - value <- 0 - for (k in seq(1, K)) { - value <- value + weight[k] * - dmvt(cbind(s, t), delta = mu[, k], - sigma = sigma[,, k], df = df[k]) - } - } - mu.norm <- apply(mu, 2, function(x) sqrt(sum(x^2))) - max.mu.index <- tail(sort(mu.norm, index = TRUE)$ix, 1) - max.mu <- mu[, max.mu.index] - sigma.det <- apply(sigma, 3, det) - max.sigma.index <- tail(sort(sigma.det, index = TRUE)$ix, 1) - max.sigma <- sigma[,, max.sigma.index] - min.df <- min(df, na.rm = TRUE) - xylim <- qmvt(.9999, delta = max.mu, - sigma = max.sigma, df = min.df)$quantile - x.grid <- seq(-xylim, xylim, length = 100) - xy.grid <- cbind(x.grid, x.grid) - xy.grid <- t(apply(xy.grid, 1, "+", max.mu)) - z.grid <- outer(xy.grid[, 1], xy.grid[, 2], func) - grid.list <- list(x = xy.grid[, 1], y = y.grid[, 2], - z = z.grid) - return(grid.list) +".generate.Grid.Student" <- function(model.obj) { + mu <- model.obj@par$mu + sigma <- model.obj@par$sigma + df <- model.obj@par$df + weight <- model.obj@weight + func <- function(s, t) { + value <- 0 + for (k in seq(1, K)) { + value <- value + weight[k] * + dmvt(cbind(s, t), + delta = mu[, k], + sigma = sigma[, , k], df = df[k] + ) + } + } + mu.norm <- apply(mu, 2, function(x) sqrt(sum(x^2))) + max.mu.index <- tail(sort(mu.norm, index = TRUE)$ix, 1) + max.mu <- mu[, max.mu.index] + sigma.det <- apply(sigma, 3, det) + max.sigma.index <- tail(sort(sigma.det, index = TRUE)$ix, 1) + max.sigma <- sigma[, , max.sigma.index] + min.df <- min(df, na.rm = TRUE) + xylim <- qmvt(.9999, + delta = max.mu, + sigma = max.sigma, df = min.df + )$quantile + x.grid <- seq(-xylim, xylim, length = 100) + xy.grid <- cbind(x.grid, x.grid) + xy.grid <- t(apply(xy.grid, 1, "+", max.mu)) + z.grid <- outer(xy.grid[, 1], xy.grid[, 2], func) + grid.list <- list( + x = xy.grid[, 1], y = y.grid[, 2], + z = z.grid + ) + return(grid.list) } ### plotPointProc -".plotpointproc.Poisson" <- function(x, dev) -{ - K <- x@K - if (.check.grDevice() && dev) { - dev.new(title = "Point Process Representation") - } - if (min(x@par$lambda) < 1) { - lambda <- log(x@par$lambda) - } else { - lambda <- x@par$lambda - } - y.grid <- rep(0, K) - size.grid <- as.vector(x@weight * 4) - col.grid <- gray.colors(K, start = 0.2, - end = 0.5) - plot(lambda, y.grid, pch = 20, col = col.grid, - cex = size.grid, cex.lab = .7, cex.axis = .7, - main = "", ylab = "", xlab = "") - mtext(side = 1, bquote(lambda), cex = .7, cex.lab = .7, - line = 3) - legend.names <- list("", K) - for (k in seq(1, K)) { - legend.names[[k]] <- bquote(lambda[.(k)]) - } - legend("topright", legend = do.call(expression, legend.names), - col = col.grid, fill = col.grid) +".plotpointproc.Poisson" <- function(x, dev) { + K <- x@K + if (.check.grDevice() && dev) { + dev.new(title = "Point Process Representation") + } + if (min(x@par$lambda) < 1) { + lambda <- log(x@par$lambda) + } else { + lambda <- x@par$lambda + } + y.grid <- rep(0, K) + size.grid <- as.vector(x@weight * 4) + col.grid <- gray.colors(K, + start = 0.2, + end = 0.5 + ) + plot(lambda, y.grid, + pch = 20, col = col.grid, + cex = size.grid, cex.lab = .7, cex.axis = .7, + main = "", ylab = "", xlab = "" + ) + mtext( + side = 1, bquote(lambda), cex = .7, cex.lab = .7, + line = 3 + ) + legend.names <- list("", K) + for (k in seq(1, K)) { + legend.names[[k]] <- bquote(lambda[.(k)]) + } + legend("topright", + legend = do.call(expression, legend.names), + col = col.grid, fill = col.grid + ) } ### Has ### Checks if a 'model' object has specified parameters. -".haspar.Model" <- function( obj, verbose ) -{ - if ( length( obj@par ) > 0 ) { - dist <- obj@dist - if ( dist %in% c( "poisson", "cond.poisson" ) ) { - .haspar.poisson.Model( obj, verbose ) - } else if ( dist == "binomial" ) { - .haspar.binomial.Model(obj, verbose) - } else if ( dist == "exponential" ) { - .haspar.exponential.Model( obj, verbose ) - } else if ( dist == "normal" ) { - .haspar.normal.Model( obj, verbose ) - } else if ( dist == "student" ) { - .haspar.student.Model( obj, verbose ) - } else if ( dist == "normult" ) { - .haspar.normult.Model( obj, verbose ) - } else if ( dist == "studmult" ) { - .haspar.studmult.Model( obj, verbose ) - } +".haspar.Model" <- function(obj, verbose) { + if (length(obj@par) > 0) { + dist <- obj@dist + if (dist %in% c("poisson", "cond.poisson")) { + .haspar.poisson.Model(obj, verbose) + } else if (dist == "binomial") { + .haspar.binomial.Model(obj, verbose) + } else if (dist == "exponential") { + .haspar.exponential.Model(obj, verbose) + } else if (dist == "normal") { + .haspar.normal.Model(obj, verbose) + } else if (dist == "student") { + .haspar.student.Model(obj, verbose) + } else if (dist == "normult") { + .haspar.normult.Model(obj, verbose) + } else if (dist == "studmult") { + .haspar.studmult.Model(obj, verbose) + } + } else { + if (verbose) { + stop(paste("Slot 'par' of 'model' object is ", + "empty.", + sep = "" + )) } else { - if ( verbose ) { - stop( paste( "Slot 'par' of 'model' object is ", - "empty.", sep = "" ) ) - } else { - return( FALSE ) - } + return(FALSE) } + } } ### ----------------------------------------------------------------- ### .haspar.poisson.Mode -### @description Checks if a Poisson model has fully specified -### parameters. If verbose is set to TRUE an error +### @description Checks if a Poisson model has fully specified +### parameters. If verbose is set to TRUE an error ### is thrown. ### @par obj an S4 object of class 'model' ### @par verbose an object of class 'logical' -### @return either TRUE or FALSE if parameters are fully -### specified or not. In case verbose == FALSE an +### @return either TRUE or FALSE if parameters are fully +### specified or not. In case verbose == FALSE an ### error is thrown. ### ----------------------------------------------------------------- -".haspar.poisson.Model" <- function(obj, verbose) -{ - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty.", - call. = FALSE ) - } else { - return( FALSE ) - } +".haspar.poisson.Model" <- function(obj, verbose) { + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty.", + call. = FALSE + ) } else { - if ( !"lambda" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Binomial models ", - "need a parameter vector named 'lambda'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + return(FALSE) + } + } else { + if (!"lambda" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Binomial models ", + "need a parameter vector named 'lambda'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (length(obj@par$lambda) != obj@K) { + if (verbose) { + stop(paste("Wrong specification of slot @par of ", + "'model' object. Slot @K does not match ", + "dimension of parameters in @par$lambda.", + sep = "" + ), call. = FALSE) } else { - if ( length( obj@par$lambda ) != obj@K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par of ", - "'model' object. Slot @K does not match ", - "dimension of parameters in @par$lambda.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } + return(FALSE) } + } else { + return(TRUE) + } } + } } ### ------------------------------------------------------------------- ### .haspar.binomial.Model @@ -1063,44 +1140,49 @@ setReplaceMethod( "setT", "model", ### thrown. ### @par obj an S4 object of class 'model' ### @par verbose an object of class 'logical' -### @return either TRUE or FALSE if parameters are fully +### @return either TRUE or FALSE if parameters are fully ### specified or not. In case verbose == TRUE an ### error is thrown. ### ------------------------------------------------------------------- -".haspar.binomial.Model" <- function(obj, verbose) -{ - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty.", - call. = FALSE ) - } else { - return( FALSE ) - } +".haspar.binomial.Model" <- function(obj, verbose) { + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty.", + call. = FALSE + ) } else { - if ("p" %in% names(obj@par)) { - if ( verbose ) { - stop( paste( "Wring specification of slot @par ", - "in 'model' object. Binomial models ", - "need a parameter named 'p'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } + return(FALSE) + } + } else { + if ("p" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wring specification of slot @par ", + "in 'model' object. Binomial models ", + "need a parameter named 'p'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (length(obj@par$p) != obj@K) { + if (verbose) { + stop(paste("Wrong specification of slot @par of ", + "'model' object. Slot @K does not ", + "match the dimension of parameters ", + "in @par$p.", + sep = "" + ), call. = FALSE) } else { - if ( length( obj@par$p ) != obj@K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par of ", - "'model' object. Slot @K does not ", - "match the dimension of parameters ", - "in @par$p.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } + return(FALSE) } + } else { + return(TRUE) + } } + } } ### ------------------------------------------------------------------ @@ -1113,42 +1195,46 @@ setReplaceMethod( "setT", "model", ### @return either TRUE or FALSE if parameters are fully specified or ### nor. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ -".haspar.exponential.Model" <- function( obj, verbose ) -{ - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty", - call. = FALSE ) - } else { - return( FALSE ) - } +".haspar.exponential.Model" <- function(obj, verbose) { + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty", + call. = FALSE + ) } else { - if ( !"lambda" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Exponential ", - "models need a parameter named ", - "'lambda'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } + return(FALSE) + } + } else { + if (!"lambda" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Exponential ", + "models need a parameter named ", + "'lambda'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (length(obj@par$lambda) != obj@K) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'model' object. Number of Exponential ", + "parameters in @par$lambda must match ", + "number of components in slot @K.", + sep = "" + ), call. = FALSE) } else { - if ( length( obj@par$lambda ) != obj@K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'model' object. Number of Exponential ", - "parameters in @par$lambda must match ", - "number of components in slot @K.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return ( TRUE ) - } + return(FALSE) } + } else { + return(TRUE) + } } + } } ### ------------------------------------------------------------------ @@ -1161,62 +1247,70 @@ setReplaceMethod( "setT", "model", ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ -".haspar.normal.Model" <- function( obj, verbose ) -{ - K <- obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty.", - call. = FALSE ) +".haspar.normal.Model" <- function(obj, verbose) { + K <- obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("mu" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Normal models ", + "need a mean vector named 'mu'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (length(obj@par$mu) != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "@par$mu.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "mu" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Normal models ", - "need a mean vector named 'mu'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("sigma" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Normal models ", + "need a standard deviation vector ", + "named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } } else { - if ( length( obj@par$mu ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "@par$mu." , sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( "sigma" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Normal models ", - "need a standard deviation vector ", - "named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( length( obj@par$sigma ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "par@$sigma.", sep = "" ), call. = FALSE ) - } - } else { - return( TRUE ) - } - } - } + if (length(obj@par$sigma) != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "par@$sigma.", + sep = "" + ), call. = FALSE) + } + } else { + return(TRUE) + } } + } } + } } ### ------------------------------------------------------------------ @@ -1229,62 +1323,70 @@ setReplaceMethod( "setT", "model", ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ -".haspar.normult.Model" <- function( obj, verbose ) -{ - K <- obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty.", - call. = FALSE ) +".haspar.normult.Model" <- function(obj, verbose) { + K <- obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("mu" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Normal models ", + "need a mean vector named 'mu'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (ncol(obj@par$mu) != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "@par$mu.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "mu" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Normal models ", - "need a mean vector named 'mu'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("sigma" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Normal models ", + "need a standard deviation vector ", + "named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } } else { - if ( ncol( obj@par$mu ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "@par$mu." , sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( "sigma" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Normal models ", - "need a standard deviation vector ", - "named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( dim( obj@par$sigma )[3] != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "par@$sigma.", sep = "" ), call. = FALSE ) - } - } else { - return( TRUE ) - } - } - } + if (dim(obj@par$sigma)[3] != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "par@$sigma.", + sep = "" + ), call. = FALSE) + } + } else { + return(TRUE) + } } + } } + } } ### ------------------------------------------------------------------ @@ -1297,73 +1399,83 @@ setReplaceMethod( "setT", "model", ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ -".haspar.student.Model" <- function( obj, verbose ) -{ - K <- obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty.", - call. = FALSE ) +".haspar.student.Model" <- function(obj, verbose) { + K <- obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("mu" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Student-t models ", + "need a mean vector named 'mu'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (length(obj@par$mu) != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "@par$mu.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "mu" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Student-t models ", - "need a mean vector named 'mu'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("sigma" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Student-t models ", + "need a standard deviation vector ", + "named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } } else { - if ( length( obj@par$mu ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "@par$mu." , sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + if (length(obj@par$sigma) != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "par@$sigma.", + sep = "" + ), call. = FALSE) + } + } else { + if (!"df" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Student-t models ", + "need a vector with degrees of freedom ", + "named 'df'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( !( "sigma" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Student-t models ", - "need a standard deviation vector ", - "named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( length( obj@par$sigma ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "par@$sigma.", sep = "" ), call. = FALSE ) - } - } else { - if ( !"df" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Student-t models ", - "need a vector with degrees of freedom ", - "named 'df'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } - } + return(TRUE) + } + } } + } } + } } ### ------------------------------------------------------------------ @@ -1376,80 +1488,90 @@ setReplaceMethod( "setT", "model", ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ -".haspar.studmult.Model" <- function( obj, verbose ) -{ - K <- obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'model' object is empty.", - call. = FALSE ) +".haspar.studmult.Model" <- function(obj, verbose) { + K <- obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'model' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("mu" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Student-t models ", + "need a mean vector named 'mu'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (ncol(obj@par$mu) != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "@par$mu.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "mu" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Student-t models ", - "need a mean vector named 'mu'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("sigma" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Student-t models ", + "need a standard deviation vector ", + "named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } } else { - if ( ncol( obj@par$mu ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "@par$mu." , sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + if (dim(obj@par$sigma)[3] != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Slot @K does ", + "not match dimension of parameter ", + "par@$sigma.", + sep = "" + ), call. = FALSE) + } + } else { + if (!"df" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'model' object. Student-t models ", + "need a vector with degrees of freedom ", + "named 'df'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( !( "sigma" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Student-t models ", - "need a standard deviation vector ", - "named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( dim( obj@par$sigma )[3] != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Slot @K does ", - "not match dimension of parameter ", - "par@$sigma.", sep = "" ), call. = FALSE ) - } - } else { - if ( !"df" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'model' object. Student-t models ", - "need a vector with degrees of freedom ", - "named 'df'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } - } + return(TRUE) + } + } } + } } + } } ### Validity ### Validity checking of model objects is implemented ### in two versions: an initializing version relying partly ### on warnings and amore restrictive version relying exclusively -### on errors. +### on errors. ### The less restrictive validity check is used in setters and ### and the fully restrictive version in the constructor and later ### usage of model object (e.g. see 'mcmcstart()') @@ -1457,19 +1579,18 @@ setReplaceMethod( "setT", "model", ### .init.valid.Model ### @description Initial validity check for model object ### @par obj a model object -### @return An error in case certain conditions are failed or there are +### @return An error in case certain conditions are failed or there are ### inconsistencies. ### @see ?model, ?vignette('finmix'), .init.valid.*, .valid.* ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- -".init.valid.Model" <- function(obj) -{ - .valid.dist.Model(obj) - .init.valid.K.Model(obj) - .init.valid.r.Model(obj) - .init.valid.par.Model(obj) - .init.valid.weight.Model(obj) - .init.valid.T.Model(obj) +".init.valid.Model" <- function(obj) { + .valid.dist.Model(obj) + .init.valid.K.Model(obj) + .init.valid.r.Model(obj) + .init.valid.par.Model(obj) + .init.valid.weight.Model(obj) + .init.valid.T.Model(obj) } ### ----------------------------------------------------------------------------- @@ -1481,43 +1602,49 @@ setReplaceMethod( "setT", "model", ### @see ?model, ?vignette('finmix'), .init.valid.*, .valid.* ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- -".valid.Model" <- function(obj) -{ - .valid.dist.Model(obj) - .valid.K.Model(obj) - .valid.r.Model(obj) - .valid.par.Model(obj) - .valid.weight.Model(obj) - .valid.T.Model(obj) +".valid.Model" <- function(obj) { + .valid.dist.Model(obj) + .valid.K.Model(obj) + .valid.r.Model(obj) + .valid.par.Model(obj) + .valid.weight.Model(obj) + .valid.T.Model(obj) } ### ---------------------------------------------------------------------------- ### .valid.dist.Model -### @description Initial validity check for the distribution of a finite +### @description Initial validity check for the distribution of a finite ### mixture model ### @par obj a model object ### @return An error in case the distribution is unknown. ### @see ?model, ?vignette('finmix')i ### ---------------------------------------------------------------------------- -".valid.dist.Model" <- function( obj ) -{ - dists <- c( "normal", "normult", "exponential", - "student", "studmult", "poisson", - "cond.poisson", "binomial") - indicmod.dists <- c( "multinomial" ) - if ( length( obj@dist ) > 0 ) { - if ( !( obj@dist %in% dists ) ) { - stop( paste( "Unknown distribution in slot 'dist' ", - "of 'model' object.", sep = "" ), - call. = FALSE ) - } else { - if ( !( obj@indicmod %in% indicmod.dists ) ) { - stop( paste( "Unknown indicator distribution in slot ", - "'indicmod' of 'model' object.", sep = "" ), - call. = FALSE ) - } - } +".valid.dist.Model" <- function(obj) { + dists <- c( + "normal", "normult", "exponential", + "student", "studmult", "poisson", + "cond.poisson", "binomial" + ) + indicmod.dists <- c("multinomial") + if (length(obj@dist) > 0) { + if (!(obj@dist %in% dists)) { + stop(paste("Unknown distribution in slot 'dist' ", + "of 'model' object.", + sep = "" + ), + call. = FALSE + ) + } else { + if (!(obj@indicmod %in% indicmod.dists)) { + stop(paste("Unknown indicator distribution in slot ", + "'indicmod' of 'model' object.", + sep = "" + ), + call. = FALSE + ) + } } + } } ### ---------------------------------------------------------------------------- @@ -1530,26 +1657,29 @@ setReplaceMethod( "setT", "model", ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".init.valid.K.Model" <- function( obj ) -{ - if ( obj@K < 1 ) { - stop( paste( "Wrong specification of slot 'K' of ", - "'model' object. Number of components ", - "must be a positive integer.", sep = "" ), - call. = FALSE ) - } else { - if ( !all( is.na( obj@weight ) ) ) { - if ( obj@K != ncol( obj@weight ) ) { - stop( paste( "Dimension of slot 'weight' in ", - "'model' object does not match ", - "number of components in slot 'K'.", - sep = "" ), - call. = FALSE ) - } - } - .init.valid.par.Model( obj ) - } - +".init.valid.K.Model" <- function(obj) { + if (obj@K < 1) { + stop(paste("Wrong specification of slot 'K' of ", + "'model' object. Number of components ", + "must be a positive integer.", + sep = "" + ), + call. = FALSE + ) + } else { + if (!all(is.na(obj@weight))) { + if (obj@K != ncol(obj@weight)) { + stop(paste("Dimension of slot 'weight' in ", + "'model' object does not match ", + "number of components in slot 'K'.", + sep = "" + ), + call. = FALSE + ) + } + } + .init.valid.par.Model(obj) + } } ### ---------------------------------------------------------------------------- @@ -1563,152 +1693,187 @@ setReplaceMethod( "setT", "model", ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".valid.K.Model" <- function( obj ) -{ - if ( obj@K < 1 ) { - stop( paste( "Wrong specification of slot 'K' of ", - "'model' object. Number of components ", - "must be a positive integer.", sep = "" ), - call. = FALSE ) - } else { - if ( !all( is.na( obj@weight ) ) ) { - if ( obj@K != ncol( obj@weight ) ) { - warning( paste( "Dimension of slot 'weight' in ", - "'model' object does not match ", - "number of components in slot 'K'.", - sep = "" ), - call. = FALSE ) - } - } - .valid.par.Model( obj ) - } +".valid.K.Model" <- function(obj) { + if (obj@K < 1) { + stop(paste("Wrong specification of slot 'K' of ", + "'model' object. Number of components ", + "must be a positive integer.", + sep = "" + ), + call. = FALSE + ) + } else { + if (!all(is.na(obj@weight))) { + if (obj@K != ncol(obj@weight)) { + warning(paste("Dimension of slot 'weight' in ", + "'model' object does not match ", + "number of components in slot 'K'.", + sep = "" + ), + call. = FALSE + ) + } + } + .valid.par.Model(obj) + } } - + ### ---------------------------------------------------------------------------- ### .init.valid.r.Model ### @description Initial validity check for variable dimension r. ### @par obj a model object -### @return An error in case the variable dimension r is not a positive +### @return An error in case the variable dimension r is not a positive ### integer or the dimension does not fit the distribution model. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".init.valid.r.Model" <- function( obj ) -{ - univ <- .get.univ.Model() - multiv <- .get.multiv.Model() - if ( obj@r < 1 ) { - stop( paste( "Wrong specification of slot 'r' ", - "in 'model' object. Dimension of ", - "variables must be a positive integer.", - sep ="" ), - call. = FALSE ) - } else { - if ( ( obj@dist %in% univ ) && obj@r > 1 ) { - stop( paste( "Wrong specification of slot 'r' ", - "in 'model' object. Univariate ", - "distributions can only have one ", - "dimension.", sep = "" ), - call. = FALSE ) - } else if ( ( obj@dist %in% multiv ) && obj@r < 2 ) { - stop( paste( "Wrong specification of slot 'r' ", - "in 'model' object. Multivariate ", - "distributions must have dimension ", - "greater one.", sep ="" ), - call. = FALSE ) - } +".init.valid.r.Model" <- function(obj) { + univ <- .get.univ.Model() + multiv <- .get.multiv.Model() + if (obj@r < 1) { + stop(paste("Wrong specification of slot 'r' ", + "in 'model' object. Dimension of ", + "variables must be a positive integer.", + sep = "" + ), + call. = FALSE + ) + } else { + if ((obj@dist %in% univ) && obj@r > 1) { + stop(paste("Wrong specification of slot 'r' ", + "in 'model' object. Univariate ", + "distributions can only have one ", + "dimension.", + sep = "" + ), + call. = FALSE + ) + } else if ((obj@dist %in% multiv) && obj@r < 2) { + stop(paste("Wrong specification of slot 'r' ", + "in 'model' object. Multivariate ", + "distributions must have dimension ", + "greater one.", + sep = "" + ), + call. = FALSE + ) } + } } ### ---------------------------------------------------------------------------- ### .init.valid.r.Model ### @description Initial validity check for variable dimension r. ### @par obj a model object -### @return An error in case the variable dimension r is not a positive +### @return An error in case the variable dimension r is not a positive ### integer or a warning if the dimension does not fit the ### distribution model. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".valid.r.Model" <- function( obj ) -{ - univ <- .get.univ.Model() - multiv <- .get.multiv.Model() - if ( obj@r < 1 ) { - stop(paste( "Wrong specification of slot 'r' ", - "in 'model' object. Dimension of ", - "variables must be positive.", - sep ="" ), - call. = FALSE ) - } else { - if ( ( obj@dist %in% univ ) && obj@r > 1 ) { - stop( paste( "Wrong specification of slot 'r' ", - "in 'model' object. Univariate ", - "distributions can only have one ", - "dimension.", sep = "" ), - call. = FALSE ) - } else if ( ( obj@dist %in% multiv ) && obj@r < 2 ) { - stop( paste( "Wrong specification of slot 'r' ", - "in 'model' object. Multivariate ", - "distributions must have dimension ", - "greater one.", sep ="" ), - call. = FALSE ) - } +".valid.r.Model" <- function(obj) { + univ <- .get.univ.Model() + multiv <- .get.multiv.Model() + if (obj@r < 1) { + stop(paste("Wrong specification of slot 'r' ", + "in 'model' object. Dimension of ", + "variables must be positive.", + sep = "" + ), + call. = FALSE + ) + } else { + if ((obj@dist %in% univ) && obj@r > 1) { + stop(paste("Wrong specification of slot 'r' ", + "in 'model' object. Univariate ", + "distributions can only have one ", + "dimension.", + sep = "" + ), + call. = FALSE + ) + } else if ((obj@dist %in% multiv) && obj@r < 2) { + stop(paste("Wrong specification of slot 'r' ", + "in 'model' object. Multivariate ", + "distributions must have dimension ", + "greater one.", + sep = "" + ), + call. = FALSE + ) } + } } ### ---------------------------------------------------------------------------- ### .init.valid.weight.Model -### @description Initial validity check for the weights of a finite mixture +### @description Initial validity check for the weights of a finite mixture ### model. ### @par obj a model object ### @return An error if the dimension of the weight vector does not fit -### the model or if the weights do not sum to 1, are negative or +### the model or if the weights do not sum to 1, are negative or ### larger than one. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".init.valid.weight.Model" <- function( obj ) -{ - if ( !all( is.na( obj@weight ) ) ) { - if ( nrow( obj@weight ) > 1 ) { - stop( paste( "Wrong dimension of slot 'weight' in ", - "'model' object. Dimension of slot ", - "'weight' must be 1 x K.", sep = "" ), - call. = FALSE ) +".init.valid.weight.Model" <- function(obj) { + if (!all(is.na(obj@weight))) { + if (nrow(obj@weight) > 1) { + stop(paste("Wrong dimension of slot 'weight' in ", + "'model' object. Dimension of slot ", + "'weight' must be 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else { + if (ncol(obj@weight) != obj@K) { + stop(paste("Wrong number of weights in slot 'weight' of ", + "'model' object. Number of weights does not ", + "match number of components in slot 'K'.", + sep = "" + ), + call. = FALSE + ) + } else { + if (is.integer(obj@weight)) { + stop(paste("Wrong specification of slot 'weight' of ", + "'model' object. Weights must be of type ", + "'numeric'.", + sep = "" + ), + call. = FALSE + ) + } + if (!is.numeric(obj@weight)) { + stop(paste("Wrong specification of slot 'weight' of ", + "'model' object. Weights must be of type ", + "'numeric'.", + sep = "" + ), + call. = FALSE + ) + } + if (any(obj@weight <= 0) || any(obj@weight >= 1)) { + stop(paste("Weights in slot 'weight' of 'model' ", + "object must be positive.", + sep = "" + ), + call. = FALSE + ) } else { - if ( ncol( obj@weight ) != obj@K ) { - stop( paste( "Wrong number of weights in slot 'weight' of ", - "'model' object. Number of weights does not ", - "match number of components in slot 'K'.", sep = "" ), - call. = FALSE ) - } else { - if ( is.integer( obj@weight ) ) { - stop( paste( "Wrong specification of slot 'weight' of ", - "'model' object. Weights must be of type ", - "'numeric'.", sep = "" ), - call. = FALSE ) - } - if ( !is.numeric( obj@weight ) ) { - stop( paste( "Wrong specification of slot 'weight' of ", - "'model' object. Weights must be of type ", - "'numeric'.", sep = "" ), - call. = FALSE ) - } - if ( any( obj@weight <= 0 ) || any( obj@weight >= 1 ) ) { - stop( paste( "Weights in slot 'weight' of 'model' ", - "object must be positive.", sep = "" ), - call. = FALSE ) - } else { - if ( round( sum( obj@weight ) ) != 1 ) { - stop( paste( "Weights in slot 'weight' of 'model' ", - "object must sum to one.", sep = "" ), - call. = FALSE ) - } - } - } + if (round(sum(obj@weight)) != 1) { + stop(paste("Weights in slot 'weight' of 'model' ", + "object must sum to one.", + sep = "" + ), + call. = FALSE + ) + } } + } } + } } ### ------------------------------------------------------------------------------------ @@ -1721,111 +1886,142 @@ setReplaceMethod( "setT", "model", ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------------- -".valid.weight.Model" <- function( obj ) -{ - if ( !all( is.na( obj@weight ) ) ) { - if ( nrow( obj@weight ) > 1 ) { - warning( paste( "Wrong dimension of slot 'weight' in ", - "'model' object. Dimension of slot ", - "'weight' must be 1 x K.", sep = "" ), - call. = FALSE ) +".valid.weight.Model" <- function(obj) { + if (!all(is.na(obj@weight))) { + if (nrow(obj@weight) > 1) { + warning(paste("Wrong dimension of slot 'weight' in ", + "'model' object. Dimension of slot ", + "'weight' must be 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else { + if (ncol(obj@weight) != obj@K) { + warning(paste("Wrong number of weights in slot 'weight' of ", + "'model' object. Number of weights does not ", + "match number of components in slot 'K'.", + sep = "" + ), + call. = FALSE + ) + } else { + if (is.integer(obj@weight)) { + stop(paste("Wrong specification of slot 'weight' of ", + "'model' object. Weights must be of type ", + "'numeric'.", + sep = "" + ), + call. = FALSE + ) + } + if (!is.numeric(obj@weight)) { + stop(paste("Wrong specification of slot 'weight' of ", + "'model' object. Weights must be of type ", + "'numeric'.", + sep = "" + ), + call. = FALSE + ) + } + if (any(obj@weight <= 0) || any(obj@weight >= 1)) { + warning(paste("Weights in slot 'weight' of 'model' ", + "object must be positive.", + sep = "" + ), + call. = FALSE + ) } else { - if ( ncol( obj@weight ) != obj@K ) { - warning( paste( "Wrong number of weights in slot 'weight' of ", - "'model' object. Number of weights does not ", - "match number of components in slot 'K'.", sep = "" ), - call. = FALSE ) - } else { - if ( is.integer(obj@weight ) ) { - stop( paste( "Wrong specification of slot 'weight' of ", - "'model' object. Weights must be of type ", - "'numeric'.", sep = "" ), - call. = FALSE ) - } - if ( !is.numeric( obj@weight ) ) { - stop( paste( "Wrong specification of slot 'weight' of ", - "'model' object. Weights must be of type ", - "'numeric'.", sep = "" ), - call. = FALSE ) - } - if ( any( obj@weight <= 0 ) || any( obj@weight >= 1 ) ) { - warning( paste( "Weights in slot 'weight' of 'model' ", - "object must be positive.", sep = "" ), - call. = FALSE ) - } else { - if ( round( sum( obj@weight ) ) != 1 ) { - warning( paste( "Weights in slot 'weight' of 'model' ", - "object must sum to one.", sep = "" ), - call. = FALSE ) - } - } - } + if (round(sum(obj@weight)) != 1) { + warning(paste("Weights in slot 'weight' of 'model' ", + "object must sum to one.", + sep = "" + ), + call. = FALSE + ) + } } + } } + } } ### ------------------------------------------------------------------------------------- ### .init.valid.T.Model ### @description Initial validity check for the repetitions of a Binomial mixture. -### @par obj a model object -### @return An error in case the reptitions are not of type integer, have +### @par obj a model object +### @return An error in case the reptitions are not of type integer, have ### the wrong dimension, or non-positive values. ### @see ?model, ?vignette('finmix') ### -------------------------------------------------------------------------------------- -".init.valid.T.Model" <- function( obj ) -{ - if ( !all( is.na( obj@T ) ) ) { - if ( !is.integer( obj@T ) ) { - stop( paste( "Wrong type of slot 'T' in 'model' object ", - "Repetitions must be of type 'integer'.", - sep = "" ), - call. = FALSE ) - } - if ( nrow( obj@T ) > 1 && ncol( obj@T ) > 1 ) { - stop( paste( "Wrong dimension of slot 'T' in 'model' ", - "object. Repetitions can only be ", - "one-dimensional", sep = "" ), - call. = FALSE ) - } - if ( any( obj@T < 1 ) ) { - stop( paste( "Wrong specification of slot 'T' in 'model' ", - "object. Repetitions must be positive integers ", - "or NA.", sep = "" ), - call. = FALSE) - } +".init.valid.T.Model" <- function(obj) { + if (!all(is.na(obj@T))) { + if (!is.integer(obj@T)) { + stop(paste("Wrong type of slot 'T' in 'model' object ", + "Repetitions must be of type 'integer'.", + sep = "" + ), + call. = FALSE + ) } + if (nrow(obj@T) > 1 && ncol(obj@T) > 1) { + stop(paste("Wrong dimension of slot 'T' in 'model' ", + "object. Repetitions can only be ", + "one-dimensional", + sep = "" + ), + call. = FALSE + ) + } + if (any(obj@T < 1)) { + stop(paste("Wrong specification of slot 'T' in 'model' ", + "object. Repetitions must be positive integers ", + "or NA.", + sep = "" + ), + call. = FALSE + ) + } + } } ### ------------------------------------------------------------------------------------- ### .valid.T.Model ### @description Validity check for the repetitions of a Binomial mixture. -### @par obj a model object -### @return An error in case the reptitions are not of type integer, have +### @par obj a model object +### @return An error in case the reptitions are not of type integer, have ### the wrong dimension, or non-positive values. ### @see ?model, ?vignette('finmix') ### -------------------------------------------------------------------------------------- -".valid.T.Model" <- function( obj ) -{ - if ( !all( is.na( obj@T ) ) ) { - if ( !is.integer( obj@T ) ) { - stop( paste( "Wrong type of slot 'T' in 'model' object ", - "Repetitions must be of type 'integer'.", - sep = "" ), - call. = FALSE ) - } - if ( nrow( obj@T ) > 1 && ncol( obj@T ) > 1 ) { - stop( paste( "Wrong dimension of slot 'T' in 'model' ", - "object. Repetitions can only be ", - "one-dimensional", sep = "" ), - call. = FALSE ) - } - if ( any( obj@T < 1 ) ) { - stop( paste( "Wrong specification of slot 'T' in 'model' ", - "object. Repetitions must be positive integers ", - "or NA.", sep = "" ), - call. = FALSE) - } +".valid.T.Model" <- function(obj) { + if (!all(is.na(obj@T))) { + if (!is.integer(obj@T)) { + stop(paste("Wrong type of slot 'T' in 'model' object ", + "Repetitions must be of type 'integer'.", + sep = "" + ), + call. = FALSE + ) + } + if (nrow(obj@T) > 1 && ncol(obj@T) > 1) { + stop(paste("Wrong dimension of slot 'T' in 'model' ", + "object. Repetitions can only be ", + "one-dimensional", + sep = "" + ), + call. = FALSE + ) } + if (any(obj@T < 1)) { + stop(paste("Wrong specification of slot 'T' in 'model' ", + "object. Repetitions must be positive integers ", + "or NA.", + sep = "" + ), + call. = FALSE + ) + } + } } @@ -1833,65 +2029,63 @@ setReplaceMethod( "setT", "model", ### .init.valid.par.Model ### @description Initial validity check of model parameters ### @par obj a model object -### @return An error if parameters fail certain conditions +### @return An error if parameters fail certain conditions ### @detail This validity check is called in the S4 constructor -### 'model()' and ensures that the user constructs an inherently +### 'model()' and ensures that the user constructs an inherently ### consistent model object. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### -------------------------------------------------------------------------------- -".init.valid.par.Model" <- function( obj ) -{ - dist <- obj@dist - if ( length( obj@par ) > 0) { - if ( dist %in% c( "poisson", "cond.poisson" ) ) { - .init.valid.Poisson.Model( obj ) - } else if ( dist == "binomial" ) { - .init.valid.Binomial.Model( obj ) - } else if ( dist == "normal" ) { - .init.valid.Normal.Model( obj ) - } else if ( dist == "normult" ) { - .init.valid.Normult.Model( obj ) - } else if ( dist == "student" ) { - .init.valid.Student.Model( obj ) - } else if ( dist == "studmult" ) { - .init.valid.Studmult.Model( obj ) - } +".init.valid.par.Model" <- function(obj) { + dist <- obj@dist + if (length(obj@par) > 0) { + if (dist %in% c("poisson", "cond.poisson")) { + .init.valid.Poisson.Model(obj) + } else if (dist == "binomial") { + .init.valid.Binomial.Model(obj) + } else if (dist == "normal") { + .init.valid.Normal.Model(obj) + } else if (dist == "normult") { + .init.valid.Normult.Model(obj) + } else if (dist == "student") { + .init.valid.Student.Model(obj) + } else if (dist == "studmult") { + .init.valid.Studmult.Model(obj) } + } } ### ------------------------------------------------------------------------------- ### .valid.par.Model ### @description Validity check of model parameters ### @par obj a model object -### @return An error if parameters fail certain necessary conditions and +### @return An error if parameters fail certain necessary conditions and ### a warning if parameters fail consistency. ### @detail This validity check is called in the setters to ensure that -### slots can be changed without errors but help the user to +### slots can be changed without errors but help the user to ### end up with an inherently consistent model object. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### -------------------------------------------------------------------------------- -".valid.par.Model" <- function(obj) -{ - dist <- obj@dist - if ( length( obj@par ) > 0 ) { - if ( dist %in% c( "poisson", "cond.poisson" ) ) { - .valid.Poisson.Model( obj ) - } else if ( dist == "binomial" ) { - .valid.Binomial.Model( obj ) - } else if ( dist == "exponential" ) { - .valid.Exponential.Model( obj ) - } else if ( dist == "normal" ) { - .valid.Normal.Model( obj ) - } else if ( dist == "normult" ) { - .valid.Normult.Model( obj ) - } else if ( dist == "student" ) { - .valid.Student.Model( obj ) - } else if ( dist == "studmult" ) { - .valid.Studmult.Model( obj ) - } +".valid.par.Model" <- function(obj) { + dist <- obj@dist + if (length(obj@par) > 0) { + if (dist %in% c("poisson", "cond.poisson")) { + .valid.Poisson.Model(obj) + } else if (dist == "binomial") { + .valid.Binomial.Model(obj) + } else if (dist == "exponential") { + .valid.Exponential.Model(obj) + } else if (dist == "normal") { + .valid.Normal.Model(obj) + } else if (dist == "normult") { + .valid.Normult.Model(obj) + } else if (dist == "student") { + .valid.Student.Model(obj) + } else if (dist == "studmult") { + .valid.Studmult.Model(obj) } + } } ### ----------------------------------------------------------------------------- @@ -1899,1039 +2093,1397 @@ setReplaceMethod( "setT", "model", ### @description Initial validity check for parameters of a Poisson mixture. ### @par obj a model object ### @return An error if parameters fail certain conditions. -### @detail This initial validity check is called in the S4 constructor -### 'model()' and ensures that the user constructs an inherently -### consistent model object. +### @detail This initial validity check is called in the S4 constructor +### 'model()' and ensures that the user constructs an inherently +### consistent model object. ### The parameter list must contain an element 'lambda' that is ### an 1 x K array, vector or matrix with numeric or integer values ### all positive. ### @see ?model ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- -".init.valid.Poisson.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( "lambda" %in% names( obj@par ) ) { - if ( !is.array( obj@par$lambda ) && !is.vector( obj@par$lambda ) && - !is.matrix( obj@par$lambda ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Poisson parameters must be either an ", - "array, a vector or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } - obj@par$lambda <- as.vector( obj@par$lambda ) - if ( !is.numeric( obj@par$lambda ) && !is.integer( obj@par$lambda ) ) { - stop( paste( "Wrong specification in slot 'par' of 'model' object. ", - "Parameters must be of type 'numeric' or 'integer'.", - sep = "" ), - call. = FALSE ) - } - if ( length( obj@par$lambda ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "lambda must be either an array, a vector ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else { - if ( any( obj@par$lambda <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Poisson parameters ", - "must be positive.", sep = "" ), - call. = FALSE ) - } - } - } else { - warning( paste( "Wrong specification of slot 'par' in 'model' object. ", - "Poisson parameters must be named 'lambda'.", sep = ""), - call. = FALSE ) - } +".init.valid.Poisson.Model" <- function(obj) { + if (length(obj@par) > 0) { + if ("lambda" %in% names(obj@par)) { + if (!is.array(obj@par$lambda) && !is.vector(obj@par$lambda) && + !is.matrix(obj@par$lambda)) { + stop(paste("Wrong specification of slot @par: ", + "Poisson parameters must be either an ", + "array, a vector or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + obj@par$lambda <- as.vector(obj@par$lambda) + if (!is.numeric(obj@par$lambda) && !is.integer(obj@par$lambda)) { + stop(paste("Wrong specification in slot 'par' of 'model' object. ", + "Parameters must be of type 'numeric' or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } + if (length(obj@par$lambda) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "lambda must be either an array, a vector ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else { + if (any(obj@par$lambda <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Poisson parameters ", + "must be positive.", + sep = "" + ), + call. = FALSE + ) + } + } + } else { + warning(paste("Wrong specification of slot 'par' in 'model' object. ", + "Poisson parameters must be named 'lambda'.", + sep = "" + ), + call. = FALSE + ) } + } } ### ----------------------------------------------------------------------------- -### .valid.Poisson.Model +### .valid.Poisson.Model ### @description Validity check for parameters of a Poisson mixture. ### @par obj a model object ### @return An error if parameters do fail certain necessary conditions. ### A warning if parameters do fail consistency. ### @detail This validity check is called in the setters to ensure that -### slots can be changed without errors but help the user to +### slots can be changed without errors but help the user to ### get a inherently consistent model object. -### The parameter list must contain an element 'lambda' that is +### The parameter list must contain an element 'lambda' that is ### an 1 x K array, vector or matrix with numeric or integer values ### all positive. ### @see $model ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- -".valid.Poisson.Model" <- function( obj ) -{ - if ( length( par) > 0 ) { - if ( "lambda" %in% names( obj@par ) ) { - if ( !is.array( obj@par$lambda ) && !is.vector( obj@par$lambda ) && - !is.matrix( obj@par$lambda ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Poisson parameters must be either an ", - "array, a vector or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } - obj@par$lambda <- as.vector( obj@par$lambda ) - if ( !is.numeric( obj@par$lambda ) && !is.integer( obj@par$lambda ) ) { - stop( paste( "Wrong specification in slot 'par' of 'model' object. ", - "Parameters must be of type 'numeric' or 'integer'.", - sep = "" ), - call. = FALSE ) - } - if ( length( obj@par$lambda ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "lambda must be either an array, a vector ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else { - if ( any( obj@par$lambda <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Poisson parameters ", - "must be positive.", sep = "" ), - call. = FALSE ) - } - } - } else { - stop( paste( "Wrong specification of slot 'par' in 'model' object. ", - "Poisson parameters must be named 'lambda'.", sep = "" ), - call. = FALSE ) - } +".valid.Poisson.Model" <- function(obj) { + if (length(par) > 0) { + if ("lambda" %in% names(obj@par)) { + if (!is.array(obj@par$lambda) && !is.vector(obj@par$lambda) && + !is.matrix(obj@par$lambda)) { + stop(paste("Wrong specification of slot @par: ", + "Poisson parameters must be either an ", + "array, a vector or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + obj@par$lambda <- as.vector(obj@par$lambda) + if (!is.numeric(obj@par$lambda) && !is.integer(obj@par$lambda)) { + stop(paste("Wrong specification in slot 'par' of 'model' object. ", + "Parameters must be of type 'numeric' or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } + if (length(obj@par$lambda) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "lambda must be either an array, a vector ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else { + if (any(obj@par$lambda <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Poisson parameters ", + "must be positive.", + sep = "" + ), + call. = FALSE + ) + } + } + } else { + stop(paste("Wrong specification of slot 'par' in 'model' object. ", + "Poisson parameters must be named 'lambda'.", + sep = "" + ), + call. = FALSE + ) } + } } ### ------------------------------------------------------------------------------ -### .init.valid.Binomial.Model +### .init.valid.Binomial.Model ### @description Initial validity check for parameters of a Binomial mixture. ### @par obj a model object ### @return An error if parameters fail certain conditions ### @detail This initial validity check is called in the S4 constructor ### 'model()' and ensures that the user constructs an inherently ### consistent model object. -### The parameter list must contain an 1 x K array, vector, or +### The parameter list must contain an 1 x K array, vector, or ### matrix with probabilities, all between 0 and 1. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------ -".init.valid.Binomial.Model" <- function(model.obj) -{ - if ( length( obj@par ) ) { - if ( !"p" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Binomial mixtures need a ", - "probability vector named 'p'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$p ) && !is.vector( obj@par$p ) && - !is.matrix( obj@par$p ) ) { - stop( paste( "Wrong specification of slot @par: ", - "p must be either an array, a vector ", - "or a matrix of dimension 1 x K", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( obj@par$p ) || is.integer( obj@par$p ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be either of type ,", - "'numeric' or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$p ) != obj@K ) { - stop( paste( "Wrong specification of slot @par: ", - "p must be an array, a vector ", - "or a matrix of dimension 1 x K", sep = "" ), - call. = FALSE ) - } else if ( !all( obj@par$p > 0 && obj@par$p < 1 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Binomial parameters must be all ", - "between 0 and 1.", sep = "" ), - call. = FALSE ) - } - } - if (dim(model.obj@T)[1] > 1 && dim(model.obj@T)[2] > 1) { - stop(paste("Dimensions of repetitions 'T' for binomial mixture", - "model do not match conditions. Only one-dimensional", - "repetitions can be used in a binomial mixture model."), sep ="") +".init.valid.Binomial.Model" <- function(model.obj) { + if (length(obj@par)) { + if (!"p" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "Binomial mixtures need a ", + "probability vector named 'p'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$p) && !is.vector(obj@par$p) && + !is.matrix(obj@par$p)) { + stop(paste("Wrong specification of slot @par: ", + "p must be either an array, a vector ", + "or a matrix of dimension 1 x K", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(obj@par$p) || is.integer(obj@par$p))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be either of type ,", + "'numeric' or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$p) != obj@K) { + stop(paste("Wrong specification of slot @par: ", + "p must be an array, a vector ", + "or a matrix of dimension 1 x K", + sep = "" + ), + call. = FALSE + ) + } else if (!all(obj@par$p > 0 && obj@par$p < 1)) { + stop(paste("Wrong specification of slot @par: ", + "Binomial parameters must be all ", + "between 0 and 1.", + sep = "" + ), + call. = FALSE + ) } - + } + if (dim(model.obj@T)[1] > 1 && dim(model.obj@T)[2] > 1) { + stop(paste( + "Dimensions of repetitions 'T' for binomial mixture", + "model do not match conditions. Only one-dimensional", + "repetitions can be used in a binomial mixture model." + ), sep = "") + } } ### ------------------------------------------------------------------------------ -### .valid.Binomial.Model +### .valid.Binomial.Model ### @description Validity check for parameters of a Binomial mixture. ### @par obj a model object ### @return An error if parameters fail certain necessary conditions and ### a warning if parameters fail consistency ### @detail This validity check is called in the setters to ensure that -##ä slots can be changed without errors but help the user to +## ä slots can be changed without errors but help the user to ### end up with an inherently consistent model object. -### The parameter list must contain an 1 x K array, vector, or +### The parameter list must contain an 1 x K array, vector, or ### matrix with probabilities, all between 0 and 1. ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------ -".valid.Binomial.Model" <- function(model.obj) -{ - if ( length( obj@par ) ) { - if ( !"p" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "Binomial mixtures need a ", - "probability vector named 'p'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$p ) && !is.vector( obj@par$p ) && - !is.matrix( obj@par$p ) ) { - stop( paste( "Wrong specification of slot @par: ", - "p must be either an array, a vector ", - "or a matrix of dimension 1 x K", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( obj@par$p ) || is.integer( obj@par$p ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be either of type ,", - "'numeric' or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$p ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "p must be an array, a vector ", - "or a matrix of dimension 1 x K", sep = "" ), - call. = FALSE ) - } else if ( !all( obj@par$p > 0 && obj@par$p < 1 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Binomial parameters must be all ", - "between 0 and 1.", sep = "" ), - call. = FALSE ) - } - } - if (dim(model.obj@T)[1] > 1 && dim(model.obj@T)[2] > 1) { - stop(paste("Dimensions of repetitions 'T' for binomial mixture", - "model do not match conditions. Only one-dimensional", - "repetitions can be used in a binomial mixture model."), sep ="") +".valid.Binomial.Model" <- function(model.obj) { + if (length(obj@par)) { + if (!"p" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "Binomial mixtures need a ", + "probability vector named 'p'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$p) && !is.vector(obj@par$p) && + !is.matrix(obj@par$p)) { + stop(paste("Wrong specification of slot @par: ", + "p must be either an array, a vector ", + "or a matrix of dimension 1 x K", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(obj@par$p) || is.integer(obj@par$p))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be either of type ,", + "'numeric' or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$p) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "p must be an array, a vector ", + "or a matrix of dimension 1 x K", + sep = "" + ), + call. = FALSE + ) + } else if (!all(obj@par$p > 0 && obj@par$p < 1)) { + stop(paste("Wrong specification of slot @par: ", + "Binomial parameters must be all ", + "between 0 and 1.", + sep = "" + ), + call. = FALSE + ) } - + } + if (dim(model.obj@T)[1] > 1 && dim(model.obj@T)[2] > 1) { + stop(paste( + "Dimensions of repetitions 'T' for binomial mixture", + "model do not match conditions. Only one-dimensional", + "repetitions can be used in a binomial mixture model." + ), sep = "") + } } ### ----------------------------------------------------------------------------- ### .init.valid.Exponential.Model -### @description Initial validity check for parameters of a Exponential +### @description Initial validity check for parameters of a Exponential ### mixture. ### @par obj a model object ### @return An error if parameters fail certain conditions. -### @detail This initial validity check is called in the S4 constructor -### 'model()' and ensures that the user constructs an inherently -### consistent model object. +### @detail This initial validity check is called in the S4 constructor +### 'model()' and ensures that the user constructs an inherently +### consistent model object. ### The parameter list must contain an element 'lambda' that is ### an 1 x K array, vector or matrix with numeric or integer values ### all positive. ### @see ?model ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- -".init.valid.Exponential.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( "lambda" %in% names( obj@par ) ) { - if ( !is.array( obj@par$lambda ) && !is.vector( obj@par$lambda ) && - !is.matrix( obj@par$lambda ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Exponential parameters must be either an ", - "array, a vector or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } - obj@par$lambda <- as.vector( obj@par$lambda ) - if ( !is.numeric( obj@par$lambda ) && !is.integer( obj@par$lambda ) ) { - stop( paste( "Wrong specification in slot 'par' of 'model' object. ", - "Parameters must be of type 'numeric' or 'integer'.", - sep = "" ), - call. = FALSE ) - } - if ( length( obj@par$lambda ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "lambda must be either an array, a vector ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else { - if ( any( obj@par$lambda <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Exponential parameters ", - "must be positive.", sep = "" ), - call. = FALSE ) - } - } - } else { - warning( paste( "Wrong specification of slot 'par' in 'model' object. ", - "Exponential parameters must be named 'lambda'.", sep = ""), - call. = FALSE ) - } +".init.valid.Exponential.Model" <- function(obj) { + if (length(obj@par) > 0) { + if ("lambda" %in% names(obj@par)) { + if (!is.array(obj@par$lambda) && !is.vector(obj@par$lambda) && + !is.matrix(obj@par$lambda)) { + stop(paste("Wrong specification of slot @par: ", + "Exponential parameters must be either an ", + "array, a vector or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + obj@par$lambda <- as.vector(obj@par$lambda) + if (!is.numeric(obj@par$lambda) && !is.integer(obj@par$lambda)) { + stop(paste("Wrong specification in slot 'par' of 'model' object. ", + "Parameters must be of type 'numeric' or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } + if (length(obj@par$lambda) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "lambda must be either an array, a vector ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else { + if (any(obj@par$lambda <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Exponential parameters ", + "must be positive.", + sep = "" + ), + call. = FALSE + ) + } + } + } else { + warning(paste("Wrong specification of slot 'par' in 'model' object. ", + "Exponential parameters must be named 'lambda'.", + sep = "" + ), + call. = FALSE + ) } + } } ### ----------------------------------------------------------------------------- -### .valid.Exponential.Model +### .valid.Exponential.Model ### @description Validity check for parameters of a Exponential mixture. ### @par obj a model object ### @return An error if parameters do fail certain necessary conditions. ### A warning if parameters do fail consistency. ### @detail This validity check is called in the setters to ensure that -### slots can be changed without errors but help the user to +### slots can be changed without errors but help the user to ### get a inherently consistent model object. -### The parameter list must contain an element 'lambda' that is +### The parameter list must contain an element 'lambda' that is ### an 1 x K array, vector or matrix with numeric or integer values ### all positive. ### @see $model ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- -".valid.Exponential.Model"<- function( obj ) -{ - if ( length( par) > 0 ) { - if ( "lambda" %in% names( obj@par ) ) { - if ( !is.array( obj@par$lambda ) && !is.vector( obj@par$lambda ) && - !is.matrix( obj@par$lambda ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Exponential parameters must be either an ", - "array, a vector or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } - obj@par$lambda <- as.vector( obj@par$lambda ) - if ( !is.numeric( obj@par$lambda ) && !is.integer( obj@par$lambda ) ) { - stop( paste( "Wrong specification in slot 'par' of 'model' object. ", - "parameters must be of type 'numeric' or 'integer'.", - sep = "" ), - call. = FALSE ) - } - if ( length( obj@par$lambda ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "lambda must be either an array, a vector ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else { - if ( any( obj@par$lambda <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Exponential parameters ", - "must be positive.", sep = "" ), - call. = FALSE ) - } - } - } else { - stop( paste( "Wrong specification of slot 'par' in 'model' object. ", - "Exponential parameters must be named 'lambda'.", sep = "" ), - call. = FALSE ) - } +".valid.Exponential.Model" <- function(obj) { + if (length(par) > 0) { + if ("lambda" %in% names(obj@par)) { + if (!is.array(obj@par$lambda) && !is.vector(obj@par$lambda) && + !is.matrix(obj@par$lambda)) { + stop(paste("Wrong specification of slot @par: ", + "Exponential parameters must be either an ", + "array, a vector or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + obj@par$lambda <- as.vector(obj@par$lambda) + if (!is.numeric(obj@par$lambda) && !is.integer(obj@par$lambda)) { + stop(paste("Wrong specification in slot 'par' of 'model' object. ", + "parameters must be of type 'numeric' or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } + if (length(obj@par$lambda) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "lambda must be either an array, a vector ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else { + if (any(obj@par$lambda <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Exponential parameters ", + "must be positive.", + sep = "" + ), + call. = FALSE + ) + } + } + } else { + stop(paste("Wrong specification of slot 'par' in 'model' object. ", + "Exponential parameters must be named 'lambda'.", + sep = "" + ), + call. = FALSE + ) } + } } ### ------------------------------------------------------------------------------ ### .init.valid.Normal.Model -### @description Initial validity check for parameters of a univariate -### Normal mixture. -### @par obj a model object +### @description Initial validity check for parameters of a univariate +### Normal mixture. +### @par obj a model object ### @return An error if parameters fail certain conditions ### @detail This initial validity check is called in the S4 constructor ### 'model()' and ensures that the user constructs an inherently ### consistent model object. ### The parameter list must contain the following elements: -### mu: an 1 x K array, vector or matrix containing +### mu: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values -### sigma: an 1 x K array, vector or matrix containing +### sigma: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### df: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- -".init.valid.Normal.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "univariate Normal mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$mu ) && !is.vector( obj@par$mu ) && - !is.matrix( obj@par$mu ) ) { - stop( paste( "Wrong specification of slot @par: ", - "mu must be either an array, a vector ", - "or a matrix of dimension 1 x K. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$mu ) ) || - is.integer( as.vector( obj@par$mu ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( length( obj@par$mu ) != obj@K ) { - stop( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension 1 x K ", - "or a vector of size K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "univariate Normal mictures need ", - "a variance vector named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$sigma ) ) || - is.integer( as.vector( obj@par$sigma ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$sigma <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain variances, all ", - "positive.", sep = "" ), - .call = FALSE ) - } else if ( !is.array( obj@par$sigma ) && !is.vector( obj@par$sigma ) && - !is.matrix( obj@par$sigma ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$sigma ) != obj@K ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix, ", - "or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } +".init.valid.Normal.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "univariate Normal mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$mu) && !is.vector(obj@par$mu) && + !is.matrix(obj@par$mu)) { + stop(paste("Wrong specification of slot @par: ", + "mu must be either an array, a vector ", + "or a matrix of dimension 1 x K. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$mu)) || + is.integer(as.vector(obj@par$mu)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$mu) != obj@K) { + stop(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension 1 x K ", + "or a vector of size K.", + sep = "" + ), + call. = FALSE + ) } + if (!"sigma" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "univariate Normal mictures need ", + "a variance vector named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$sigma)) || + is.integer(as.vector(obj@par$sigma)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$sigma <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain variances, all ", + "positive.", + sep = "" + ), + .call = FALSE + ) + } else if (!is.array(obj@par$sigma) && !is.vector(obj@par$sigma) && + !is.matrix(obj@par$sigma)) { + stop(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$sigma) != obj@K) { + stop(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix, ", + "or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + } } ### ------------------------------------------------------------------------------ ### .valid.Normal.Model -### @description Validity check for parameters of a univariate Normal -### mixture. -### @par obj a model object +### @description Validity check for parameters of a univariate Normal +### mixture. +### @par obj a model object ### @return An error if parameters fail certain necessary conditions and ### a warning if parameters fail consistency. ### @detail This validity check is called in the setters to ensure that -### slots can be changed without errors but help the user to +### slots can be changed without errors but help the user to ### end up with an inherently consistent model object. ### The parameter list must contain the following elements: -### mu: an 1 x K array, vector or matrix containing +### mu: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values -### sigma: an 1 x K array, vector or matrix containing +### sigma: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- -".valid.Normal.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "univariate Normal mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$mu ) && !is.vector( obj@par$mu ) && - !is.matrix( obj@par$mu ) ) { - warning( paste( "Wrong specification of slot @par: ", - "mu must be either an array, a vector ", - "or a matrix of dimension 1 x K. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$mu ) ) || - is.integer( as.vector( obj@par$mu ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( length( obj@par$mu ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension 1 x K ", - "or a vector of size K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "univariate Normal mictures need ", - "a variance vector named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$sigma ) ) || - is.integer( as.vector( obj@par$sigma ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$sigma <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain variances, all ", - "positive.", sep = "" ), - .call = FALSE ) - } else if ( !is.array( obj@par$sigma ) && !is.matrix( obj@par$sigma ) && - !is.matrix( obj@par$sigma ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$sigma ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix, ", - "or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } +".valid.Normal.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "univariate Normal mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$mu) && !is.vector(obj@par$mu) && + !is.matrix(obj@par$mu)) { + warning(paste("Wrong specification of slot @par: ", + "mu must be either an array, a vector ", + "or a matrix of dimension 1 x K. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$mu)) || + is.integer(as.vector(obj@par$mu)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$mu) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension 1 x K ", + "or a vector of size K.", + sep = "" + ), + call. = FALSE + ) } + if (!"sigma" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "univariate Normal mictures need ", + "a variance vector named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$sigma)) || + is.integer(as.vector(obj@par$sigma)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$sigma <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain variances, all ", + "positive.", + sep = "" + ), + .call = FALSE + ) + } else if (!is.array(obj@par$sigma) && !is.matrix(obj@par$sigma) && + !is.matrix(obj@par$sigma)) { + warning(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$sigma) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix, ", + "or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + } } ### ---------------------------------------------------------------------------- ### .init.valid.Normult.Model -### @description Initial validity check for parameters of a multivariate +### @description Initial validity check for parameters of a multivariate ### Normal mixture. -### @par obj a model object +### @par obj a model object ### @return An error if parameters fail certain conditions ### @detail This initial validity check is called in the S4 constructor -### 'model()' and ensures that the user constructs an inherently +### 'model()' and ensures that the user constructs an inherently ### consistent model object. ### The parameter list must contain the foillowing elements: -### mu: an r x K matrix containing 'numeric' or -### 'integer' values -### sigma: am r x r x K array containing 'numeric' or +### mu: an r x K matrix containing 'numeric' or +### 'integer' values +### sigma: am r x r x K array containing 'numeric' or ### 'integer' matrices, all symmetric/positive -### definite +### definite ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".init.valid.Normult.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "multivariate Normal mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.matrix( obj@par$mu ) ) { - stop( paste( "Wrong specification of slot @par: ", - "mu is not a matrix. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( obj@par$mu ) || is.numeric( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$mu ), c( obj@r, obj@K ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension r x K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "multivariate Normal mixtures need ", - "a variance-covariance array named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !( is.numeric( obj@par$sigma ) || is.integer( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric' ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$sigma ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma is not an array.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, isSymmetric ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain K symmetric ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, function( x ) { all( eigen( x )$values > 0 ) } ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain K positive definite ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$sigma ), c( obj@r, obj@r, obj@K ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must be an array of dimension ", - "r x r x K.", sep = "" ), - call. = FALSE ) - } +".init.valid.Normult.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "multivariate Normal mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.matrix(obj@par$mu)) { + stop(paste("Wrong specification of slot @par: ", + "mu is not a matrix. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(obj@par$mu) || is.numeric(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$mu), c(obj@r, obj@K))) { + stop(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension r x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"sigma" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "multivariate Normal mixtures need ", + "a variance-covariance array named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!(is.numeric(obj@par$sigma) || is.integer(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric' ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$sigma)) { + stop(paste("Wrong specification of slot @par: ", + "sigma is not an array.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, isSymmetric))) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain K symmetric ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, function(x) { + all(eigen(x)$values > 0) + }))) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain K positive definite ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$sigma), c(obj@r, obj@r, obj@K))) { + stop(paste("Wrong specification of slot @par: ", + "sigma must be an array of dimension ", + "r x r x K.", + sep = "" + ), + call. = FALSE + ) } + } } ### ---------------------------------------------------------------------------- ### .valid.Normult.Model -### @description Initial validity check for parameters of a multivariate +### @description Initial validity check for parameters of a multivariate ### Normal mixture. -### @par obj a model object +### @par obj a model object ### @return An error if parameters fail necessary conditions and ### a warning if parameters fail consistency ### @detail This validity check is called in the setters to ensure that ### slots can be changed without errors but help the user to ### end up with an inherently consistent model object. ### The parameter list must contain the foillowing elements: -### mu: an r x K matrix containing 'numeric' or -### 'integer' values -### sigma: am r x r x K array containing 'numeric' or +### mu: an r x K matrix containing 'numeric' or +### 'integer' values +### sigma: am r x r x K array containing 'numeric' or ### 'integer' matrices, all symmetric/positive -### definite +### definite ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".valid.Normult.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "multivariate Normal mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.matrix( obj@par$mu ) ) { - warning( paste( "Wrong specification of slot @par: ", - "mu is not a matrix. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( obj@par$mu ) || is.numeric( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$mu ), c( obj@r, obj@K ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension r x K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "multivariate Normal mixtures need ", - "a variance-covariance array named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !( is.numeric( obj@par$sigma ) || is.integer( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric' ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$sigma ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma is not an array.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, isSymmetric ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must contain K symmetric ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, function( x ) { all( eigen( x )$values > 0 ) } ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must contain K positive definite ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$sigma ), c( obj@r, obj@r, obj@K ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must be an array of dimension ", - "r x r x K.", sep = "" ), - call. = FALSE ) - } +".valid.Normult.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "multivariate Normal mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.matrix(obj@par$mu)) { + warning(paste("Wrong specification of slot @par: ", + "mu is not a matrix. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(obj@par$mu) || is.numeric(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$mu), c(obj@r, obj@K))) { + warning(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension r x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"sigma" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "multivariate Normal mixtures need ", + "a variance-covariance array named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!(is.numeric(obj@par$sigma) || is.integer(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric' ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$sigma)) { + warning(paste("Wrong specification of slot @par: ", + "sigma is not an array.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, isSymmetric))) { + warning(paste("Wrong specification of slot @par: ", + "sigma must contain K symmetric ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, function(x) { + all(eigen(x)$values > 0) + }))) { + warning(paste("Wrong specification of slot @par: ", + "sigma must contain K positive definite ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$sigma), c(obj@r, obj@r, obj@K))) { + warning(paste("Wrong specification of slot @par: ", + "sigma must be an array of dimension ", + "r x r x K.", + sep = "" + ), + call. = FALSE + ) } + } } ### ------------------------------------------------------------------------------ ### .init.valid.Student.Model -### @description Initial validity check for parameters of a univariate -### Student-t mixture. -### @par obj a model object +### @description Initial validity check for parameters of a univariate +### Student-t mixture. +### @par obj a model object ### @return An error if parameters fail certain conditions ### @detail This initial validity check is called in the S4 constructor ### 'model()' and ensures that the user constructs an inherently ### consistent model object. ### The parameter list must contain the following elements: -### mu: an 1 x K array, vector or matrix containing +### mu: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values -### sigma: an 1 x K array, vector or matrix containing +### sigma: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### df: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- -".init.valid.Student.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "univariate Normal mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$mu ) && !is.vector( obj@par$mu ) && - !is.matrix( obj@par$mu ) ) { - stop( paste( "Wrong specification of slot @par: ", - "mu must be either an array, a vector ", - "or a matrix of dimension 1 x K. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$mu ) ) || - is.integer( as.vector( obj@par$mu ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( length( obj@par$mu ) != obj@K ) { - stop( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension 1 x K ", - "or a vector of size K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "univariate Normal mictures need ", - "a variance vector named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$sigma ) ) || - is.integer( as.vector( obj@par$sigma ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$sigma <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain variances, all ", - "positive.", sep = "" ), - .call = FALSE ) - } else if ( !is.array( obj@par$sigma ) && is.vector( obj@par$sigma ) && - is.matrix( obj@par$sigma ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$sigma ) != obj@K ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix, ", - "or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } - if ( !"df" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Student-t mixtures need a degree of ", - "freedom vector.", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$df ) ) || - is.integer( as.vector( obj@par$df ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$df <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Degrees of freedom must be all positive.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$df ) != obj@K ) { - stop( paste( "Wrong specification of slot @par: ", - "df must be a vector or matrix of ", - "dimension 1 x K", sep = "" ), - call. = FALSE ) - } +".init.valid.Student.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "univariate Normal mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$mu) && !is.vector(obj@par$mu) && + !is.matrix(obj@par$mu)) { + stop(paste("Wrong specification of slot @par: ", + "mu must be either an array, a vector ", + "or a matrix of dimension 1 x K. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$mu)) || + is.integer(as.vector(obj@par$mu)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$mu) != obj@K) { + stop(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension 1 x K ", + "or a vector of size K.", + sep = "" + ), + call. = FALSE + ) } + if (!"sigma" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "univariate Normal mictures need ", + "a variance vector named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$sigma)) || + is.integer(as.vector(obj@par$sigma)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$sigma <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain variances, all ", + "positive.", + sep = "" + ), + .call = FALSE + ) + } else if (!is.array(obj@par$sigma) && is.vector(obj@par$sigma) && + is.matrix(obj@par$sigma)) { + stop(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$sigma) != obj@K) { + stop(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix, ", + "or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"df" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "Student-t mixtures need a degree of ", + "freedom vector.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$df)) || + is.integer(as.vector(obj@par$df)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$df <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Degrees of freedom must be all positive.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$df) != obj@K) { + stop(paste("Wrong specification of slot @par: ", + "df must be a vector or matrix of ", + "dimension 1 x K", + sep = "" + ), + call. = FALSE + ) + } + } } ### ------------------------------------------------------------------------------ ### .valid.Student.Model -### @description Validity check for parameters of a univariate Student-t -### mixture. -### @par obj a model object +### @description Validity check for parameters of a univariate Student-t +### mixture. +### @par obj a model object ### @return An error if parameters fail certain necessary conditions and ### a warning if parameters fail consistency. ### @detail This validity check is called in the setters to ensure that -### slots can be changed without errors but help the user to +### slots can be changed without errors but help the user to ### end up with an inherently consistent model object. ### The parameter list must contain the following elements: -### mu: an 1 x K array, vector or matrix containing +### mu: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values -### sigma: an 1 x K array, vector or matrix containing +### sigma: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### df: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- -".valid.Student.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "univariate Normal mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$mu ) && !is.vector( obj@par$mu ) && - !is.matrix( obj@par$mu ) ) { - warning( paste( "Wrong specification of slot @par: ", - "mu must be either an array, a vector ", - "or a matrix of dimension 1 x K. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$mu ) ) || - is.integer( as.vector( obj@par$mu ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( length( obj@par$mu ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension 1 x K ", - "or a vector of size K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "univariate Normal mictures need ", - "a variance vector named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$sigma ) ) || - is.integer( as.vector( obj@par$sigma ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$sigma <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain variances, all ", - "positive.", sep = "" ), - .call = FALSE ) - } else if ( is.array( obj@par$sigma ) && is.vector( obj@par$sigma ) && - is.matrix( obj@par$sigma ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix of dimension 1 x K.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$sigma ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must be either an array, a vector, ", - "or a matrix, ", - "or a matrix of dimension ", - "1 x K.", sep = "" ), - call. = FALSE ) - } - if ( !"df" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "Student-t mixtures need a degree of ", - "freedom vector.", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$df ) ) || - is.integer( as.vector( obj@par$df ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$df <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Degrees of freedom must be all positive.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$df ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "df must be a vector or matrix of ", - "dimension 1 x K", sep = "" ), - call. = FALSE ) - } +".valid.Student.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "univariate Normal mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$mu) && !is.vector(obj@par$mu) && + !is.matrix(obj@par$mu)) { + warning(paste("Wrong specification of slot @par: ", + "mu must be either an array, a vector ", + "or a matrix of dimension 1 x K. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$mu)) || + is.integer(as.vector(obj@par$mu)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$mu) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension 1 x K ", + "or a vector of size K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"sigma" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "univariate Normal mictures need ", + "a variance vector named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$sigma)) || + is.integer(as.vector(obj@par$sigma)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$sigma <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain variances, all ", + "positive.", + sep = "" + ), + .call = FALSE + ) + } else if (is.array(obj@par$sigma) && is.vector(obj@par$sigma) && + is.matrix(obj@par$sigma)) { + warning(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix of dimension 1 x K.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$sigma) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "sigma must be either an array, a vector, ", + "or a matrix, ", + "or a matrix of dimension ", + "1 x K.", + sep = "" + ), + call. = FALSE + ) } + if (!"df" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "Student-t mixtures need a degree of ", + "freedom vector.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$df)) || + is.integer(as.vector(obj@par$df)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$df <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Degrees of freedom must be all positive.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$df) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "df must be a vector or matrix of ", + "dimension 1 x K", + sep = "" + ), + call. = FALSE + ) + } + } } ### ---------------------------------------------------------------------------- ### .init.valid.Studmult.Model -### @description Initial validity check for parameters of a multivariate +### @description Initial validity check for parameters of a multivariate ### Student-t mixture. -### @par obj a model object +### @par obj a model object ### @return An error if parameters fail certain conditions ### @detail This initial validity check is called in the S4 constructor -### 'model()' and ensures that the user constructs an inherently +### 'model()' and ensures that the user constructs an inherently ### consistent model object. ### The parameter list must contain the foillowing elements: -### mu: an r x K matrix containing 'numeric' or -### 'integer' values -### sigma: an r x r x K array containing 'numeric' or +### mu: an r x K matrix containing 'numeric' or +### 'integer' values +### sigma: an r x r x K array containing 'numeric' or ### 'integer' matrices, all symmetric/positive -### definite -### df: an 1 x K array, vector or matrix containing +### definite +### df: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer', all positive ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".init.valid.Studmult.Model" <- function( obj ) -{ - if ( length( obj@par) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "multivariate Student-t mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.matrix( obj@par$mu ) ) { - stop( paste( "Wrong specification of slot @par: ", - "mu is not a matrix. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( obj@par$mu ) || is.numeric( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$mu ), c( obj@r, obj@K ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension r x K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - stop( paste( "Wrong specification of slot @par: ", - "multivariate Student-t mictures need ", - "a variance-covariance array named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !( is.numeric( obj@par$sigma ) || is.integer( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric' ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$sigma ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma is not an array.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, isSymmetric ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain K symmetric ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, function( x ) { all( eigen( x )$values > 0 ) } ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must contain K positive definite ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$sigma ), c( obj@r, obj@r, obj@K ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "sigma must be an array of dimension ", - "r x r x K.", sep = "" ), - call. = FALSE ) - } - if ( !"df" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "Student-t mixtures need a degree of ", - "freedom vector.", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$df ) ) || - is.integer( as.vector( obj@par$df ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$df <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Degrees of freedom must be all positive.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$df ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "df must be a vector or matrix of ", - "dimension 1 x K", sep = "" ), - call. = FALSE ) - } +".init.valid.Studmult.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "multivariate Student-t mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.matrix(obj@par$mu)) { + stop(paste("Wrong specification of slot @par: ", + "mu is not a matrix. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(obj@par$mu) || is.numeric(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$mu), c(obj@r, obj@K))) { + stop(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension r x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"sigma" %in% names(obj@par)) { + stop(paste("Wrong specification of slot @par: ", + "multivariate Student-t mictures need ", + "a variance-covariance array named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!(is.numeric(obj@par$sigma) || is.integer(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric' ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$sigma)) { + stop(paste("Wrong specification of slot @par: ", + "sigma is not an array.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, isSymmetric))) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain K symmetric ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, function(x) { + all(eigen(x)$values > 0) + }))) { + stop(paste("Wrong specification of slot @par: ", + "sigma must contain K positive definite ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$sigma), c(obj@r, obj@r, obj@K))) { + stop(paste("Wrong specification of slot @par: ", + "sigma must be an array of dimension ", + "r x r x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"df" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "Student-t mixtures need a degree of ", + "freedom vector.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$df)) || + is.integer(as.vector(obj@par$df)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$df <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Degrees of freedom must be all positive.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$df) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "df must be a vector or matrix of ", + "dimension 1 x K", + sep = "" + ), + call. = FALSE + ) } + } } ### ---------------------------------------------------------------------------- ### .valid.Studmult.Model -### @description Initial validity check for parameters of a multivariate +### @description Initial validity check for parameters of a multivariate ### Student-t mixture. -### @par obj a model object +### @par obj a model object ### @return An error if parameters fail necessary conditions and ### a warning if parameters fail consistency ### @detail This validity check is called in the setters to ensure that ### slots can be changed without errors but help the user to ### end up with an inherently consistent model object. ### The parameter list must contain the foillowing elements: -### mu: an r x K matrix containing 'numeric' or -### 'integer' values -### sigma: am r x r x K array containing 'numeric' or +### mu: an r x K matrix containing 'numeric' or +### 'integer' values +### sigma: am r x r x K array containing 'numeric' or ### 'integer' matrices, all symmetric/positive -### definite -### df: an 1 x K array, vector or matrix containing +### definite +### df: an 1 x K array, vector or matrix containing ### 'numeric' or 'integer' values, all positive ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- -".valid.Studmult.Model" <- function( obj ) -{ - if ( length( obj@par ) > 0 ) { - if ( !"mu" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "multivariate Student-t mixtures need ", - "a mean matrix named 'mu'.", sep = "" ), - call. = FALSE ) - } else if ( !is.matrix( obj@par$mu ) ) { - warning( paste( "Wrong specification of slot @par: ", - "mu is not a matrix. ", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( obj@par$mu ) || is.numeric( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$mu ), c( obj@r, obj@K ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "mu must be a matrix of dimension r x K.", sep = "" ), - call. = FALSE ) - } - if ( !"sigma" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "multivariate Student-t mictures need ", - "a variance-covariance array named ", - "'sigma'", sep = "" ), - call. = FALSE ) - } else if ( !( is.numeric( obj@par$sigma ) || is.integer( obj@par$mu ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "parameters must be of type 'numeric' ", - "or 'integer'.", sep = "" ), - call. = FALSE ) - } else if ( !is.array( obj@par$sigma ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma is not an array.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, isSymmetric ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must contain K symmetric ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !all( apply( obj@par$sigma, 3, function( x ) { all( eigen( x )$values > 0 ) } ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must contain K positive definite ", - "r x r matrices.", sep = "" ), - call. = FALSE ) - } else if ( !identical( dim( obj@par$sigma ), c( obj@r, obj@r, obj@K ) ) ) { - warning( paste( "Wrong specification of slot @par: ", - "sigma must be an array of dimension ", - "r x r x K.", sep = "" ), - call. = FALSE ) - } - if ( !"df" %in% names( obj@par ) ) { - warning( paste( "Wrong specification of slot @par: ", - "Student-t mixtures need a degree of ", - "freedom vector.", sep = "" ), - call. = FALSE ) - } else if ( !all( is.numeric( as.vector( obj@par$df ) ) || - is.integer( as.vector( obj@par$df ) ) ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Parameters must be of type 'numeric' or ", - "'integer'.", sep = ""), - call. = FALSE ) - } else if ( any( obj@par$df <= 0 ) ) { - stop( paste( "Wrong specification of slot @par: ", - "Degrees of freedom must be all positive.", sep = "" ), - call. = FALSE ) - } else if ( length( obj@par$df ) != obj@K ) { - warning( paste( "Wrong specification of slot @par: ", - "df must be a vector or matrix of ", - "dimension 1 x K", sep = "" ), - call. = FALSE ) - } +".valid.Studmult.Model" <- function(obj) { + if (length(obj@par) > 0) { + if (!"mu" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "multivariate Student-t mixtures need ", + "a mean matrix named 'mu'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.matrix(obj@par$mu)) { + warning(paste("Wrong specification of slot @par: ", + "mu is not a matrix. ", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(obj@par$mu) || is.numeric(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$mu), c(obj@r, obj@K))) { + warning(paste("Wrong specification of slot @par: ", + "mu must be a matrix of dimension r x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"sigma" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "multivariate Student-t mictures need ", + "a variance-covariance array named ", + "'sigma'", + sep = "" + ), + call. = FALSE + ) + } else if (!(is.numeric(obj@par$sigma) || is.integer(obj@par$mu))) { + stop(paste("Wrong specification of slot @par: ", + "parameters must be of type 'numeric' ", + "or 'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (!is.array(obj@par$sigma)) { + warning(paste("Wrong specification of slot @par: ", + "sigma is not an array.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, isSymmetric))) { + warning(paste("Wrong specification of slot @par: ", + "sigma must contain K symmetric ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(apply(obj@par$sigma, 3, function(x) { + all(eigen(x)$values > 0) + }))) { + warning(paste("Wrong specification of slot @par: ", + "sigma must contain K positive definite ", + "r x r matrices.", + sep = "" + ), + call. = FALSE + ) + } else if (!identical(dim(obj@par$sigma), c(obj@r, obj@r, obj@K))) { + warning(paste("Wrong specification of slot @par: ", + "sigma must be an array of dimension ", + "r x r x K.", + sep = "" + ), + call. = FALSE + ) + } + if (!"df" %in% names(obj@par)) { + warning(paste("Wrong specification of slot @par: ", + "Student-t mixtures need a degree of ", + "freedom vector.", + sep = "" + ), + call. = FALSE + ) + } else if (!all(is.numeric(as.vector(obj@par$df)) || + is.integer(as.vector(obj@par$df)))) { + stop(paste("Wrong specification of slot @par: ", + "Parameters must be of type 'numeric' or ", + "'integer'.", + sep = "" + ), + call. = FALSE + ) + } else if (any(obj@par$df <= 0)) { + stop(paste("Wrong specification of slot @par: ", + "Degrees of freedom must be all positive.", + sep = "" + ), + call. = FALSE + ) + } else if (length(obj@par$df) != obj@K) { + warning(paste("Wrong specification of slot @par: ", + "df must be a vector or matrix of ", + "dimension 1 x K", + sep = "" + ), + call. = FALSE + ) } + } } ### Additional functions -".get.univ.Model" <- function() -{ - univ <- c("poisson", "cond.poisson", - "binomial", "exponential", - "normal", "student") - return(univ) +".get.univ.Model" <- function() { + univ <- c( + "poisson", "cond.poisson", + "binomial", "exponential", + "normal", "student" + ) + return(univ) } -".get.multiv.Model" <- function() -{ - multiv <- c("normult", "studmult") - return(multiv) +".get.multiv.Model" <- function() { + multiv <- c("normult", "studmult") + return(multiv) } diff --git a/R/modelmoments.R b/R/modelmoments.R index a4d0008..0a34c30 100644 --- a/R/modelmoments.R +++ b/R/modelmoments.R @@ -16,57 +16,61 @@ # along with finmix. If not, see . setClass("modelmoments", - representation(mean = "vector", - var = "array", - model = "model" - ), - validity = function(object) { - ## else: OK - TRUE - }, - prototype( - mean = vector(), - var = array(), - model = model() - ) + representation( + mean = "vector", + var = "array", + model = "model" + ), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + mean = vector(), + var = array(), + model = model() + ) ) "modelmoments" <- function(model) { - dist <- model@dist - if (dist == "normult") { - .normultmodelmoments(model = model) - } else if (dist == "studmult") { - .studmultmodelmoments(model = model) - } else if (dist == "student") { - .studentmodelmoments(model = model) - } else if (dist == "normal") { - .normalmodelmoments(model = model) - } else if (dist == "exponential") { - .exponentialmodelmoments(model = model) - } else if (dist %in% c("poisson", "cond.poisson")) { - .poissonmodelmoments(model = model) - } else if (dist == "binomial") { - .binomialmodelmoments(model = model) - } + dist <- model@dist + if (dist == "normult") { + .normultmodelmoments(model = model) + } else if (dist == "studmult") { + .studmultmodelmoments(model = model) + } else if (dist == "student") { + .studentmodelmoments(model = model) + } else if (dist == "normal") { + .normalmodelmoments(model = model) + } else if (dist == "exponential") { + .exponentialmodelmoments(model = model) + } else if (dist %in% c("poisson", "cond.poisson")) { + .poissonmodelmoments(model = model) + } else if (dist == "binomial") { + .binomialmodelmoments(model = model) + } } ## Getters ## -setMethod("getMean", "modelmoments", - function(object) { - return(object@mean) - } +setMethod( + "getMean", "modelmoments", + function(object) { + return(object@mean) + } ) -setMethod("getVar", "modelmoments", - function(object) { - return(object@var) - } +setMethod( + "getVar", "modelmoments", + function(object) { + return(object@var) + } ) -setMethod("getModel", "modelmoments", - function(object) { - return(object@model) - } +setMethod( + "getModel", "modelmoments", + function(object) { + return(object@model) + } ) ## Setters are not provided as users are not intended to manipulate ## diff --git a/R/normalmodelmoments.R b/R/normalmodelmoments.R index eed80a6..27adf18 100644 --- a/R/normalmodelmoments.R +++ b/R/normalmodelmoments.R @@ -15,77 +15,94 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.normalmodelmoments <- setClass("normalmodelmoments", - representation(B = "numeric", - W = "numeric", - R = "numeric"), - contains = c("cmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype(B = numeric(), - W = numeric(), - R = numeric() - ) +.normalmodelmoments <- setClass("normalmodelmoments", + representation( + B = "numeric", + W = "numeric", + R = "numeric" + ), + contains = c("cmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + B = numeric(), + W = numeric(), + R = numeric() + ) ) -setMethod("initialize", "normalmodelmoments", - function(.Object, ..., model) { - .Object <- callNextMethod(.Object, ..., model = model) - .Object <- generateMoments(.Object) - return(.Object) - } +setMethod( + "initialize", "normalmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + .Object <- generateMoments(.Object) + return(.Object) + } ) -setMethod("generateMoments", "normalmodelmoments", - function(object) - { - .generateMomentsNormal(object) - } +setMethod( + "generateMoments", "normalmodelmoments", + function(object) { + .generateMomentsNormal(object) + } ) -setMethod("show", "normalmodelmoments", - function(object) { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" higher :", - paste(dim(object@higher), collapse = "x"), "\n") - cat(" skewness : Vector of", - length(object@skewness), "\n") - cat(" kurtosis : Vector of", - length(object@kurtosis), "\n") - cat(" B :", object@B, "\n") - cat(" W :", object@W, "\n") - cat(" R :", object@R, "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "normalmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " higher :", + paste(dim(object@higher), collapse = "x"), "\n" + ) + cat( + " skewness : Vector of", + length(object@skewness), "\n" + ) + cat( + " kurtosis : Vector of", + length(object@kurtosis), "\n" + ) + cat(" B :", object@B, "\n") + cat(" W :", object@W, "\n") + cat(" R :", object@R, "\n") + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) ## Getters ## -setMethod("getB", "normalmodelmoments", - function(object) - { - return(object@B) - } +setMethod( + "getB", "normalmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getW", "normalmodelmoments", - function(object) - { - return(object@W) - } +setMethod( + "getW", "normalmodelmoments", + function(object) { + return(object@W) + } ) -setMethod("getR", "normalmodelmoments", - function(object) - { - return(object@R) - } +setMethod( + "getR", "normalmodelmoments", + function(object) { + return(object@R) + } ) ## No setters as users are not intended to manipulate ## @@ -93,21 +110,24 @@ setMethod("getR", "normalmodelmoments", ### Private functions ### This functions are not exported -".generateMomentsNormal" <- function(object) -{ - mu <- object@model@par$mu - sigma <- object@model@par$sigma - weight <- object@model@weight - object@mean <- sum(weight * mu) - object@higher <- .mixturemoments.normal(object@model, - 4, object@mean) - dimnames(object@higher) <- list(c("1st", "2nd", - "3rd", "4th"), "") - object@var <- array(object@higher[2], dim = c(1, 1)) - object@skewness <- object@higher[3]/object@higher[2]^1.5 - object@kurtosis <- object@higher[4]/object@higher[2]^2 - object@B <- sum(weight * (mu - object@mean)^2) - object@W <- sum(weight * sigma) - object@R <- 1 - object@W/object@var[1] - return(object) +".generateMomentsNormal" <- function(object) { + mu <- object@model@par$mu + sigma <- object@model@par$sigma + weight <- object@model@weight + object@mean <- sum(weight * mu) + object@higher <- .mixturemoments.normal( + object@model, + 4, object@mean + ) + dimnames(object@higher) <- list(c( + "1st", "2nd", + "3rd", "4th" + ), "") + object@var <- array(object@higher[2], dim = c(1, 1)) + object@skewness <- object@higher[3] / object@higher[2]^1.5 + object@kurtosis <- object@higher[4] / object@higher[2]^2 + object@B <- sum(weight * (mu - object@mean)^2) + object@W <- sum(weight * sigma) + object@R <- 1 - object@W / object@var[1] + return(object) } diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index 0b9a54d..0cd29e2 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -16,145 +16,182 @@ # along with finmix. If not, see . .normultmodelmoments <- setClass("normultmodelmoments", - representation(B = "array", - W = "array", - Rdet= "numeric", - Rtr = "numeric", - corr= "array"), - contains = c("cmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype( - B = array(), - W = array(), - Rdet = numeric(), - Rtr = numeric(), - corr = array() - ) + representation( + B = "array", + W = "array", + Rdet = "numeric", + Rtr = "numeric", + corr = "array" + ), + contains = c("cmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + B = array(), + W = array(), + Rdet = numeric(), + Rtr = numeric(), + corr = array() + ) ) -setMethod("initialize", "normultmodelmoments", - function(.Object, ..., model) { - .Object <- callNextMethod(.Object,..., model = model) - generateMoments(.Object) - } +setMethod( + "initialize", "normultmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + generateMoments(.Object) + } ) -setMethod("generateMoments", "normultmodelmoments", - function(object) { - .generateMomentsNormult(object) - } +setMethod( + "generateMoments", "normultmodelmoments", + function(object) { + .generateMomentsNormult(object) + } ) -setMethod("show", "normultmodelmoments", - function(object) { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), - "\n") - cat(" higher :", - paste(dim(object@higher), collapse = "x"), - "\n") - cat(" skewness : Vector of", - length(object@skewness), "\n") - cat(" kurtosis : Vector of", - length(object@kurtosis), "\n") - cat(" B :", - paste(dim(object@B), collapse = "x"), "\n") - cat(" W :", - paste(dim(object@W), collapse = "x"), "\n") - cat(" Rdet :", object@Rdet, "\n") - cat(" Rtr :", object@Rtr, "\n") - cat(" corr :", - paste(dim(object@corr), collapse = "x"), - "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "normultmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), + "\n" + ) + cat( + " higher :", + paste(dim(object@higher), collapse = "x"), + "\n" + ) + cat( + " skewness : Vector of", + length(object@skewness), "\n" + ) + cat( + " kurtosis : Vector of", + length(object@kurtosis), "\n" + ) + cat( + " B :", + paste(dim(object@B), collapse = "x"), "\n" + ) + cat( + " W :", + paste(dim(object@W), collapse = "x"), "\n" + ) + cat(" Rdet :", object@Rdet, "\n") + cat(" Rtr :", object@Rtr, "\n") + cat( + " corr :", + paste(dim(object@corr), collapse = "x"), + "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) ## Getters ## -setMethod("getB", "normultmodelmoments", - function(object) { - return(object@B) - } +setMethod( + "getB", "normultmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getW", "normultmodelmoments", - function(object) { - return(object@W) - } +setMethod( + "getW", "normultmodelmoments", + function(object) { + return(object@W) + } ) -setMethod("getRdet", "normultmodelmoments", - function(object) { - return(object@B) - } +setMethod( + "getRdet", "normultmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getRtr", "normultmodelmoments", - function(object) { - return(object@B) - } +setMethod( + "getRtr", "normultmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getCorr", "normultmodelmoments", - function(object) { - return(object@corr) - } +setMethod( + "getCorr", "normultmodelmoments", + function(object) { + return(object@corr) + } ) ## No setters as users are not intended to manipulate ## ## this object ## -### private functions -### these function are not exported +### private functions +### these function are not exported ".generateMomentsNormult" <- function(object) { - mu <- object@model@par$mu - sigma <- object@model@par$sigma - weight <- object@model@weight - names <- rep("", object@model@r) - for (i in seq(1, object@model@r)) { - names[i] <- paste("r=", i, sep = "") - } - object@mean <- apply(apply(mu, 1, '*', weight), - 2, sum, na.rm = TRUE) - object@W <- apply(sweep(sigma, MARGIN = 1, weight, '*'), - c(1,2), sum, na.rm = TRUE) - object@var <- object@W + apply(apply(mu, 2, tcrossprod, mu) - , 1, '*', weight) - object@var <- object@var - object@mean %*% t(object@mean) - diffm <- mu - object@mean - object@B <- apply(apply(diffm, 1, tcrossprod, diffm), - 1, '*', weight) - cd <- diag(1/diag(object@var)^.5) - object@corr <- cd %*% object@var %*% cd - object@Rtr <- 1 - sum(diag(object@W))/sum(diag(object@var)) - object@Rdet <- 1 - det(object@W)/det(object@var) - highm <- array(0, dim = c(4, object@model@r)) - for(i in seq(1, object@model@r)) { - marmodel <- mixturemar(object@model, i) - highm[, i] <- t(.mixturemoments.normal(marmodel, - 4, - object@mean[i])) - } - names(object@mean) <- names - colnames(object@var) <- names - rownames(object@var) <- names - colnames(object@B) <- names - rownames(object@B) <- names - colnames(object@W) <- names - rownames(object@W) <- names - colnames(object@corr) <- names - rownames(object@corr) <- names - object@higher <- highm - dimnames(object@higher) <- list(c("1st", "2nd", "3rd", "4th"), names) - object@skewness <- object@higher[3, ]/object@higher[2,]^1.5 - object@kurtosis <- object@higher[4, ]/object@higher[2,]^2 - return(object) + mu <- object@model@par$mu + sigma <- object@model@par$sigma + weight <- object@model@weight + names <- rep("", object@model@r) + for (i in seq(1, object@model@r)) { + names[i] <- paste("r=", i, sep = "") + } + object@mean <- apply(apply(mu, 1, "*", weight), + 2, sum, + na.rm = TRUE + ) + object@W <- apply(sweep(sigma, MARGIN = 1, weight, "*"), + c(1, 2), sum, + na.rm = TRUE + ) + object@var <- object@W + apply( + apply(mu, 2, tcrossprod, mu), + 1, "*", weight + ) + object@var <- object@var - object@mean %*% t(object@mean) + diffm <- mu - object@mean + object@B <- apply( + apply(diffm, 1, tcrossprod, diffm), + 1, "*", weight + ) + cd <- diag(1 / diag(object@var)^.5) + object@corr <- cd %*% object@var %*% cd + object@Rtr <- 1 - sum(diag(object@W)) / sum(diag(object@var)) + object@Rdet <- 1 - det(object@W) / det(object@var) + highm <- array(0, dim = c(4, object@model@r)) + for (i in seq(1, object@model@r)) { + marmodel <- mixturemar(object@model, i) + highm[, i] <- t(.mixturemoments.normal( + marmodel, + 4, + object@mean[i] + )) + } + names(object@mean) <- names + colnames(object@var) <- names + rownames(object@var) <- names + colnames(object@B) <- names + rownames(object@B) <- names + colnames(object@W) <- names + rownames(object@W) <- names + colnames(object@corr) <- names + rownames(object@corr) <- names + object@higher <- highm + dimnames(object@higher) <- list(c("1st", "2nd", "3rd", "4th"), names) + object@skewness <- object@higher[3, ] / object@higher[2, ]^1.5 + object@kurtosis <- object@higher[4, ] / object@higher[2, ]^2 + return(object) } - diff --git a/R/poissonmodelmoments.R b/R/poissonmodelmoments.R index 1a287b2..a1420ce 100644 --- a/R/poissonmodelmoments.R +++ b/R/poissonmodelmoments.R @@ -16,82 +16,89 @@ # along with finmix. If not, see . .poissonmodelmoments <- setClass("poissonmodelmoments", - contains = c("dmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - } + contains = c("dmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + } ) -setMethod("initialize", "poissonmodelmoments", - function(.Object, ..., model) - { - .Object <- callNextMethod(.Object, ..., model = model) - generateMoments(.Object) - } +setMethod( + "initialize", "poissonmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + generateMoments(.Object) + } ) -setMethod("generateMoments", "poissonmodelmoments", - function(object) - { - .generateMomentsPoisson(object) - } +setMethod( + "generateMoments", "poissonmodelmoments", + function(object) { + .generateMomentsPoisson(object) + } ) -setMethod("show", "poissonmodelmoments", - function(object) { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" factorial :", - paste(dim(object@factorial), collapse = "x"), - "\n") - cat(" over :", object@over, "\n") - cat(" zero :", object@zero, "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "poissonmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " factorial :", + paste(dim(object@factorial), collapse = "x"), + "\n" + ) + cat(" over :", object@over, "\n") + cat(" zero :", object@zero, "\n") + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) -## No Setters as users are not intended to manipulate +## No Setters as users are not intended to manipulate ## this object ## ### Private functions -### These functions are not exported -".generateMomentsPoisson" <- function(object) -{ - hasPar(object@model, verbose = TRUE) - K <- object@model@K - lambda <- object@model@par$lambda - fact.names <- list(c("1st", "2nd", "3rd", "4th"), "") - if (K == 1) { - object@mean <- lambda - object@var <- as.matrix(lambda) - object@over <- 0 - factm <- array(NA, dim = c(4, 1)) - for (i in seq(1, 4)) { - factm[i] <- lambda^i - } - dimnames(factm) <- fact.names - object@factorial <- factm - object@zero <- exp((-1) * lambda) - } else { - hasWeight(object@model, verbose = TRUE) - weight <- object@model@weight - object@mean <- sum(weight * lambda) - object@var <- array(sum(weight * lambda * (lambda + 1)) - - object@mean^2, dim = c(1, 1)) - object@over <- object@var[1] - object@mean - factm <- array(NA, dim = c(4, 1)) - for (i in seq(1, 4)) { - factm[i] <- sum(weight * lambda^i) - } - dimnames(factm) <- fact.names - object@factorial <- factm - object@zero <- sum(weight * exp((-1) * lambda)) +### These functions are not exported +".generateMomentsPoisson" <- function(object) { + hasPar(object@model, verbose = TRUE) + K <- object@model@K + lambda <- object@model@par$lambda + fact.names <- list(c("1st", "2nd", "3rd", "4th"), "") + if (K == 1) { + object@mean <- lambda + object@var <- as.matrix(lambda) + object@over <- 0 + factm <- array(NA, dim = c(4, 1)) + for (i in seq(1, 4)) { + factm[i] <- lambda^i } - return(object) + dimnames(factm) <- fact.names + object@factorial <- factm + object@zero <- exp((-1) * lambda) + } else { + hasWeight(object@model, verbose = TRUE) + weight <- object@model@weight + object@mean <- sum(weight * lambda) + object@var <- array(sum(weight * lambda * (lambda + 1)) + - object@mean^2, dim = c(1, 1)) + object@over <- object@var[1] - object@mean + factm <- array(NA, dim = c(4, 1)) + for (i in seq(1, 4)) { + factm[i] <- sum(weight * lambda^i) + } + dimnames(factm) <- fact.names + object@factorial <- factm + object@zero <- sum(weight * exp((-1) * lambda)) + } + return(object) } - diff --git a/R/prior.R b/R/prior.R index 86135ca..778b9ce 100644 --- a/R/prior.R +++ b/R/prior.R @@ -18,35 +18,36 @@ ### ================================================================ ### The prior class ### ---------------------------------------------------------------- -.prior <- setClass( "prior", - representation( weight = "matrix", - par = "list", - type = "character", - hier = "logical" - ), - validity = function( object ) - { - .valid.type.Prior( object ) - ## else: OK - TRUE - }, - prototype( weight = matrix(), - par = list(), - type = character(), - hier = logical() - ) +.prior <- setClass("prior", + representation( + weight = "matrix", + par = "list", + type = "character", + hier = "logical" + ), + validity = function(object) { + .valid.type.Prior(object) + ## else: OK + TRUE + }, + prototype( + weight = matrix(), + par = list(), + type = character(), + hier = logical() + ) ) ### ---------------------------------------------------------------- -### Constructors +### Constructors ### ---------------------------------------------------------------- ### ---------------------------------------------------------------- ### prior ### @description Default constructor. -### @par weight an R 'matrix' object containing the prior weights +### @par weight an R 'matrix' object containing the prior weights ### @par par an R list object containing the hyper parameters -### @par type an R 'character' object defining the type of the +### @par type an R 'character' object defining the type of the ### prior; possible type are either "independent" or ### "condconjugate" ### @par hier an R 'logical' object indicating if a hierarchical @@ -55,17 +56,18 @@ ### @see ?prior ### @author Lars SImon Zehnder ### ----------------------------------------------------------------- -"prior" <- function( weight = matrix(), par = list(), - type = c( "independent", "condconjugate" ), - hier = TRUE ) -{ - type <- match.arg( type ) - .prior( weight = weight, par = par, - type = type, hier = hier ) +"prior" <- function(weight = matrix(), par = list(), + type = c("independent", "condconjugate"), + hier = TRUE) { + type <- match.arg(type) + .prior( + weight = weight, par = par, + type = type, hier = hier + ) } ### ----------------------------------------------------------------- ### priordefine -### @description Advanced constructor. Constructs an object from +### @description Advanced constructor. Constructs an object from ### input parameters. Constructed prior has data- ### dependent hyper parameters. ### @par fdata an S4 object of class 'fdata' @@ -76,67 +78,74 @@ ### @see ?fdata, ?model, ?priordefine ### @author Lars Simon Zehnder ### ----------------------------------------------------------------- -"priordefine" <- function( fdata = fdata(), model = model(), - varargin = NULL, prior.wagner = TRUE, s = 5.0 ) -{ - .check.fdata.model.Prior( fdata, model ) - if ( !is.null( varargin ) ) { - .check.varargin.Prior( varargin ) - } - object <- .prior( hier = TRUE, type = "independent" ) - generatePrior( object, fdata = fdata, model = model, - varargin = varargin, prior.wagner = prior.wagner, s ) +"priordefine" <- function(fdata = fdata(), model = model(), + varargin = NULL, prior.wagner = TRUE, s = 5.0) { + .check.fdata.model.Prior(fdata, model) + if (!is.null(varargin)) { + .check.varargin.Prior(varargin) + } + object <- .prior(hier = TRUE, type = "independent") + generatePrior(object, + fdata = fdata, model = model, + varargin = varargin, prior.wagner = prior.wagner, s + ) } ### ================================================================== ### Has methods ### ------------------------------------------------------------------ -setMethod( "hasPriorPar", signature( object = "prior", - model = "model", - verbose = "ANY" ), - function( object, model, verbose = FALSE ) - { - .haspar.Prior( object, model, verbose ) - } +setMethod( + "hasPriorPar", signature( + object = "prior", + model = "model", + verbose = "ANY" + ), + function(object, model, verbose = FALSE) { + .haspar.Prior(object, model, verbose) + } ) -setMethod( "hasPriorWeight", signature( object = "prior", - model = "model", - verbose = "ANY" ), - function( object, model, verbose = FALSE ) - { - if ( !all( is.na( object@weight ) ) ) { - if ( ncol( object@weight ) == model@K ) { - return( TRUE ) - } else { - if ( verbose ) { - stop( paste( "Wrong dimension of ", - "slot 'weight' of ", - "'prior' object. " , - "Weights must be of ", - "dimension 1 x K.", - sep = "" ) ) - } else { - return( FALSE ) - } - } - } else { - if ( verbose ) { - stop( paste( "Slot 'weight' of 'prior' ", - "object is empty.", - sep = "" ) ) - } else { - return( FALSE ) - } - } - } +setMethod( + "hasPriorWeight", signature( + object = "prior", + model = "model", + verbose = "ANY" + ), + function(object, model, verbose = FALSE) { + if (!all(is.na(object@weight))) { + if (ncol(object@weight) == model@K) { + return(TRUE) + } else { + if (verbose) { + stop(paste("Wrong dimension of ", + "slot 'weight' of ", + "'prior' object. ", + "Weights must be of ", + "dimension 1 x K.", + sep = "" + )) + } else { + return(FALSE) + } + } + } else { + if (verbose) { + stop(paste("Slot 'weight' of 'prior' ", + "object is empty.", + sep = "" + )) + } else { + return(FALSE) + } + } + } ) ### ----------------------------------------------------------------------- ### generaterPrior ### @description Generates an object of class 'prior' from input ### parameters, i.e. it fills all slots with appropriate -### values. The object itself is constructed before this +### values. The object itself is constructed before this ### method is called. ### @par obj an S4 object of class 'prior' ### @par fdata an S4 object of class 'fdata' @@ -147,117 +156,130 @@ setMethod( "hasPriorWeight", signature( object = "prior", ### @see .generatePrior ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------- -setMethod( "generatePrior", "prior", - function( object, fdata, model, varargin, prior.wagner, s ) - { - dist <- model@dist - if ( dist == "poisson" ) { - object <- .generatePriorPoisson( object, fdata, model, - varargin = varargin ) - } else if ( dist == "cond.poisson") { - object <- .generatePriorCondPoisson( object, fdata, model, - s ) - } else if ( dist == "binomial") { - object <- .generatePriorBinomial(object, model) - } else if ( dist == "exponential") { - object <- .generatePriorExponential( object, fdata, model, - varargin = varargin, - prior.wagner ) - } else { - object <- .generatePriorNorstud( object, fdata, model, - varargin = varargin ) - if ( dist == "student" || dist == "studmult" ) { - object <- .generateDfPrior( object ) - warning( paste( "A 'prior' object for a Student-t model ", - "needs a tuning vector named 'mhtune' ", - "to be added by the user to slot @par$df ", - "of the 'prior' object.", sep = "" ), - call. = FALSE ) - } - } - .generatePriorWeight( object, model ) - } +setMethod( + "generatePrior", "prior", + function(object, fdata, model, varargin, prior.wagner, s) { + dist <- model@dist + if (dist == "poisson") { + object <- .generatePriorPoisson(object, fdata, model, + varargin = varargin + ) + } else if (dist == "cond.poisson") { + object <- .generatePriorCondPoisson( + object, fdata, model, + s + ) + } else if (dist == "binomial") { + object <- .generatePriorBinomial(object, model) + } else if (dist == "exponential") { + object <- .generatePriorExponential(object, fdata, model, + varargin = varargin, + prior.wagner + ) + } else { + object <- .generatePriorNorstud(object, fdata, model, + varargin = varargin + ) + if (dist == "student" || dist == "studmult") { + object <- .generateDfPrior(object) + warning(paste("A 'prior' object for a Student-t model ", + "needs a tuning vector named 'mhtune' ", + "to be added by the user to slot @par$df ", + "of the 'prior' object.", + sep = "" + ), + call. = FALSE + ) + } + } + .generatePriorWeight(object, model) + } ) -setMethod( "show", "prior", - function( object ) { - cat( "Object 'prior'\n" ) - cat( " class :", class(object), "\n" ) - cat( " hier :", object@hier, "\n" ) - cat( " type :", object@type, "\n" ) - cat( " par : List of", - length( object@par ), "\n" ) - if( !all( is.na( object@weight ) ) ) { - cat(" weight :", - paste( dim( object@weight ), collapse = "x" ), "\n" ) - } - } +setMethod( + "show", "prior", + function(object) { + cat("Object 'prior'\n") + cat(" class :", class(object), "\n") + cat(" hier :", object@hier, "\n") + cat(" type :", object@type, "\n") + cat( + " par : List of", + length(object@par), "\n" + ) + if (!all(is.na(object@weight))) { + cat( + " weight :", + paste(dim(object@weight), collapse = "x"), "\n" + ) + } + } ) ## Getters ## -setMethod( "getWeight", "prior", - function( object ) - { - return( object@weight ) - } -) +setMethod( + "getWeight", "prior", + function(object) { + return(object@weight) + } +) -setMethod( "getPar", "prior", - function( object ) - { - return( object@par ) - } +setMethod( + "getPar", "prior", + function(object) { + return(object@par) + } ) -setMethod( "getType", "prior", - function( object ) - { - return( object@type ) - } +setMethod( + "getType", "prior", + function(object) { + return(object@type) + } ) -setMethod( "getHier", "prior", - function( object ) - { - return( object@hier ) - } +setMethod( + "getHier", "prior", + function(object) { + return(object@hier) + } ) ## Setters ## -setReplaceMethod( "setWeight", "prior", - function( object, value ) - { - object@weight <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setWeight", "prior", + function(object, value) { + object@weight <- value + validObject(object) + return(object) + } ) -setReplaceMethod( "setPar", "prior", - function( object, value ) - { - object@par <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setPar", "prior", + function(object, value) { + object@par <- value + validObject(object) + return(object) + } ) -setReplaceMethod( "setType", "prior", - function( object, value ) - { - object@type <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setType", "prior", + function(object, value) { + object@type <- value + validObject(object) + return(object) + } ) -setReplaceMethod( "setHier", "prior", - function( object, value ) - { - object@hier <- value - validObject( object ) - return( object ) - } +setReplaceMethod( + "setHier", "prior", + function(object, value) { + object@hier <- value + validObject(object) + return(object) + } ) ### Private functions @@ -270,7 +292,7 @@ setReplaceMethod( "setHier", "prior", ### ------------------------------------------------------------------ ### .check.fdata.model.Prior ### @description Checks objects of classes 'fdata' and 'model' for -### validity and consistency. +### validity and consistency. ### @par fdata.obj an S4 object of class 'fdata' ### @par model.obj an S4 object of class 'model' ### @return throws an error if any object is not valid or if @@ -279,12 +301,11 @@ setReplaceMethod( "setHier", "prior", ### .valid.fdata.model.Prior ### @author Lars Simon Zehnder ### ------------------------------------------------------------------- -".check.fdata.model.Prior" <- function( fdata.obj, model.obj ) -{ - .valid.Fdata( fdata.obj ) - hasY( fdata.obj, verbose = TRUE ) - .init.valid.Model( model.obj ) - .valid.fdata.model.Prior( fdata.obj, model.obj ) +".check.fdata.model.Prior" <- function(fdata.obj, model.obj) { + .valid.Fdata(fdata.obj) + hasY(fdata.obj, verbose = TRUE) + .init.valid.Model(model.obj) + .valid.fdata.model.Prior(fdata.obj, model.obj) } ### ------------------------------------------------------------------ @@ -298,848 +319,966 @@ setReplaceMethod( "setHier", "prior", ### @see validity ### @author Lars Simon Zehnder ### ------------------------------------------------------------------- -".check.varargin.Prior" <- function( obj ) -{ - if ( !inherits( obj, "prior" ) ) { - stop( paste( "Argument 'varargin' is not of class 'prior'. ", - "If argument 'varargin' in 'priordefine()' is ", - "specified, it must be of class 'prior'.", sep = "" ) ) - } else { - validObject( obj ) - } +".check.varargin.Prior" <- function(obj) { + if (!inherits(obj, "prior")) { + stop(paste("Argument 'varargin' is not of class 'prior'. ", + "If argument 'varargin' in 'priordefine()' is ", + "specified, it must be of class 'prior'.", + sep = "" + )) + } else { + validObject(obj) + } } ### Has ### hasPar Prior -".haspar.Prior" <- function( obj, model.obj, verbose ) -{ - dist <- model.obj@dist - if ( dist == "poisson" ) { - .haspar.poisson.Prior( obj, model.obj, verbose ) - } else if ( dist == "binomial" ) { - .haspar.binomial.Prior( obj, model.obj, verbose ) - } else if ( dist == "exponential" ) { - .haspar.exponential.Prior( obj, model.obj, verbose ) - } else if ( dist == "cond.poisson" ) { - .haspar.condpoisson.Prior( obj, model.obj, verbose ) - } else if ( dist %in% c( "normal", "normult" ) ) { - .haspar.normal.Prior( obj, model.obj, verbose ) - } else if ( dist %in% c( "student", "studmult" ) ) { - .haspar.student.Prior( obj, model.obj, verbose ) - } +".haspar.Prior" <- function(obj, model.obj, verbose) { + dist <- model.obj@dist + if (dist == "poisson") { + .haspar.poisson.Prior(obj, model.obj, verbose) + } else if (dist == "binomial") { + .haspar.binomial.Prior(obj, model.obj, verbose) + } else if (dist == "exponential") { + .haspar.exponential.Prior(obj, model.obj, verbose) + } else if (dist == "cond.poisson") { + .haspar.condpoisson.Prior(obj, model.obj, verbose) + } else if (dist %in% c("normal", "normult")) { + .haspar.normal.Prior(obj, model.obj, verbose) + } else if (dist %in% c("student", "studmult")) { + .haspar.student.Prior(obj, model.obj, verbose) + } } ### hasPar Prior Poisson -".haspar.poisson.Prior" <- function( obj, model.obj, verbose ) -{ - K <- model.obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'prior' object is empty.", - call. = FALSE ) +".haspar.poisson.Prior" <- function(obj, model.obj, verbose) { + K <- model.obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'prior' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("a" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Poisson models ", + "need Gamma shape parameters named ", + "'a'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (dim(obj@par$a)[2] != K) { + if (verbose) { + stop(paste("Wrong specifcation of slot @par ", + "in 'prior' object. Slot 'K' in ", + "'model' object does not match ", + "dimension of prior parameters.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "a" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Poisson models ", - "need Gamma shape parameters named ", - "'a'.", sep = "" ), call. = FALSE ) + } else { + if (!("b" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Poisson models ", + "need Gamma rate parameters named ", + "'b'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (dim(obj@par$b)[2] != K) { + if (verbose) { + stop(paste("Wrong specifcation of slot @par ", + "in 'prior' object. Slot 'K' in ", + "'model' object does not match ", + "dimension of prior parameters.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( dim( obj@par$a )[2] != K ) { - if ( verbose ) { - stop( paste( "Wrong specifcation of slot @par ", - "in 'prior' object. Slot 'K' in ", - "'model' object does not match ", - "dimension of prior parameters.", - sep = ""), call. = FALSE ) + } else { + if (obj@hier) { + if (!("g" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object if slot 'hier' ", + "is set to TRUE. Hierarchical Poisson models ", + "need Gamma shape hyperparameter named ", + "'g'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "b" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Poisson models ", - "need Gamma rate parameters named ", - "'b'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("G" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object if slot 'hier' ", + "is set to TRUE. Hierarchical Poisson models ", + "need Gamma rate hyperparameter named ", + "'gG'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( dim( obj@par$b )[2] != K ) { - if ( verbose ) { - stop( paste( "Wrong specifcation of slot @par ", - "in 'prior' object. Slot 'K' in ", - "'model' object does not match ", - "dimension of prior parameters.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( obj@hier ) { - if ( !( "g" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object if slot 'hier' ", - "is set to TRUE. Hierarchical Poisson models ", - "need Gamma shape hyperparameter named ", - "'g'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( "G" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object if slot 'hier' ", - "is set to TRUE. Hierarchical Poisson models ", - "need Gamma rate hyperparameter named ", - "'gG'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } else { - return( TRUE ) - } - } - } + return(TRUE) + } + } + } else { + return(TRUE) } + } } + } } + } } -".haspar.condpoisson.Prior" <- function( obj, model.obj, verbose ) -{ - K <- model.obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'prior' object is empty.", - call. = FALSE ) +".haspar.condpoisson.Prior" <- function(obj, model.obj, verbose) { + K <- model.obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'prior' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("Q" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Poisson models ", + "need means named ", + "'Q'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (length(obj@par$Q) != K) { + if (verbose) { + stop(paste("Wrong specifcation of slot @par ", + "in 'prior' object. Slot @K in ", + "'model' object does not match ", + "dimension of prior parameters.", + sep = "" + ), .call = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "Q" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Poisson models ", - "need means named ", - "'Q'.", sep = ""), call. = FALSE ) + } else { + if (!("N" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot 'par' ", + "in 'prior' object. Poisson models ", + "need a number of observations per ", + "component named ", + "'N'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (length(obj@par$N) != K) { + if (verbose) { + stop(paste("Wrong specifcation of slot 'par' ", + "in 'prior' object. Slot @K in ", + "'model' object does not match ", + "dimension of prior parameters.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( length( obj@par$Q ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specifcation of slot @par ", - "in 'prior' object. Slot @K in ", - "'model' object does not match ", - "dimension of prior parameters.", - sep = ""), .call = FALSE ) + } else { + if (!("a" %in% names(obj@par))) { + if (verbose) { + stop(paste( + "Wrong specification of slot @par ", + "in 'prior' object. Conditional ", + "Poisson models need a uniform ", + "distribution parameter 'a' ", + "defining the interval [a, b]." + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("b" %in% names(obj@par))) { + if (verbose) { + stop(paste( + "Wrong specification of slot @par ", + "in 'prior' object. Conditional ", + "Poisson models need a uniform ", + "distribution parameter 'b' ", + "defining the interval [a, b]." + ), + .call = FALSE + ) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( "N" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot 'par' ", - "in 'prior' object. Poisson models ", - "need a number of observations per ", - "component named ", - "'N'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("s" %in% names(obj@par))) { + if (verbose) { + stop(paste( + "Wrong specification of slot @par ", + "in 'prior' object. Conditional ", + "Poisson models need a parameter ", + "'s' defining the standard deviation ", + "of the Metropolis proposal." + ), + call. = FALSE + ) + } else { + return(FALSE) + } } else { - if ( length( obj@par$N ) != K ) { - if ( verbose ) { - stop( paste( "Wrong specifcation of slot 'par' ", - "in 'prior' object. Slot @K in ", - "'model' object does not match ", - "dimension of prior parameters.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( "a" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Conditional ", - "Poisson models need a uniform ", - "distribution parameter 'a' ", - "defining the interval [a, b]." ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( "b" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Conditional ", - "Poisson models need a uniform ", - "distribution parameter 'b' ", - "defining the interval [a, b]." ), - .call = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( "s" %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Conditional ", - "Poisson models need a parameter ", - "'s' defining the standard deviation ", - "of the Metropolis proposal." ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } - } + return(TRUE) } - } + } + } + } } - } + } + } + } } -".haspar.binomial.Prior" <- function( obj, model.obj, verbose ) -{ - K <- model.obj@K - if ( !length( obj@par ) ) { - if ( verbose ) { - stop( "Slot @par in 'prior' object is empty.", - call. = FALSE ) +".haspar.binomial.Prior" <- function(obj, model.obj, verbose) { + K <- model.obj@K + if (!length(obj@par)) { + if (verbose) { + stop("Slot @par in 'prior' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!("a" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Binomial models ", + "need Beta shape parameters named ", + "'a'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (dim(obj@par$a)[2] != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Slot @K in ", + "'model' object does not match ", + "dimension of prior parameters.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !( 'a' %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Binomial models ", - "need Beta shape parameters named ", - "'a'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!("b" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Binomial models ", + "need Beta shape parameters named ", + "'b'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( dim( obj@par$a )[2] != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Slot @K in ", - "'model' object does not match ", - "dimension of prior parameters.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !( 'b' %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Binomial models ", - "need Beta shape parameters named ", - "'b'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( dim( obj@par$b )[2] != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Slot @K in ", - "'model' object does not match ", - "dimension of prior parameters.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return(TRUE) - } - } + if (dim(obj@par$b)[2] != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Slot @K in ", + "'model' object does not match ", + "dimension of prior parameters.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) } + } else { + return(TRUE) + } } + } } + } } ### ----------------------------------------------------------------- ### .haspar.exponential.Prior ### ----------------------------------------------------------------- -".haspar.exponential.Prior" <- function( obj, model.obj, verbose ) -{ - K <- model.obj@K - if ( !length( obj@par ) ) { - if ( verbose ) { - stop( "Slot @par in 'prior' object is empty.", call. = FALSE) +".haspar.exponential.Prior" <- function(obj, model.obj, verbose) { + K <- model.obj@K + if (!length(obj@par)) { + if (verbose) { + stop("Slot @par in 'prior' object is empty.", call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!("a" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Priors for ", + "exponential models need Gamma ", + "shape parameters named 'a'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (dim(obj@par$a)[2] != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Slot @K in ", + "'model' object does not match dimension ", + "of prior parameters.", + sep = "" + ), + call. = FALSE + ) } else { - return ( FALSE ) + return(FALSE) } + } + if (!("b" %in% names(obj@par))) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Priors for ", + "exponential models need Gamma rate ", + "parameters named 'b'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (dim(obj@par$b)[2] != K) { + if (verbose) { + stop(paste("Wrong specification of slot @par ", + "in 'prior' object. Slot @K in ", + "'model' object does not match dimension ", + "of prior parameters.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + return(TRUE) + } + } + } + } +} + +".haspar.normal.Prior" <- function(obj, model.obj, verbose) { + K <- model.obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'prior' object is empty.", + call. = FALSE + ) } else { - if ( !('a' %in% names ( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Priors for ", - "exponential models need Gamma ", - "shape parameters named 'a'.", - sep = ""), call. = FALSE ) + return(FALSE) + } + } else { + if (!"mu" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a 'list' object called 'mu'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"b" %in% names(obj@par$mu)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need mean values named 'b'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (obj@type == "condconjugate") { + if (!"N0" %in% names(obj@par$mu)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Conditionally conjugate ", + "priors for Normal models need variances ", + "named 'N0'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( dim( obj@par$a )[2] != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Slot @K in ", - "'model' object does not match dimension ", - "of prior parameters.", sep = ""), - call. = FALSE) + } else { + if (!"sigma" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a 'list' object named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!"c" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a inverse Gamma shape parameter named ", + "'c'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } - if ( !('b' %in% names( obj@par ) ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Priors for ", - "exponential models need Gamma rate ", - "parameters named 'b'.", sep = ""), - call. = FALSE) + } else { + if (!"C" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object'. Priors for Normal models ", + "need a inverse Gamma rate parameter named ", + "'C'.", + sep = "" + ), call. = FALSE) + } } else { - return( FALSE ) + if (model.obj@r > 1 && !"logdetC" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for multivariate ", + "Normal models need the logarithmised ", + "determinant of the shape matrix of the ", + "Wishart distribution and has to be named ", + "'logdetC'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (obj@hier && !"g" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Normal models need a Gamma shape parameter ", + "named 'g'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else if (obj@hier && !"G" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Normal models need a Gamma rate parameter ", + "named 'G'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + return(TRUE) + } + } } + } + } + } + } else { + if (!"Binv" %in% names(obj@par$mu)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Independent priors for ", + "Normal models need variances named 'Binv'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"sigma" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a 'list' object named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } } else { - if ( dim( obj@par$b )[2] != K ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par ", - "in 'prior' object. Slot @K in ", - "'model' object does not match dimension ", - "of prior parameters.", sep = ""), - call. = FALSE ) + if (!"c" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a inverse Gamma shape parameter named ", + "'c'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"C" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a inverse Gamma rate parameter named ", + "'C'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (model.obj@r > 1 && !"logdetC" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for multivariate ", + "Normal models need the logarithmised ", + "determinant of the shape matrix of the ", + "Wishart distribution and has to be named ", + "'logdetC'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - return( TRUE ) + } else { + if (obj@hier && !"g" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Normal models need a Gamma shape parameter ", + "named 'g'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else if (obj@hier && !"G" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Normal models need a Gamma rate parameter ", + "named 'G'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + return(TRUE) + } + } } + } } + } } + } } + } } -".haspar.normal.Prior" <- function( obj, model.obj, verbose ) -{ - K <- model.obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'prior' object is empty.", - call. = FALSE ) +".haspar.student.Prior" <- function(obj, model.obj, verbose) { + K <- model.obj@K + if (length(obj@par) == 0) { + if (verbose) { + stop("Slot @par in 'prior' object is empty.", + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!"mu" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Student-t models ", + "need a 'list' object called 'mu'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"b" %in% names(obj@par$mu)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Student-t models ", + "need mean values named 'b'.", + sep = "" + ), + call. = FALSE + ) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !"mu" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a 'list' object called 'mu'.", - sep = "" ), call. = FALSE ) + } else { + if (obj@type == "condconjugate") { + if (!"N0" %in% names(obj@par$mu)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Conditionally conjugate ", + "priors for Student-t models need variances ", + "named 'N0'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !"b" %in% names( obj@par$mu ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need mean values named 'b'.", sep = "" ), - call. = FALSE ) + } else { + if (!"sigma" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Student-t models ", + "need a 'list' object named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!"c" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Student-t models ", + "need a inverse Gamma shape parameter named ", + "'c'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( obj@type == "condconjugate" ) { - if ( !"N0" %in% names( obj@par$mu ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Conditionally conjugate ", - "priors for Normal models need variances ", - "named 'N0'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!"C" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object'. Priors for Student-t models ", + "need a inverse Gamma rate parameter named ", + "'C'.", + sep = "" + ), call. = FALSE) + } + } else { + if (model.obj@r > 1 && !"logdetC" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for multivariate ", + "Student-t models need the logarithmised ", + "determinant of the shape matrix of the ", + "Wishart distribution and has to be named ", + "'logdetC'.", + sep = "" + ), call. = FALSE) } else { - if ( !"sigma" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a 'list' object named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"c" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a inverse Gamma shape parameter named ", - "'c'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"C" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object'. Priors for Normal models ", - "need a inverse Gamma rate parameter named ", - "'C'.", sep = ""), call. = FALSE ) - } - } else { - if ( model.obj@r > 1 && !"logdetC" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for multivariate ", - "Normal models need the logarithmised ", - "determinant of the shape matrix of the ", - "Wishart distribution and has to be named ", - "'logdetC'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( obj@hier && !"g" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Normal models need a Gamma shape parameter ", - "named 'g'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else if ( obj@hier && !"G" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Normal models need a Gamma rate parameter ", - "named 'G'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } - } - } + return(FALSE) } - } else { - if ( !'Binv' %in% names( obj@par$mu ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Independent priors for ", - "Normal models need variances named 'Binv'.", - sep = "" ), call. = FALSE ) + } else { + if (obj@hier && !"g" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Student-t models need a Gamma shape parameter ", + "named 'g'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else if (obj@hier && !"G" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Student-t models need a Gamma rate parameter ", + "named 'G'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"df" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Student-t ", + "models need a 'list' object named ", + "'df'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !"sigma" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a 'list' object named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!"type" %in% names(obj@par$df)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for the degrees of ", + "freedom in Student-t models need a type ", + "named 'type'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( !"c" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a inverse Gamma shape parameter named ", - "'c'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + if (!all(c("trans", "a0", "b0", "d") %in% names(obj@par$df)) + ) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for the degrees of ", + "freedom in Student-t models need ", + "hyperparameters named 'trans', 'a0', 'b0' ", + "and 'd'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"mhtune" %in% names(obj@par$df)) { + if (verbose) { + stop(paste("Wrog specification of slot @par in ", + "'prior' object. Priors for the degrees ", + "of freedom need Metropolis-Hastings ", + "tuning parameters named 'mhtune'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( !"C" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a inverse Gamma rate parameter named ", - "'C'.", sep = ""), call. = FALSE ) - - } else { - return( FALSE ) - } - } else { - if ( model.obj@r > 1 && !"logdetC" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for multivariate ", - "Normal models need the logarithmised ", - "determinant of the shape matrix of the ", - "Wishart distribution and has to be named ", - "'logdetC'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( obj@hier && !"g" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Normal models need a Gamma shape parameter ", - "named 'g'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else if ( obj@hier && !"G" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Normal models need a Gamma rate parameter ", - "named 'G'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } + return(TRUE) } + } } + } } + } } - } - } - } -} - -".haspar.student.Prior" <- function( obj, model.obj, verbose ) -{ - K <- model.obj@K - if ( length( obj@par ) == 0 ) { - if ( verbose ) { - stop( "Slot @par in 'prior' object is empty.", - call. = FALSE ) + } + } + } } else { - return( FALSE ) - } - } else { - if ( !"mu" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Student-t models ", - "need a 'list' object called 'mu'.", - sep = "" ), call. = FALSE ) + if (!"Binv" %in% names(obj@par$mu)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Independent priors for ", + "Normal models need variances named 'Binv'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !"b" %in% names( obj@par$mu ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Student-t models ", - "need mean values named 'b'.", sep = "" ), - call. = FALSE ) + } else { + if (!"sigma" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a 'list' object named 'sigma'.", + sep = "" + ), + call. = FALSE + ) + } else { + return(FALSE) + } + } else { + if (!"c" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a inverse Gamma shape parameter named ", + "'c'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( obj@type == "condconjugate" ) { - if ( !"N0" %in% names( obj@par$mu ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Conditionally conjugate ", - "priors for Student-t models need variances ", - "named 'N0'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!"C" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Normal models ", + "need a inverse Gamma rate parameter named ", + "'C'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (model.obj@r > 1 && !"logdetC" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for multivariate ", + "Normal models need the logarithmised ", + "determinant of the shape matrix of the ", + "Wishart distribution and has to be named ", + "'logdetC'.", + sep = "" + ), call. = FALSE) } else { - if ( !"sigma" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Student-t models ", - "need a 'list' object named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"c" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Student-t models ", - "need a inverse Gamma shape parameter named ", - "'c'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"C" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object'. Priors for Student-t models ", - "need a inverse Gamma rate parameter named ", - "'C'.", sep = ""), call. = FALSE ) - } - } else { - if ( model.obj@r > 1 && !"logdetC" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for multivariate ", - "Student-t models need the logarithmised ", - "determinant of the shape matrix of the ", - "Wishart distribution and has to be named ", - "'logdetC'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( obj@hier && !"g" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Student-t models need a Gamma shape parameter ", - "named 'g'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else if ( obj@hier && !"G" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Student-t models need a Gamma rate parameter ", - "named 'G'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"df" %in% names( obj@par) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Student-t ", - "models need a 'list' object named ", - "'df'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"type" %in% names( obj@par$df ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for the degrees of ", - "freedom in Student-t models need a type ", - "named 'type'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !all( c( "trans", "a0", "b0", "d" ) %in% names( obj@par$df ) ) - ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for the degrees of ", - "freedom in Student-t models need ", - "hyperparameters named 'trans', 'a0', 'b0' ", - "and 'd'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"mhtune" %in% names( obj@par$df ) ) { - if ( verbose ) { - stop( paste( "Wrog specification of slot @par in ", - "'prior' object. Priors for the degrees ", - "of freedom need Metropolis-Hastings ", - "tuning parameters named 'mhtune'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } - } - } - } - } - } - } + return(FALSE) } - } else { - if ( !'Binv' %in% names( obj@par$mu ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Independent priors for ", - "Normal models need variances named 'Binv'.", - sep = "" ), call. = FALSE ) + } else { + if (obj@hier && !"g" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Normal models need a Gamma shape parameter ", + "named 'g'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else if (obj@hier && !"G" %in% names(obj@par$sigma)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Hierarchical priors for ", + "Normal models need a Gamma rate parameter ", + "named 'G'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + if (!"df" %in% names(obj@par)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for Student-t ", + "models need a 'list' object named ", + "'df'.", + sep = "" + ), call. = FALSE) } else { - return( FALSE ) + return(FALSE) } - } else { - if ( !"sigma" %in% names( obj@par ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a 'list' object named 'sigma'.", sep = "" ), - call. = FALSE ) - } else { - return( FALSE ) - } + } else { + if (!"type" %in% names(obj@par$df)) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for the degrees of ", + "freedom in Student-t models need a type ", + "named 'type'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } } else { - if ( !"c" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a inverse Gamma shape parameter named ", - "'c'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } + if (!all(c("trans", "a0", "b0", "d") %in% names(obj@par$df)) + ) { + if (verbose) { + stop(paste("Wrong specification of slot @par in ", + "'prior' object. Priors for the degrees of ", + "freedom in Student-t models need ", + "hyperparameters named 'trans', 'a0', 'b0' ", + "and 'd'.", + sep = "" + ), call. = FALSE) } else { - if ( !"C" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Normal models ", - "need a inverse Gamma rate parameter named ", - "'C'.", sep = ""), call. = FALSE ) - - } else { - return( FALSE ) - } - } else { - if ( model.obj@r > 1 && !"logdetC" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for multivariate ", - "Normal models need the logarithmised ", - "determinant of the shape matrix of the ", - "Wishart distribution and has to be named ", - "'logdetC'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( obj@hier && !"g" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Normal models need a Gamma shape parameter ", - "named 'g'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else if ( obj@hier && !"G" %in% names( obj@par$sigma ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Hierarchical priors for ", - "Normal models need a Gamma rate parameter ", - "named 'G'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"df" %in% names( obj@par) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for Student-t ", - "models need a 'list' object named ", - "'df'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"type" %in% names( obj@par$df ) ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for the degrees of ", - "freedom in Student-t models need a type ", - "named 'type'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !all( c( "trans", "a0", "b0", "d" ) %in% names( obj@par$df ) ) - ) { - if ( verbose ) { - stop( paste( "Wrong specification of slot @par in ", - "'prior' object. Priors for the degrees of ", - "freedom in Student-t models need ", - "hyperparameters named 'trans', 'a0', 'b0' ", - "and 'd'.", sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - if ( !"mhtune" %in% names( obj@par$df ) ) { - if ( verbose ) { - stop( paste( "Wrog specification of slot @par in ", - "'prior' object. Priors for the degrees ", - "of freedom need Metropolis-Hastings ", - "tuning parameters named 'mhtune'.", - sep = "" ), call. = FALSE ) - } else { - return( FALSE ) - } - } else { - return( TRUE ) - } - } - } - } - } - } - } + return(FALSE) } + } else { + if (!"mhtune" %in% names(obj@par$df)) { + if (verbose) { + stop(paste("Wrog specification of slot @par in ", + "'prior' object. Priors for the degrees ", + "of freedom need Metropolis-Hastings ", + "tuning parameters named 'mhtune'.", + sep = "" + ), call. = FALSE) + } else { + return(FALSE) + } + } else { + return(TRUE) + } + } } + } } + } } - } + } + } + } } + } } + } } ### ----------------------------------------------------------------- -### obj, model.obj, verbose .generatePriorPoisson -### @description Generates the hyper parameters for a Poisson +### obj, model.obj, verbose .generatePriorPoisson +### @description Generates the hyper parameters for a Poisson ### distribution. ### @par obj an S4 object of class 'prior' ### @par fdata.obj an S4 object of class 'fdata' ### @par model.obj an S4 object of class 'model' ### @par varargin am S4 object of class 'prior' ### @return a fully specified 'prior' object for Poisson -### models specified by 'model.obj' with data in +### models specified by 'model.obj' with data in ### 'fdata.obj' and predefined slots in 'varargin' ### @details the type of a data-dependent Poisson prior is -### is always conditionally conjugate Gamma with +### is always conditionally conjugate Gamma with ### parameters: a: shape, 1 x model.obj@K ### b: rate, 1 x model.obj@K ### If not otherwise specified in 'varargin' an @@ -1149,121 +1288,128 @@ setReplaceMethod( "setHier", "prior", ### @see ?prior, ?fdata, ?model ### @author Lars Simon Zehnder ### ------------------------------------------------------------------ -".generatePriorPoisson" <- function(obj, fdata.obj, model.obj, - varargin) -{ - K <- model.obj@K - datam <- getColY(fdata.obj) - if (is.null(varargin)) { - obj@hier <- TRUE ## default prior is hierarchical - obj@type <- "condconjugate" - } else { - obj@hier <- varargin@hier - obj@type <- "condconjugate" - } - ## Default prior based on matching moments - ## See Frühwirth-Schnatter (2006) and Viallefont et. al. (2002) - ## for more information. +".generatePriorPoisson" <- function(obj, fdata.obj, model.obj, + varargin) { + K <- model.obj@K + datam <- getColY(fdata.obj) + if (is.null(varargin)) { + obj@hier <- TRUE ## default prior is hierarchical + obj@type <- "condconjugate" + } else { + obj@hier <- varargin@hier + obj@type <- "condconjugate" + } + ## Default prior based on matching moments + ## See Frühwirth-Schnatter (2006) and Viallefont et. al. (2002) + ## for more information. - ## Choose level of overdispersion, depending on the - ## ratio overdispersion/mean^2 - ## no idea: data-based choice - mean <- mean(datam, na.rm = TRUE) - over <- as.numeric(var(datam, na.rm = TRUE) - mean) - if (over > 0) { - a0 <- mean^2/over - } else { - a0 <- 10 - } - if (obj@hier) { - g0 <- 0.5 - G0 <- mean * g0/a0 - b0 <- g0/G0 - par <- list(a = array(a0, dim = c(1, K)), - b = array(b0, dim = c(1, K)), - g = g0, G = G0) - } else { - b0 = a0/mean - par <- list(a = array(a0, dim = c(1, K)), - b = array(b0, dim = c(1, K))) - } - obj@par <- par - return(obj) + ## Choose level of overdispersion, depending on the + ## ratio overdispersion/mean^2 + ## no idea: data-based choice + mean <- mean(datam, na.rm = TRUE) + over <- as.numeric(var(datam, na.rm = TRUE) - mean) + if (over > 0) { + a0 <- mean^2 / over + } else { + a0 <- 10 + } + if (obj@hier) { + g0 <- 0.5 + G0 <- mean * g0 / a0 + b0 <- g0 / G0 + par <- list( + a = array(a0, dim = c(1, K)), + b = array(b0, dim = c(1, K)), + g = g0, G = G0 + ) + } else { + b0 <- a0 / mean + par <- list( + a = array(a0, dim = c(1, K)), + b = array(b0, dim = c(1, K)) + ) + } + obj@par <- par + return(obj) } -".generatePriorCondPoisson" <- function( obj, fdata.obj, model.obj, - s ) -{ - K <- model.obj@K - if ( fdata.obj@bycolumn) { - datam <- fdata.obj@y - } else { - datam <- t( fdata.obj@y ) - } - obj@hier <- FALSE ## default prior is hierarchical - obj@type <- "condconjugate" - clust <- kmeans( datam, model.obj@K ) - Q <- vector( "numeric", K ) - N <- vector( "numeric", K ) - for ( k in 1:K ) { - Q[k] <- mean( fdata.obj@y[clust$cluster == k], na.rm = TRUE ) - N[k] <- sum( clust$cluster == k ) - } - Qsort <- sort( Q, decreasing = FALSE, index.return = TRUE ) - Q <- Qsort$x - N <- N[Qsort$ix] - ## Q <- mean( datam, na.rm = TRUE ) - ## if ( nrow( datam ) %% K == 0 ) { - ## N <- nrow( datam ) / K - ## } else { - ## N <- nrow( datam ) / K - ## N <- c( ceiling( N ), floor( N ) ) - ##} - mu1 <- Q[1] - mu2 <- mean( datam[clust$cluster == which(Qsort$ix == 1)]^2, na.rm = TRUE ) - A <- max( 0, mu1 - sqrt( 3 * ( mu2 - mu1^2 ) ) ) - B <- mu1 + sqrt( 3 * ( mu2 - mu1^2 ) ) - pars <- list( Q = as.array( Q ), - N = as.array( N ), - a = A, - b = B, - s = s ) - obj@par <- pars - return( obj ) +".generatePriorCondPoisson" <- function(obj, fdata.obj, model.obj, + s) { + K <- model.obj@K + if (fdata.obj@bycolumn) { + datam <- fdata.obj@y + } else { + datam <- t(fdata.obj@y) + } + obj@hier <- FALSE ## default prior is hierarchical + obj@type <- "condconjugate" + clust <- kmeans(datam, model.obj@K) + Q <- vector("numeric", K) + N <- vector("numeric", K) + for (k in 1:K) { + Q[k] <- mean(fdata.obj@y[clust$cluster == k], na.rm = TRUE) + N[k] <- sum(clust$cluster == k) + } + Qsort <- sort(Q, decreasing = FALSE, index.return = TRUE) + Q <- Qsort$x + N <- N[Qsort$ix] + ## Q <- mean( datam, na.rm = TRUE ) + ## if ( nrow( datam ) %% K == 0 ) { + ## N <- nrow( datam ) / K + ## } else { + ## N <- nrow( datam ) / K + ## N <- c( ceiling( N ), floor( N ) ) + ## } + mu1 <- Q[1] + mu2 <- mean(datam[clust$cluster == which(Qsort$ix == 1)]^2, na.rm = TRUE) + A <- max(0, mu1 - sqrt(3 * (mu2 - mu1^2))) + B <- mu1 + sqrt(3 * (mu2 - mu1^2)) + pars <- list( + Q = as.array(Q), + N = as.array(N), + a = A, + b = B, + s = s + ) + obj@par <- pars + return(obj) } -".select.beta.Prior" <- function( quantile1, quantile2 ) -{ - betaprior1 <- function( K, x, p ) - { - m.lo <- 0.0; m.hi <- 1; flag = 0 - while ( flag == 0 ) { - m0 <- ( m.lo + m.hi ) / 2 - p0 <- pbeta( x, K * m0, K * (1 - m0 ) ) - if ( p0 < p ) m.hi <- m0 else m.lo <- m0 - if ( abs( p0 - p ) < .0001 ) flag = 1 - } - return( m0 ) +".select.beta.Prior" <- function(quantile1, quantile2) { + betaprior1 <- function(K, x, p) { + m.lo <- 0.0 + m.hi <- 1 + flag <- 0 + while (flag == 0) { + m0 <- (m.lo + m.hi) / 2 + p0 <- pbeta(x, K * m0, K * (1 - m0)) + if (p0 < p) m.hi <- m0 else m.lo <- m0 + if (abs(p0 - p) < .0001) flag <- 1 } - p1 <- quantile1$p; x1 <- quantile1$x - p2 <- quantile2$p; x2 <- quantile2$x - logK <- seq( -3, 8, length = 100 ); K = exp( logK ) - m <- sapply( K, betaprior1, x1, p1 ) - prob2 <- pbeta( x2, K * m, K * ( 1 - m ) ) - ind <- ( ( prob2 > 0 ) & ( prob2 < 1) ) - app <- approx( prob2[ind], logK[ind], p2 ) - K0 <- exp( app$y ) - m0 <- betaprior1( K0, x1, p1 ) - return( round( K0 * c( m0, ( 1 - m0 ) ), 2 ) ) + return(m0) + } + p1 <- quantile1$p + x1 <- quantile1$x + p2 <- quantile2$p + x2 <- quantile2$x + logK <- seq(-3, 8, length = 100) + K <- exp(logK) + m <- sapply(K, betaprior1, x1, p1) + prob2 <- pbeta(x2, K * m, K * (1 - m)) + ind <- ((prob2 > 0) & (prob2 < 1)) + app <- approx(prob2[ind], logK[ind], p2) + K0 <- exp(app$y) + m0 <- betaprior1(K0, x1, p1) + return(round(K0 * c(m0, (1 - m0)), 2)) } ### ---------------------------------------------------------------- ### .generatePriorBinomial -### @description Generates the hyper parameters for a Binomial +### @description Generates the hyper parameters for a Binomial ### distribution. ### @par obj an S4 object of class 'prior' ### @par model.obj an S4 object of class 'model' ### @return a fully specified 'prior' object for Binomial -### models specified by 'model.obj'. +### models specified by 'model.obj'. ### @details the type of generated Binomial prior is always ### conditionally conjugate Beta with parameters: ### a: shape, 1 x model.obj@K @@ -1272,16 +1418,17 @@ setReplaceMethod( "setHier", "prior", ### @see ?prior, ?model ### author Lars Simon Zehnder ### ---------------------------------------------------------------- -".generatePriorBinomial" <- function( obj, model.obj ) -{ - K <- model.obj@K - obj@type <- "condconjugate" - ## uniform prior ## - a0 <- 1 - b0 <- 1 - obj@par <- list( a = array( a0, dim = c( 1, K ) ), - b = array( b0, dim = c( 1, K ) ) ) - return( obj ) +".generatePriorBinomial" <- function(obj, model.obj) { + K <- model.obj@K + obj@type <- "condconjugate" + ## uniform prior ## + a0 <- 1 + b0 <- 1 + obj@par <- list( + a = array(a0, dim = c(1, K)), + b = array(b0, dim = c(1, K)) + ) + return(obj) } ### ---------------------------------------------------------------- @@ -1295,286 +1442,302 @@ setReplaceMethod( "setHier", "prior", ### @return a fully specified 'prior' object for Exponential models ### specified by 'model.obj' and data specified in'fdata.obj' ### @detail If the identifier 'prior.wagner == TRUE' the prior from -### Wagner (2007) is taken. In the remaining case a +### Wagner (2007) is taken. In the remaining case a ### prior is constructed from the analysis of overdispersion ### in the observations. This prior can also be hierarchical ### if specified. ### @see ?priordefine -###@author Lars Simon Zehnder +### @author Lars Simon Zehnder ### ---------------------------------------------------------------- ".generatePriorExponential" <- function(obj, fdata.obj, model.obj, - varargin, prior.wagner ) -{ - if ( is.null( varargin ) ) { - obj@hier <- TRUE - } else { - obj@hier <- varargin@hier - } - obj@type <- "condconjugate" - datam <- getColY( fdata.obj ) - K <- model.obj@K - if ( prior.wagner ) { - # Prior following Wagner (2007) ## - obj@hier <- FALSE - a0 <- 0.1 - be <- mean( datam, na.rm = TRUE ) * a0 - obj@par <- list( a = array( a0, dim = c( 1, K ) ), - b = array( be, dim = c( 1, K ) ) ) - } else { - # Prior based on matching moments - # Choose level of overdispersion - # levover - # 0: no idea, data based choice - # 1: low degree of overdispersion; ratio smaller than 1 - # 2: medium degree of overdispersion; ratio close to 1 - # 3: high degree of overdispersion; ratio larger than 1 - levover <- 0 - a00 <- c( 10, 8/3, 2.1 ) - d.mean <- mean( datam, na.rm = TRUE ) - d2.mean <- mean( datam^2, na.rm = TRUE ) - over <- sd( datam, na.rm = TRUE )/d.mean - 1 - if ( levover == 0 ) { - if ( d2.mean - 2 * d.mean^2 > 0 ) { - a0 <- 2 * var( datam )/(d2.mean - 2 * d.mean^2) - } else { - if ( over < 0.2 ) { - levover <- 1 - a0 <- a00[1] - } else if ( over < 2 ) { - levover <- 2 - a0 <- a00[2] - } else { - levover <- 3 - a0 <- a00[3] - } - } + varargin, prior.wagner) { + if (is.null(varargin)) { + obj@hier <- TRUE + } else { + obj@hier <- varargin@hier + } + obj@type <- "condconjugate" + datam <- getColY(fdata.obj) + K <- model.obj@K + if (prior.wagner) { + # Prior following Wagner (2007) ## + obj@hier <- FALSE + a0 <- 0.1 + be <- mean(datam, na.rm = TRUE) * a0 + obj@par <- list( + a = array(a0, dim = c(1, K)), + b = array(be, dim = c(1, K)) + ) + } else { + # Prior based on matching moments + # Choose level of overdispersion + # levover + # 0: no idea, data based choice + # 1: low degree of overdispersion; ratio smaller than 1 + # 2: medium degree of overdispersion; ratio close to 1 + # 3: high degree of overdispersion; ratio larger than 1 + levover <- 0 + a00 <- c(10, 8 / 3, 2.1) + d.mean <- mean(datam, na.rm = TRUE) + d2.mean <- mean(datam^2, na.rm = TRUE) + over <- sd(datam, na.rm = TRUE) / d.mean - 1 + if (levover == 0) { + if (d2.mean - 2 * d.mean^2 > 0) { + a0 <- 2 * var(datam) / (d2.mean - 2 * d.mean^2) + } else { + if (over < 0.2) { + levover <- 1 + a0 <- a00[1] + } else if (over < 2) { + levover <- 2 + a0 <- a00[2] } else { - a0 <- a00( levover ) + levover <- 3 + a0 <- a00[3] } - if ( obj@hier ) { - g0 <- 0.5 - G0 <- g0/d.mean * ( a0 - 1 ) - be <- g0/G0 - obj@par <- list( a = array( a0, dim = c( 1, K ) ), - b = array( be, dim = c( 1, K ) ), - g = g0, - G = G0 ) - } else { - be <- d.mean * ( a0 - 1 ) - obj@par <- list( a = array( a0, dim = c( 1, K ) ), - b = array( be, dim = c( 1, K ) ) ) - } - } - return( obj ) -} - -".generatePriorNorstud" <- function( obj, data.obj, - model.obj, varargin ) -{ - r <- data.obj@r - K <- model.obj@K - datam <- getColY( data.obj ) - ## check if varargin is non-empty and prior object ## - ## set hierarchical or non-hierarchical prior ## - if( is.null( varargin ) ) { - ## default prior: independent hierarchical prior ## - obj@hier <- hier <- TRUE - obj@type <- "independent" + } } else { - obj@hier <- hier <- varargin@hier - obj@type <- varargin@type + a0 <- a00(levover) } - conjugate.prior <- obj@type == "condconjugate" - bensmail <- FALSE - rich.green <- FALSE - if ( conjugate.prior || !hier ) { - bensmail <- TRUE ## Prior following Bensmail et al. - } else { - rich.green <- TRUE ## Prior following Richardson and Green for r = 1 - ## Stephens (1997a) for r = 2 only - } - if ( rich.green ) { ## Richardson and Green (1997) or Stephens (1997a) - ## row vectors: dimension 1 x r - max <- apply( datam, 2, max, na.rm = TRUE ) - min <- apply( datam, 2, min, na.rm = TRUE ) - mean <- ( max + min ) * .5 - cov <- diag( ( max - min )^2, nrow = model.obj@r ) - } else { - ## row vectors: dimension 1 x r - mean <- apply( datam, 2, mean, na.rm = TRUE ) - cov <- var( datam, na.rm = TRUE ) - } - b0 <- mean - if ( conjugate.prior ) { - B0sc <- 1 ## info contained in a standard conjugate (sc) prior (equal to N0) - ## Bensmail et al. (1997) + if (obj@hier) { + g0 <- 0.5 + G0 <- g0 / d.mean * (a0 - 1) + be <- g0 / G0 + obj@par <- list( + a = array(a0, dim = c(1, K)), + b = array(be, dim = c(1, K)), + g = g0, + G = G0 + ) } else { - B0inv <- solve( cov ) ## info contained in a non-conjugate prior, - ## i.e. either by Richardson Green (1997) + be <- d.mean * (a0 - 1) + obj@par <- list( + a = array(a0, dim = c(1, K)), + b = array(be, dim = c(1, K)) + ) } - if ( !conjugate.prior ) { - if ( r > 1 ) { - par.mu <- list( b = array( t( b0 ), dim = c( r, K ) ), - Binv = array( B0inv, dim = c( r, r, K ) ) ) - } else { ## r = 1 - par.mu <- list( b = array( b0, dim = c( 1, K ) ), - Binv = array( B0inv, dim = c( 1, K ) ) ) - } + } + return(obj) +} + +".generatePriorNorstud" <- function(obj, data.obj, + model.obj, varargin) { + r <- data.obj@r + K <- model.obj@K + datam <- getColY(data.obj) + ## check if varargin is non-empty and prior object ## + ## set hierarchical or non-hierarchical prior ## + if (is.null(varargin)) { + ## default prior: independent hierarchical prior ## + obj@hier <- hier <- TRUE + obj@type <- "independent" + } else { + obj@hier <- hier <- varargin@hier + obj@type <- varargin@type + } + conjugate.prior <- obj@type == "condconjugate" + bensmail <- FALSE + rich.green <- FALSE + if (conjugate.prior || !hier) { + bensmail <- TRUE ## Prior following Bensmail et al. + } else { + rich.green <- TRUE ## Prior following Richardson and Green for r = 1 + ## Stephens (1997a) for r = 2 only + } + if (rich.green) { ## Richardson and Green (1997) or Stephens (1997a) + ## row vectors: dimension 1 x r + max <- apply(datam, 2, max, na.rm = TRUE) + min <- apply(datam, 2, min, na.rm = TRUE) + mean <- (max + min) * .5 + cov <- diag((max - min)^2, nrow = model.obj@r) + } else { + ## row vectors: dimension 1 x r + mean <- apply(datam, 2, mean, na.rm = TRUE) + cov <- var(datam, na.rm = TRUE) + } + b0 <- mean + if (conjugate.prior) { + B0sc <- 1 ## info contained in a standard conjugate (sc) prior (equal to N0) + ## Bensmail et al. (1997) + } else { + B0inv <- solve(cov) ## info contained in a non-conjugate prior, + ## i.e. either by Richardson Green (1997) + } + if (!conjugate.prior) { + if (r > 1) { + par.mu <- list( + b = array(t(b0), dim = c(r, K)), + Binv = array(B0inv, dim = c(r, r, K)) + ) + } else { ## r = 1 + par.mu <- list( + b = array(b0, dim = c(1, K)), + Binv = array(B0inv, dim = c(1, K)) + ) } - else { ## conditionally conjugate prior - if( r > 1 ) { - par.mu <- list( b = array( t( b0 ), dim = c( r, K ) ), - N0 = array( B0sc, dim = c( 1, K ) ) ) - } - else { ## r = 1 - par.mu <- list( b = array( b0, dim = c( 1, K ) ), - N0 = array( B0sc, dim = c( 1, K ) ) ) - } + } else { ## conditionally conjugate prior + if (r > 1) { + par.mu <- list( + b = array(t(b0), dim = c(r, K)), + N0 = array(B0sc, dim = c(1, K)) + ) + } else { ## r = 1 + par.mu <- list( + b = array(b0, dim = c(1, K)), + N0 = array(B0sc, dim = c(1, K)) + ) } + } - ## prior sigma ## - ## r = 1: Inverse Gamma with c0, C0 - ## r > 1: Wishart with c0, C0 - ## any r: Q in {Inverse Gamma, Inverse Wishart} with prQnu (prior Q nu) and prQS - ## We use the Gamma and Wishart and sample the inverse Variance. - ## where: - ## prQnu: degrees of freedom for Wishart and rate for Gamma - ## prQS : shape for Q - ## - ## Select Q0 the prior mean of Q. - ## Determine prQS from prQS = Q0 * (prQnu - (r + 1)/2). This matches Q0 to the mean - ## of the Inverse Gamma or the Inverse Wishart distribution and to the mode of Q^{-1} - ## i.e. the Gamma and Wishart distribution respectively. - ## Further, variance shrinkage towards the ratio prQS/dfQpr, where dfQpr bounds the - ## ratio of the variances. + ## prior sigma ## + ## r = 1: Inverse Gamma with c0, C0 + ## r > 1: Wishart with c0, C0 + ## any r: Q in {Inverse Gamma, Inverse Wishart} with prQnu (prior Q nu) and prQS + ## We use the Gamma and Wishart and sample the inverse Variance. + ## where: + ## prQnu: degrees of freedom for Wishart and rate for Gamma + ## prQS : shape for Q + ## + ## Select Q0 the prior mean of Q. + ## Determine prQS from prQS = Q0 * (prQnu - (r + 1)/2). This matches Q0 to the mean + ## of the Inverse Gamma or the Inverse Wishart distribution and to the mode of Q^{-1} + ## i.e. the Gamma and Wishart distribution respectively. + ## Further, variance shrinkage towards the ratio prQS/dfQpr, where dfQpr bounds the + ## ratio of the variances. - dfQpr <- 2.5 ## this bounds the ratio of variances to 10 for r = 1 - prQnu <- dfQpr + ( r - 1 ) / 2 + dfQpr <- 2.5 ## this bounds the ratio of variances to 10 for r = 1 + prQnu <- dfQpr + (r - 1) / 2 - if ( K == 1 ) { - phi <- 1 ## c0 heterogeneity - } else { - ## Tuning of the prior for sigma is done by explained heterogeneity - ## See p. 192, chapter 6.3.2 Fruewirth-Schnatter (2006) - ## Rhet - ## -> 1: means very different in relation to variances - ## -> 0: means rather similar in relation to variances - ## 0 < Rhet < 1 (do not choose 0 nor 1) - ## SMALL VALUE: leads to very informative prior for mu_k - ## close to b0. Should be chosen only in - ## combination with a hierarchical prior - ## on b0. - ## LARGE VALUE: leads to a very informative prior for - ## sigma_k close to prQS/prQnu. Should only - ## be chosen in combination with hierarchical - ## prior on prQS. - Rhet <- 0.5 ## Rhet = 2/3 - phi <- ( 1 - Rhet ) + if (K == 1) { + phi <- 1 ## c0 heterogeneity + } else { + ## Tuning of the prior for sigma is done by explained heterogeneity + ## See p. 192, chapter 6.3.2 Fruewirth-Schnatter (2006) + ## Rhet + ## -> 1: means very different in relation to variances + ## -> 0: means rather similar in relation to variances + ## 0 < Rhet < 1 (do not choose 0 nor 1) + ## SMALL VALUE: leads to very informative prior for mu_k + ## close to b0. Should be chosen only in + ## combination with a hierarchical prior + ## on b0. + ## LARGE VALUE: leads to a very informative prior for + ## sigma_k close to prQS/prQnu. Should only + ## be chosen in combination with hierarchical + ## prior on prQS. + Rhet <- 0.5 ## Rhet = 2/3 + phi <- (1 - Rhet) + } + prQS <- cov * phi * (prQnu - (r + 1) / 2) + if (r > 1) { + detprQS <- log(det(prQS)) + } + if (hier) { + if (rich.green) { + if (r == 1) { + g0 <- 0.2 ## Richardson and Green. Sampling from Gamma allows + ## arbitrary g0: + ## WARNING: seems to cause problems in bayesf + prQnu <- 2 ## Note that prQnu standard is changed here + } else if (r == 2) { + g0 <- 0.3 ## Stephens + ## WARNING: seems to cause problems in bayesf + prQnu <- 3 ## prQnu is changed also in relation from standard + } else { ## r > 2 + g0 <- 0.5 + (r - 1) / 2 + } + g0 <- 0.5 + (r - 1) / 2 + G0 <- 100 * g0 / prQnu * solve(cov) ## Stephens + prQS <- prQnu * cov / 100 ## define starting values for prQS + } else { ## Bensmail et al. + g0 <- 0.5 + (r - 1) / 2 ## in general g0 must be a multiple of 0.5 for the + ## Inverse Wishart (IW) to lead to a proper prior + G0 <- g0 * solve(prQS) ## match hierarchical and non-hierarchical priors } - prQS <- cov * phi * ( prQnu - ( r + 1 ) / 2 ) - if ( r > 1 ) { - detprQS <- log( det( prQS ) ) - } - if ( hier ) { - if ( rich.green ) { - if ( r == 1 ) { - g0 <- 0.2 ## Richardson and Green. Sampling from Gamma allows - ## arbitrary g0: - ## WARNING: seems to cause problems in bayesf - prQnu <- 2 ## Note that prQnu standard is changed here - } else if ( r == 2 ){ - g0 <- 0.3 ## Stephens - ## WARNING: seems to cause problems in bayesf - prQnu <- 3 ## prQnu is changed also in relation from standard - } else { ## r > 2 - g0 <- 0.5 + ( r - 1 ) / 2 - } - g0 <- 0.5 + ( r - 1 ) / 2 - G0 <- 100 * g0 / prQnu * solve( cov ) ## Stephens - prQS <- prQnu * cov / 100 ## define starting values for prQS - } else { ## Bensmail et al. - g0 <- 0.5 + ( r - 1 ) / 2 ## in general g0 must be a multiple of 0.5 for the - ## Inverse Wishart (IW) to lead to a proper prior - G0 <- g0 * solve( prQS ) ## match hierarchical and non-hierarchical priors - } - if ( r > 1 ) { - par.sigma <- list( c = array( prQnu, dim = c( 1, K ) ), - C = array( prQS, dim = c( r, r, K ) ), - logdetC = array( detprQS, dim = c( 1, K ) ), - g = g0, G = G0 ) - } else { ## r == 1 - par.sigma <- list( c = array( prQnu, dim = c( 1, K ) ), - C = array( prQS, dim = c( 1, K ) ), - g = g0, G = G0 ) - } - } else { ## non-hierarchical prior - if ( r > 1 ) { - par.sigma <- list(c = array( prQnu, dim = c( 1, K ) ), - C = array( prQS, dim = c( r, r, K ) ), - logdetC = array( detprQS, dim = c( 1, K ) ) ) - } - else { ## r == 1 - ## later distinguish between 'sigmauniform' and 'others' ## - par.sigma <- list( c = array( prQnu, dim = c( 1, K ) ), - C = array( prQS, dim = c( 1, K ) ) ) - } + if (r > 1) { + par.sigma <- list( + c = array(prQnu, dim = c(1, K)), + C = array(prQS, dim = c(r, r, K)), + logdetC = array(detprQS, dim = c(1, K)), + g = g0, G = G0 + ) + } else { ## r == 1 + par.sigma <- list( + c = array(prQnu, dim = c(1, K)), + C = array(prQS, dim = c(1, K)), + g = g0, G = G0 + ) } - obj@par <- list( mu = par.mu, sigma = par.sigma ) - return( obj ) + } else { ## non-hierarchical prior + if (r > 1) { + par.sigma <- list( + c = array(prQnu, dim = c(1, K)), + C = array(prQS, dim = c(r, r, K)), + logdetC = array(detprQS, dim = c(1, K)) + ) + } else { ## r == 1 + ## later distinguish between 'sigmauniform' and 'others' ## + par.sigma <- list( + c = array(prQnu, dim = c(1, K)), + C = array(prQS, dim = c(1, K)) + ) + } + } + obj@par <- list(mu = par.mu, sigma = par.sigma) + return(obj) } -".generateDfPrior" <- function( object ) -{ - ## default prior: independent hierarchical prior following Fernandéz and Steel (1999) - df.type <- "inhier" - df.trans <- 1 - df.a0 <- 2 - df.b0 <- 2 - df.mean <- 10 - df.d <- ( df.mean - df.trans ) * ( df.b0 - 1 ) - df <- list( type = df.type, trans = df.trans, - a0 = df.a0, b0 = df.b0, d = df.d ) - object@par$df <- df - return( object ) +".generateDfPrior" <- function(object) { + ## default prior: independent hierarchical prior following Fernandéz and Steel (1999) + df.type <- "inhier" + df.trans <- 1 + df.a0 <- 2 + df.b0 <- 2 + df.mean <- 10 + df.d <- (df.mean - df.trans) * (df.b0 - 1) + df <- list( + type = df.type, trans = df.trans, + a0 = df.a0, b0 = df.b0, d = df.d + ) + object@par$df <- df + return(object) } ### Prior weight: The prior distribution of the weights. ### @Distribution: Dirichlet -### @Parameters: +### @Parameters: ### e_1,...e_K, 1 x K ### A default with e_i = 4 for all i = 1, ..., K is chosen. -".generatePriorWeight" <- function( object, model ) -{ - K <- model@K - if( K > 1 && !model@indicfix ) { - e0 <- 4 - object@weight <- matrix( e0, nrow = 1, ncol = K ) - } - else { ## K = 1 - object@weight <- matrix() - } - return( object ) +".generatePriorWeight" <- function(object, model) { + K <- model@K + if (K > 1 && !model@indicfix) { + e0 <- 4 + object@weight <- matrix(e0, nrow = 1, ncol = K) + } else { ## K = 1 + object@weight <- matrix() + } + return(object) } -### Validity +### Validity ### Valid type: The prior @type must be one of the two choices -### 'independent' or 'condconjugate' (conditional conjugate). +### 'independent' or 'condconjugate' (conditional conjugate). ### For some distribution models only one type of prior exists: ### @Poisson: 'condconjugate' -".valid.type.Prior" <- function(obj) -{ - type.choices <- c("condconjugate", "independent") - if (!(obj@type %in% type.choices)) { - stop(paste("Unknown prior 'type'. 'type' must be", - "'independent' or 'condconjugate'.", - sep = "")) - } -# if (model.obj@dist == "poisson" && obj@type == "independent") { -# warning(paste("Wrong specification of slot 'type' in 'prior' ", -# "object with slot 'dist' in 'model' object set to ", -# "'poisson'. For Poisson mixtures only the prior ", -# "type 'condconjugate' is available.", sep = "")) -# } +".valid.type.Prior" <- function(obj) { + type.choices <- c("condconjugate", "independent") + if (!(obj@type %in% type.choices)) { + stop(paste("Unknown prior 'type'. 'type' must be", + "'independent' or 'condconjugate'.", + sep = "" + )) + } + # if (model.obj@dist == "poisson" && obj@type == "independent") { + # warning(paste("Wrong specification of slot 'type' in 'prior' ", + # "object with slot 'dist' in 'model' object set to ", + # "'poisson'. For Poisson mixtures only the prior ", + # "type 'condconjugate' is available.", sep = "")) + # } } ### The coefficient matrix 'coef.mat' for 'cond.poisson' @@ -1583,29 +1746,29 @@ setReplaceMethod( "setHier", "prior", ### Further it must be of type 'matrix' or 'array' with ### dimension K x K. ".valid.coefmat.Prior" <- function(model.obj, coef.mat) { - K <- model.obj@K - if (is.null(coef.mat)) { - stop("For a conditional Poisson mixture a coefficient matrix - 'coef.mat' has to be provided.") - } else if (!is.null(coef.mat)) { - if (!is.matrix(coef.mat) && !is.array(coef.mat)) { - stop("Argument 'coef.mat' must be of type 'matrix' or 'array'.") - } else if (nrow(coef.mat) != ncol(coef.mat)) { - stop("Argument 'coef.mat' must be a quadratic 'matrix' or 'array'.") - } else if (nrow(coef.mat) != K || ncol(coef.mat) != K) { - stop("Dimension of argument 'coef.mat' must correspond to number + K <- model.obj@K + if (is.null(coef.mat)) { + stop("For a conditional Poisson mixture a coefficient matrix + 'coef.mat' has to be provided.") + } else if (!is.null(coef.mat)) { + if (!is.matrix(coef.mat) && !is.array(coef.mat)) { + stop("Argument 'coef.mat' must be of type 'matrix' or 'array'.") + } else if (nrow(coef.mat) != ncol(coef.mat)) { + stop("Argument 'coef.mat' must be a quadratic 'matrix' or 'array'.") + } else if (nrow(coef.mat) != K || ncol(coef.mat) != K) { + stop("Dimension of argument 'coef.mat' must correspond to number of components 'K' in 'model'.\n") - } else if (!(all(diag(coef.mat) == 1))) { - stop("Coefficients on the diagonal of 'coef.mat' must be equal + } else if (!(all(diag(coef.mat) == 1))) { + stop("Coefficients on the diagonal of 'coef.mat' must be equal to one.\n") - } } + } } ### ------------------------------------------------------------------------------- ### .valid.fdata.model.Prior ### @description Checks for consistency between the specified model in slot -### @dist of the 'model' object and the dimension of variables +### @dist of the 'model' object and the dimension of variables ### @r in the 'fdata' object. Throws and error if no consistency ### exists. ### @par fdata.obj an S4 object of class 'fdata' @@ -1614,17 +1777,20 @@ setReplaceMethod( "setHier", "prior", ### @see ?fdata, ?model ### @author Lars Simon Zehnder ### -------------------------------------------------------------------------------- -".valid.fdata.model.Prior" <- function(fdata.obj, model.obj) -{ - if (model.obj@dist %in% .get.univ.Model() && fdata.obj@r > 1) { - stop(paste("Wrong specification of slot 'r' in 'fdata' object. ", - "Univariate distribution in slot 'dist' of 'model' ", - "object but dimension in slot 'r' of 'fdata' object ", - "greater 1.", sep = "")) - } else if (model.obj@dist %in% .get.multiv.Model() && fdata.obj@r < 2) { - stop(paste("Wrong specification of slot 'r' in 'fdata' object. ", - "Multivariate distribution in slot 'dist' of 'model' ", - "object but dimension in slot 'r' of 'fdata' object ", - "less than two.", sep = "")) - } +".valid.fdata.model.Prior" <- function(fdata.obj, model.obj) { + if (model.obj@dist %in% .get.univ.Model() && fdata.obj@r > 1) { + stop(paste("Wrong specification of slot 'r' in 'fdata' object. ", + "Univariate distribution in slot 'dist' of 'model' ", + "object but dimension in slot 'r' of 'fdata' object ", + "greater 1.", + sep = "" + )) + } else if (model.obj@dist %in% .get.multiv.Model() && fdata.obj@r < 2) { + stop(paste("Wrong specification of slot 'r' in 'fdata' object. ", + "Multivariate distribution in slot 'dist' of 'model' ", + "object but dimension in slot 'r' of 'fdata' object ", + "less than two.", + sep = "" + )) + } } diff --git a/R/sdatamoments.R b/R/sdatamoments.R index 2347f34..cf57041 100644 --- a/R/sdatamoments.R +++ b/R/sdatamoments.R @@ -16,63 +16,67 @@ # along with finmix. If not, see . .sdatamoments <- setClass("sdatamoments", - representation(gmoments = "groupmoments", - fdata = "fdata"), - validity = function(object) - { - ## else: OK - TRUE - } + representation( + gmoments = "groupmoments", + fdata = "fdata" + ), + validity = function(object) { + ## else: OK + TRUE + } ) setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) ## mutual constructor for both types of sdatamoments ## -"sdatamoments" <- function(value = fdata()) -{ - hasY(value, verbose = TRUE) - hasS(value, verbose = TRUE) - if (value@type == "discrete") { - object <- .sdatamoments(value = value) - } else { - object <- .csdatamoments(value = value) - } - return(object) +"sdatamoments" <- function(value = fdata()) { + hasY(value, verbose = TRUE) + hasS(value, verbose = TRUE) + if (value@type == "discrete") { + object <- .sdatamoments(value = value) + } else { + object <- .csdatamoments(value = value) + } + return(object) } -setMethod("initialize", "sdatamoments", - function(.Object, ..., value = fdata()) - { - .Object@fdata <- value - .Object@gmoments <- .groupmoments(value = value) - return(.Object) - } +setMethod( + "initialize", "sdatamoments", + function(.Object, ..., value = fdata()) { + .Object@fdata <- value + .Object@gmoments <- .groupmoments(value = value) + return(.Object) + } ) -setMethod("show", "sdatamoments", - function(object) - { - cat("Object 'sdatamoments'\n") - cat(" gmoments : Object of class", - class(object@gmoments), "\n") - cat(" fdata : Object of class", - class(object@fdata), "\n") - } +setMethod( + "show", "sdatamoments", + function(object) { + cat("Object 'sdatamoments'\n") + cat( + " gmoments : Object of class", + class(object@gmoments), "\n" + ) + cat( + " fdata : Object of class", + class(object@fdata), "\n" + ) + } ) ## Getters ## -setMethod("getGmoments", "sdatamoments", - function(object) - { - return(object@gmoments) - } +setMethod( + "getGmoments", "sdatamoments", + function(object) { + return(object@gmoments) + } ) -setMethod("getFdata", "sdatamoments", - function(object) - { - return(object@fdata) - } +setMethod( + "getFdata", "sdatamoments", + function(object) { + return(object@fdata) + } ) ## Setters ## diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index 7856ca2..9558edd 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -16,72 +16,92 @@ # along with finmix. If not, see . .studentmodelmoments <- setClass("studentmodelmoments", - representation(B = "numeric", - W = "numeric", - R = "numeric" - ), - contains = c("cmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype(B = numeric(), - W = numeric(), - R = numeric() - ) + representation( + B = "numeric", + W = "numeric", + R = "numeric" + ), + contains = c("cmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + B = numeric(), + W = numeric(), + R = numeric() + ) ) -setMethod("initialize", "studentmodelmoments", - function(.Object, ..., model) { - .Object <- callNextMethod(.Object, ..., model = model) - generateMoments(.Object) - } +setMethod( + "initialize", "studentmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + generateMoments(.Object) + } ) -setMethod("generateMoments", "studentmodelmoments", - function(object) { - .generateMomentsStudent(object) - } +setMethod( + "generateMoments", "studentmodelmoments", + function(object) { + .generateMomentsStudent(object) + } ) -setMethod("show", "studentmodelmoments", - function(object) { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" higher :", - paste(dim(object@higher), collapse = "x"), "\n") - cat(" skewness : Vector of", - length(object@skewness), "\n") - cat(" kurtosis : Vector of", - length(object@kurtosis), "\n") - cat(" B :", object@B, "\n") - cat(" W :", object@W, "\n") - cat(" R :", object@R, "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "studentmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " higher :", + paste(dim(object@higher), collapse = "x"), "\n" + ) + cat( + " skewness : Vector of", + length(object@skewness), "\n" + ) + cat( + " kurtosis : Vector of", + length(object@kurtosis), "\n" + ) + cat(" B :", object@B, "\n") + cat(" W :", object@W, "\n") + cat(" R :", object@R, "\n") + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) ## Getters ## -setMethod("getB", "studentmodelmoments", - function(object) { - return(object@B) - } +setMethod( + "getB", "studentmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getW", "studentmodelmoments", - function(object) { - return(object@W) - } +setMethod( + "getW", "studentmodelmoments", + function(object) { + return(object@W) + } ) -setMethod("getR", "studentmodelmoments", - function(object) { - return(object@R) - } +setMethod( + "getR", "studentmodelmoments", + function(object) { + return(object@R) + } ) ## No setters as users are not intended to manipulate ## @@ -90,20 +110,24 @@ setMethod("getR", "studentmodelmoments", ### Private functions ### These function are not exported ".generateMomentsStudent" <- function(object) { - mu <- object@model@par$mu - sigma <- object@model@par$sigma - df <- object@model@par$df - weight <- object@model@weight - object@mean <- sum(weight * mu) - object@higher <- .mixturemoments.student(object@model, - 4, object@mean) - dimnames(object@higher) <- list(c("1st", "2nd", "3rd", "4th"), - "") - object@var <- array(object@higher[2], dim = c(1, 1)) - object@skewness <- object@higher[3]/object@higher[2]^1.5 - object@kurtosis <- object@higher[4]/object@higher[2]^2 - object@B <- sum(weight * (mu - object@mean)^2) - object@W <- sum(weight * sigma * df/(df - 2)) - object@R <- 1 - object@W/object@var[1] - return(object) + mu <- object@model@par$mu + sigma <- object@model@par$sigma + df <- object@model@par$df + weight <- object@model@weight + object@mean <- sum(weight * mu) + object@higher <- .mixturemoments.student( + object@model, + 4, object@mean + ) + dimnames(object@higher) <- list( + c("1st", "2nd", "3rd", "4th"), + "" + ) + object@var <- array(object@higher[2], dim = c(1, 1)) + object@skewness <- object@higher[3] / object@higher[2]^1.5 + object@kurtosis <- object@higher[4] / object@higher[2]^2 + object@B <- sum(weight * (mu - object@mean)^2) + object@W <- sum(weight * sigma * df / (df - 2)) + object@R <- 1 - object@W / object@var[1] + return(object) } diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index 3dc3510..5f661a2 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -15,103 +15,122 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -.studmultmodelmoments <- setClass("studmultmodelmoments", - representation(B = "array", - W = "array", - Rdet = "numeric", - Rtr = "numeric", - corr = "array" - ), - contains = c("cmodelmoments"), - validity = function(object) { - ## else: OK - TRUE - }, - prototype( - B = array(), - W = array(), - Rdet= numeric(), - Rtr = numeric(), - corr= array() - ) +.studmultmodelmoments <- setClass("studmultmodelmoments", + representation( + B = "array", + W = "array", + Rdet = "numeric", + Rtr = "numeric", + corr = "array" + ), + contains = c("cmodelmoments"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype( + B = array(), + W = array(), + Rdet = numeric(), + Rtr = numeric(), + corr = array() + ) ) -setMethod("initialize", "studmultmodelmoments", - function(.Object, ..., model) - { - .Object <- callNextMethod(.Object, ..., model = model) - generateMoments(.Object) - } +setMethod( + "initialize", "studmultmodelmoments", + function(.Object, ..., model) { + .Object <- callNextMethod(.Object, ..., model = model) + generateMoments(.Object) + } ) -setMethod("generateMoments", "studmultmodelmoments", - function(object) - { - .generateMomentsStudmult(object) - } +setMethod( + "generateMoments", "studmultmodelmoments", + function(object) { + .generateMomentsStudmult(object) + } ) -setMethod("show", "studmultmodelmoments", - function(object) - { - cat("Object 'modelmoments'\n") - cat(" mean : Vector of", - length(object@mean), "\n") - cat(" var :", - paste(dim(object@var), collapse = "x"), "\n") - cat(" higher :", - paste(dim(object@higher), collapse = "x"),"\n") - cat(" skewness : Vector of", - length(object@skewness), "\n") - cat(" kurtosis : Vector of", - length(object@kurtosis), "\n") - cat(" B :", - paste(dim(object@B), collapse = "x"), "\n") - cat(" W :", - paste(dim(object@W), collapse = "x"), "\n") - cat(" Rdet :", object@Rdet, "\n") - cat(" Rtr :", object@Rtr, "\n") - cat(" corr :", - paste(dim(object@corr), collapse = "x"), "\n") - cat(" model : Object of class", - class(object@model), "\n") - } +setMethod( + "show", "studmultmodelmoments", + function(object) { + cat("Object 'modelmoments'\n") + cat( + " mean : Vector of", + length(object@mean), "\n" + ) + cat( + " var :", + paste(dim(object@var), collapse = "x"), "\n" + ) + cat( + " higher :", + paste(dim(object@higher), collapse = "x"), "\n" + ) + cat( + " skewness : Vector of", + length(object@skewness), "\n" + ) + cat( + " kurtosis : Vector of", + length(object@kurtosis), "\n" + ) + cat( + " B :", + paste(dim(object@B), collapse = "x"), "\n" + ) + cat( + " W :", + paste(dim(object@W), collapse = "x"), "\n" + ) + cat(" Rdet :", object@Rdet, "\n") + cat(" Rtr :", object@Rtr, "\n") + cat( + " corr :", + paste(dim(object@corr), collapse = "x"), "\n" + ) + cat( + " model : Object of class", + class(object@model), "\n" + ) + } ) ## Getters ## -setMethod("getB", "studmultmodelmoments", - function(object) - { - return(object@B) - } +setMethod( + "getB", "studmultmodelmoments", + function(object) { + return(object@B) + } ) -setMethod("getW", "studmultmodelmoments", - function(object) - { - return(object@W) - } +setMethod( + "getW", "studmultmodelmoments", + function(object) { + return(object@W) + } ) -setMethod("getRdet", "studmultmodelmoments", - function(object) - { - return(object@Rdet) - } +setMethod( + "getRdet", "studmultmodelmoments", + function(object) { + return(object@Rdet) + } ) -setMethod("getRtr", "studmultmodelmoments", - function(object) - { - return(object@Rtr) - } +setMethod( + "getRtr", "studmultmodelmoments", + function(object) { + return(object@Rtr) + } ) -setMethod("getCorr", "studmultmodelmoments", - function(object) - { - return(object@corr) - } +setMethod( + "getCorr", "studmultmodelmoments", + function(object) { + return(object@corr) + } ) ## No setters as users are not intended to manipulate ## @@ -119,64 +138,74 @@ setMethod("getCorr", "studmultmodelmoments", ### Private functions ### These function are not exported -".generateMomentsStudmult" <- function(object) -{ - mu <- object@model@par$mu - sigma <- object@model@par$sigma - df <- object@model@par$df - weight <- object@model@weight - names <- rep("", object@model@r) - for (i in seq(1, object@model@r)) { - names[i] <- paste("r=", i, sep = "") - } - object@mean <- apply(apply(mu, 1, '*', weight) - , 2, sum, na.rm = TRUE) - if(all(df > 2)) { - object@W <- apply(sweep(sigma, MARGIN = 3, - weight * df/(df - 2), '*'), - c(1, 2), sum, na.rm = TRUE) - object@var <- object@W + apply(apply(mu, 2, - tcrossprod, mu), - 1, '*', - weight) - object@var <- object@var - object@mean %*% t(object@mean) - diffm <- mu - object@mean - object@B <- apply(apply(diffm, 1, tcrossprod, diffm), - 1, '*', weight) - cd <- diag(1/diag(object@var)^.5) - object@corr <- cd %*% object@var %*% cd - object@Rtr <- 1 - sum(diag(object@W))/sum(diag(object@var)) - object@Rdet <- 1 - det(object@W)/det(object@var) - } else { - r <- object@model@r - object@W <- array(NaN, dim = c(r, r)) - object@var <- array(NaN, dim = c(r, r)) - object@B <- array(NaN, dim = c(r, r)) - object@Rdet <- NaN - object@Rtr <- NaN - object@corr <- array(NaN, dim = c(r, r)) - } - names(object@mean) <- names - colnames(object@var) <- names - rownames(object@var) <- names - colnames(object@B) <- names - rownames(object@B) <- names - colnames(object@W) <- names - rownames(object@W) <- names - colnames(object@corr) <- names - rownames(object@corr) <- names - highm <- array(0, dim = c(4, object@model@r)) - dimnames(highm) <- list(c("1st", "2nd", "3rd", "4th"), names) - for (i in seq(1, object@model@r)) { - marmodel <- mixturemar(object@model, i) - highm[, i] <- .mixturemoments.student(marmodel, 4, - object@mean[i]) - } - object@higher <- highm - object@skewness <- object@higher[3, ]/object@higher[2, ]^1.5 - object@kurtosis <- object@higher[4, ]/object@higher[2, ]^2 - return(object) +".generateMomentsStudmult" <- function(object) { + mu <- object@model@par$mu + sigma <- object@model@par$sigma + df <- object@model@par$df + weight <- object@model@weight + names <- rep("", object@model@r) + for (i in seq(1, object@model@r)) { + names[i] <- paste("r=", i, sep = "") + } + object@mean <- apply(apply(mu, 1, "*", weight), + 2, sum, + na.rm = TRUE + ) + if (all(df > 2)) { + object@W <- apply(sweep(sigma, + MARGIN = 3, + weight * df / (df - 2), "*" + ), + c(1, 2), sum, + na.rm = TRUE + ) + object@var <- object@W + apply( + apply( + mu, 2, + tcrossprod, mu + ), + 1, "*", + weight + ) + object@var <- object@var - object@mean %*% t(object@mean) + diffm <- mu - object@mean + object@B <- apply( + apply(diffm, 1, tcrossprod, diffm), + 1, "*", weight + ) + cd <- diag(1 / diag(object@var)^.5) + object@corr <- cd %*% object@var %*% cd + object@Rtr <- 1 - sum(diag(object@W)) / sum(diag(object@var)) + object@Rdet <- 1 - det(object@W) / det(object@var) + } else { + r <- object@model@r + object@W <- array(NaN, dim = c(r, r)) + object@var <- array(NaN, dim = c(r, r)) + object@B <- array(NaN, dim = c(r, r)) + object@Rdet <- NaN + object@Rtr <- NaN + object@corr <- array(NaN, dim = c(r, r)) + } + names(object@mean) <- names + colnames(object@var) <- names + rownames(object@var) <- names + colnames(object@B) <- names + rownames(object@B) <- names + colnames(object@W) <- names + rownames(object@W) <- names + colnames(object@corr) <- names + rownames(object@corr) <- names + highm <- array(0, dim = c(4, object@model@r)) + dimnames(highm) <- list(c("1st", "2nd", "3rd", "4th"), names) + for (i in seq(1, object@model@r)) { + marmodel <- mixturemar(object@model, i) + highm[, i] <- .mixturemoments.student( + marmodel, 4, + object@mean[i] + ) + } + object@higher <- highm + object@skewness <- object@higher[3, ] / object@higher[2, ]^1.5 + object@kurtosis <- object@higher[4, ] / object@higher[2, ]^2 + return(object) } - - - diff --git a/R/unass.R b/R/unass.R index 8ad77be..de9ddbd 100644 --- a/R/unass.R +++ b/R/unass.R @@ -1,31 +1,32 @@ -# Copyright (c) 2013 All Rights Reserved +# Copyright (c) 2013 All Rights Reserved # author: Barry Rowlingson # created: January 2013 # # This code has been copied from 'https://gist.github.com/spacedman/4543212' -# and is used in package 'finmix' to assign several modified objects -# to a list. +# and is used in package 'finmix' to assign several modified objects +# to a list. -unsass <- function(lhs,rhs) -{ - nvalues = length(rhs) - lhss = getFormulaNames(lhs) - if (length(lhss)!=nvalues) { +unsass <- function(lhs, rhs) { + nvalues <- length(rhs) + lhss <- getFormulaNames(lhs) + if (length(lhss) != nvalues) { stop("Wrong number of values to unpack") } - + for (i in 1:nvalues) { - eval(substitute(target <- value, - list(target=lhss[[i]],value=rhs[[i]])), - envir=parent.frame()) + eval(substitute( + target <- value, + list(target = lhss[[i]], value = rhs[[i]]) + ), + envir = parent.frame() + ) } invisible(0) } - -assign("%=%",unsass) -getFormulaNames <- function(formula) -{ +assign("%=%", unsass) + +getFormulaNames <- function(formula) { ## extract elements from a~b[1]~c~d ## recursive - might be an easier way... ## @@ -33,8 +34,8 @@ getFormulaNames <- function(formula) return(formula) } else { if (is.call(formula)) { - if (formula[[1]]=="~") { - return(c(getFormulaNames(formula[[2]]),getFormulaNames(formula[[3]]))) + if (formula[[1]] == "~") { + return(c(getFormulaNames(formula[[2]]), getFormulaNames(formula[[3]]))) } else { return(formula) } diff --git a/src/ADAPTER.h b/src/ADAPTER.h index d6637b1..36a7741 100644 --- a/src/ADAPTER.h +++ b/src/ADAPTER.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package 'finmix'. - * - * 'finmix' is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * 'finmix' is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package 'finmix'. +* +* 'finmix' is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* 'finmix' is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef ADAPTER_H @@ -31,14 +31,14 @@ // ============================================================= // ADAPTER class (to be reviewed) // ------------------------------------------------------------- -/* @brief Is used as the root for any layer combination. - * @detail This is the outer wrapper for a interlaced mixin - * layer construct. It defines a constructor for +/* @brief Is used as the root for any layer combination. + * @detail This is the outer wrapper for a interlaced mixin + * layer construct. It defines a constructor for * such that all necessary parameters can be provided. * It inherits directly from the base class BASE and * from any mxin layer above defined by 'Super'. * Note, that the ADAPTER has actually no extra 'Node' - * and 'Output' mixin defined. It just takes already + * and 'Output' mixin defined. It just takes already * defined (or better refined) inner mixins 'Node' and * 'Output' from its Super class. * @see BASE, HIER, POST, IND, FIX @@ -47,19 +47,21 @@ * ============================================================ * @review An adapter class is in this setting probably not * needed as all mixin layers have the same default - * parameters for their constructors respectively. + * parameters for their constructors respectively. * Therefore any interlacing with no restruction in * ordering can be done. * ------------------------------------------------------------ **/ template class ADAPTER : public Super, public BASE { - public: - ADAPTER () {} - ADAPTER (const FinmixData&, const FinmixModel&, const - FinmixPrior&, const FinmixMCMC&, Rcpp::S4&); - virtual void update (); - virtual void store (const unsigned int&); +public: +ADAPTER () +{ +} +ADAPTER (const FinmixData&, const FinmixModel&, const + FinmixPrior&, const FinmixMCMC&, Rcpp::S4&); +virtual void update(); +virtual void store(const unsigned int&); }; /** @@ -68,17 +70,17 @@ class ADAPTER : public Super, public BASE { * @brief Constructs an ADAPTER object of any type 'Super' * given as parameter to template. * @par data a FinmixData object to hold all data - * @par model a FinmixModel object to hold all model + * @par model a FinmixModel object to hold all model * information - * @par prior a FinmixPrior object to hold any information + * @par prior a FinmixPrior object to hold any information * about the model prior * @par mcmc a FinmixMCMC object to hold any configuration * parameters for the Gibbs sampling algorithm * @par classS4 a Rcpp::S4 class object containing all * containers for output storage. * @detail This is actually the main part of the ADAPTER. The - * constructor of the ADAPTER template contains all - * parameters needed to construct any upper mixin + * constructor of the ADAPTER template contains all + * parameters needed to construct any upper mixin * layers in an application. This constructor makes * arbitrary interlacing of mixin layers possible. * @see FIX, HIER, IND, POST, BASE @@ -87,8 +89,10 @@ class ADAPTER : public Super, public BASE { **/ template ADAPTER ::ADAPTER (const FinmixData& data, const FinmixModel& model, const - FinmixPrior& prior, const FinmixMCMC& mcmc, Rcpp::S4& classS4) : - Super(data, model, prior, mcmc, classS4), BASE() {} + FinmixPrior& prior, const FinmixMCMC& mcmc, Rcpp::S4& classS4) : + Super(data, model, prior, mcmc, classS4), BASE() +{ +} /** * ------------------------------------------------------- @@ -101,9 +105,9 @@ ADAPTER ::ADAPTER (const FinmixData& data, const FinmixModel& model, cons * ------------------------------------------------------- **/ template -void ADAPTER ::update () +void ADAPTER ::update() { - Super::update(); + Super::update(); } /** @@ -117,8 +121,8 @@ void ADAPTER ::update () * ------------------------------------------------------- **/ template -void ADAPTER ::store (const unsigned int& m) +void ADAPTER ::store(const unsigned int& m) { - Super::store(m); + Super::store(m); } #endif diff --git a/src/BASE.h b/src/BASE.h index b98af0a..eb9e1c2 100644 --- a/src/BASE.h +++ b/src/BASE.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package 'finmix'. - * - * 'finmix' is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * 'finmix' is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package 'finmix'. +* +* 'finmix' is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* 'finmix' is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef BASE_H @@ -32,38 +32,46 @@ // -------------------------------------------------------------- /** * @brief Base class for all mixin layers. - * @detail This is the base class for all mixin layers defined. - * In particular it defines next to constructor and - * destructor the virtual member functions 'BASE::update' - * and 'BASE::store' to be implemented or redefined by - * inheriting classes. + * @detail This is the base class for all mixin layers defined. + * In particular it defines next to constructor and + * destructor the virtual member functions 'BASE::update' + * and 'BASE::store' to be implemented or redefined by + * inheriting classes. * @see FIX, IND, POST, HIER, ADAPTER - * @author Lars Simon Zehnder + * @author Lars Simon Zehnder * * ============================================================== * @review As any combination of layers begins with the FIX * the latter one has no super class and needs thereby - * also no base class, as it defines 'Node' and + * also no base class, as it defines 'Node' and * 'Output' classes as well as 'update()' and 'store()' - * methods. The BASE class is probably only needed, if + * methods. The BASE class is probably only needed, if * there is no real hierarchy to the system of layers. * The same seems to hold for the adapter. * -------------------------------------------------------------- */ class BASE { - public: - BASE () {} - virtual ~BASE () {} - /* - * Function to update parameters. - * Specified in all classes inheriting - * from BASE - */ - virtual void update () {} - /* - * Function to store values. Specified - * all classes inheriting from BASE - */ - virtual void store (const unsigned int&) {} +public: +BASE () +{ +} +virtual ~BASE () +{ +} +/* + * Function to update parameters. + * Specified in all classes inheriting + * from BASE + */ +virtual void update() +{ +} +/* + * Function to store values. Specified + * all classes inheriting from BASE + */ +virtual void store(const unsigned int&) +{ +} }; #endif diff --git a/src/DataClass.h b/src/DataClass.h index 1a59788..c85f73b 100644 --- a/src/DataClass.h +++ b/src/DataClass.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef DATACLASS_H #define DATACLASS_H @@ -36,139 +36,151 @@ * entropy : entropy of the posterior classification probability distribution * postS : posterior of sampled classifications */ -struct DataClass { - - arma::mat logPy; - arma::mat prob; - arma::ivec newS; - arma::vec logLikCd; - double mixLik; - double entropy; - double postS; - +struct DataClass +{ + arma::mat logPy; + arma::mat prob; + arma::ivec newS; + arma::vec logLikCd; + double mixLik; + double entropy; + double postS; }; /** - * This function is used for all mixtures + * This function is used for all mixtures * */ -inline DataClass -classification (const arma::ivec &S, const liklist &lik, - const arma::rowvec& weight) +inline DataClass +classification(const arma::ivec &S, const liklist &lik, + const arma::rowvec& weight) { - - const unsigned int N = S.n_elem; - const unsigned int K = weight.n_elem; - double postS = 0.0; - DataClass dataC = DataClass(); + const unsigned int N = S.n_elem; + const unsigned int K = weight.n_elem; + double postS = 0.0; + DataClass dataC = DataClass(); // lik.lh.print("lh: "); // lik.llh.print("llh: "); - /* if indicators are not fix, they are simulated */ - arma::mat p_m(N, K); - arma::ivec newS(N); - /* only multinomial indicator model implemented */ - for(unsigned int i = 0; i < N; ++i) { - p_m.row(i) = lik.lh.row(i) % weight; - } - arma::vec sump_v = arma::sum(p_m, 1); // N x 1 matrix - arma::vec lsump = arma::log(sump_v) + lik.maxl; // N x 1 matrix - double mixlik = arma::sum(lsump); // mixture likelihood - p_m.each_col() /= sump_v; // classification probability matrix - // N x K matrix - - dataC.prob = p_m; - /* simulate only if true mixture */ - if(K > 1) { - /* simulate classifications from probability matrix p */ - arma::vec rnd(N); - GetRNGstate(); - for(unsigned int i = 0; i < N; ++i) { - rnd(i) = R::runif(0.0, 1.0); - } - PutRNGstate(); - arma::mat rndM = arma::repmat(rnd, 1, K); // N x K matrix - arma::mat cumSP = arma::cumsum(p_m, 1); // cumulate along rows, N x K matrix - arma::umat ind = (cumSP > rndM); - rndM = arma::conv_to::from(ind); // logical N x K matrix - newS = arma::conv_to::from(arma::sum(rndM, 1)); // new classifications - - /* compute posterior log likelihood of S */ - arma::imat Sm = arma::repmat(newS, 1, K); // N x K matrix of S - arma::imat compM = arma::ones(N, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - ind = (Sm == compM); // logical N x K matrix - arma::mat indDouble = arma::conv_to::from(ind); - arma::vec postSm = arma::sum(indDouble % p_m, 1); // sum along rows - postSm = arma::log(postSm); - postS = arma::sum(postSm); - } - - - /* calculate entropy */ - arma::mat logp(N, K); - arma::uvec col_index(1); - for(unsigned int k = 0; k < K; ++k) { - col_index(0) = k; - arma::uvec zero_index = arma::find(p_m.col(k) == 0); - arma::uvec index = arma::find(p_m.col(k)); - logp.submat(zero_index, col_index).fill(-99.00); - logp.submat(index, col_index) = arma::log(p_m.submat(index, col_index)); - } - double entropy = (-1.0) * arma::accu(logp % p_m); - dataC.logPy = lik.llh; - dataC.prob = p_m; - dataC.newS = newS; - dataC.mixLik = mixlik; - dataC.entropy = entropy; - dataC.postS = postS; - - return dataC; + /* if indicators are not fix, they are simulated */ + arma::mat p_m(N, K); + arma::ivec newS(N); + + /* only multinomial indicator model implemented */ + for (unsigned int i = 0; i < N; ++i) + { + p_m.row(i) = lik.lh.row(i) % weight; + } + arma::vec sump_v = arma::sum(p_m, 1); // N x 1 matrix + arma::vec lsump = arma::log(sump_v) + lik.maxl; // N x 1 matrix + double mixlik = arma::sum(lsump); // mixture likelihood + + p_m.each_col() /= sump_v; // classification probability matrix + // N x K matrix + + dataC.prob = p_m; + /* simulate only if true mixture */ + if (K > 1) + { + /* simulate classifications from probability matrix p */ + arma::vec rnd(N); + GetRNGstate(); + for (unsigned int i = 0; i < N; ++i) + { + rnd(i) = R::runif(0.0, 1.0); + } + PutRNGstate(); + arma::mat rndM = arma::repmat(rnd, 1, K); // N x K matrix + arma::mat cumSP = arma::cumsum(p_m, 1); // cumulate along rows, N x K matrix + arma::umat ind = (cumSP > rndM); + rndM = arma::conv_to::from(ind); // logical N x K matrix + newS = arma::conv_to::from(arma::sum(rndM, 1)); // new classifications + + /* compute posterior log likelihood of S */ + arma::imat Sm = arma::repmat(newS, 1, K); // N x K matrix of S + arma::imat compM = arma::ones(N, K); + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + ind = (Sm == compM); // logical N x K matrix + arma::mat indDouble = arma::conv_to::from(ind); + arma::vec postSm = arma::sum(indDouble % p_m, 1); // sum along rows + postSm = arma::log(postSm); + postS = arma::sum(postSm); + } + + + /* calculate entropy */ + arma::mat logp(N, K); + arma::uvec col_index(1); + + for (unsigned int k = 0; k < K; ++k) + { + col_index(0) = k; + arma::uvec zero_index = arma::find(p_m.col(k) == 0); + arma::uvec index = arma::find(p_m.col(k)); + logp.submat(zero_index, col_index).fill(-99.00); + logp.submat(index, col_index) = arma::log(p_m.submat(index, col_index)); + } + double entropy = (-1.0) * arma::accu(logp % p_m); + + dataC.logPy = lik.llh; + dataC.prob = p_m; + dataC.newS = newS; + dataC.mixLik = mixlik; + dataC.entropy = entropy; + dataC.postS = postS; + + return dataC; } -/** +/** * ------------------------------------------------------------- * classification_fix - * @brief Computes the complete data mixture log- likelihood + * @brief Computes the complete data mixture log- likelihood * for a model with fixed indicators. * @par K number of components * @par S fixed indicators * @par liklist a liklist object holding the likelihoods and log * log-likelihoods for each observation and com- - * ponent as well as the maximum likelihood over + * ponent as well as the maximum likelihood over * components. * @details computes the complete data likelihood by summing the * log-likelihoods over the component of each ob- - * servation indicated by S. + * servation indicated by S. * @see liklist * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ inline DataClass -classification_fix(const unsigned int K, const arma::ivec& S, - const liklist& lik) +classification_fix(const unsigned int K, const arma::ivec& S, + const liklist& lik) { - arma::vec loglikcd(K); - arma::uvec col_index(1); - if(K > 1) { - for(unsigned int k = 0; k < K; ++k) { - col_index(0) = k; - arma::uvec index = arma::find(S == k); - loglikcd(k) = arma::accu(lik.llh.submat(index, col_index)); - } - } - else { /* no true mixture */ - arma::vec sump_v = sum(lik.lh, 1); - arma::vec lsump = arma::log(sump_v) + lik.maxl; - double mixlik = arma::sum(lsump); - //TODO: check if better to fill all K entries with mixlik - loglikcd(0, 0) = mixlik; - } - DataClass dataC; - dataC.logPy = lik.llh; - dataC.logLikCd = loglikcd; - return dataC; + arma::vec loglikcd(K); + arma::uvec col_index(1); + + if (K > 1) + { + for (unsigned int k = 0; k < K; ++k) + { + col_index(0) = k; + arma::uvec index = arma::find(S == k); + loglikcd(k) = arma::accu(lik.llh.submat(index, col_index)); + } + } + else /* no true mixture */ + { + arma::vec sump_v = sum(lik.lh, 1); + arma::vec lsump = arma::log(sump_v) + lik.maxl; + double mixlik = arma::sum(lsump); + //TODO: check if better to fill all K entries with mixlik + loglikcd(0, 0) = mixlik; + } + DataClass dataC; + + dataC.logPy = lik.llh; + dataC.logLikCd = loglikcd; + return dataC; } #endif diff --git a/src/FIX.h b/src/FIX.h index d1ebe53..50fc93a 100644 --- a/src/FIX.h +++ b/src/FIX.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef FIX_H #define FIX_H @@ -35,7 +35,7 @@ // ------------------------------------------------------------------- /* * @brief Mixin layer to implement the collaboration between 'Node' - * and 'Output' objects in case of Gibbs sampling with fixed + * and 'Output' objects in case of Gibbs sampling with fixed * indicators. * @par PriorType parameter for prior distribution * @par ParType parameter for posterior distribution @@ -44,107 +44,109 @@ * @detail Any implemented mixin layer describes the whole collabo- * ration between 'Node' and 'Output' object to perform a * Gibbs sampling of posterior parameters. The FIX mixin - * defines the two inner mixins 'Node' and 'Output' with - * variables needed to perform all actions for Gibbs - * sampling with fixed indicators (or for mixtures with one - * component only). These are e.g. variables needed to + * defines the two inner mixins 'Node' and 'Output' with + * variables needed to perform all actions for Gibbs + * sampling with fixed indicators (or for mixtures with one + * component only). These are e.g. variables needed to * configure the algorithm, to perform random permutation * Gibbs sampling, etc. - * The template parameters PriorType, ParType and LogType - * determine the specific model for that a Gibbs sampling - * should be performed. In particular they must specifiy + * The template parameters PriorType, ParType and LogType + * determine the specific model for that a Gibbs sampling + * should be performed. In particular they must specifiy * parameters and an 'update()' function that can be called - * from the inner mixin 'Node's 'update()' function. The - * ParOutType parameter determines the specific storage - * prcocess for the parameters of a chosen model and has to be - * provided. It must contain a 'store()' method that can be - * called from the inner mixin 'Output's 'store()' function. + * from the inner mixin 'Node's 'update()' function. The + * ParOutType parameter determines the specific storage + * prcocess for the parameters of a chosen model and has to be + * provided. It must contain a 'store()' method that can be + * called from the inner mixin 'Output's 'store()' function. * @see IND, HIER, POST, ADAPTER, BASE * @author Lars SImon Zehnder * ------------------------------------------------------------------ */ -template +template class FIX { - public: - /** - * --------------------------------------------------------- - * Node mixin - * --------------------------------------------------------- - * - * @brief Holds all variables and method to perform the - * steps of a Gibbs sampler. - * @detail This class defines the variables needed for - * configuration of the algorithm as well as random - * permutation Gibbs sampling. The workhorse of this - * mixin is the virtual method 'update()' that - * performs the update step and calls any 'update()' - * function of related classes. - * @see IND, HIER, POST, ADAPTER, BASE - * -------------------------------------------------------- - */ - class Node { - public: - const unsigned int K; - const unsigned int N; - const unsigned int M; - const unsigned int BURNIN; - const unsigned int STORES; - const bool INDICFIX; - const bool STARTPAR; - const bool HIER; - const bool RANPERM; - const bool STOREPOST; - PriorType hyperPar; - ParType par; - LogType log; - const arma::mat y; - arma::ivec S; - const arma::mat expos; - const arma::vec T; - arma::urowvec compIndex; - arma::urowvec permIndex; - arma::urowvec compIndex2; +public: +/** + * --------------------------------------------------------- + * Node mixin + * --------------------------------------------------------- + * + * @brief Holds all variables and method to perform the + * steps of a Gibbs sampler. + * @detail This class defines the variables needed for + * configuration of the algorithm as well as random + * permutation Gibbs sampling. The workhorse of this + * mixin is the virtual method 'update()' that + * performs the update step and calls any 'update()' + * function of related classes. + * @see IND, HIER, POST, ADAPTER, BASE + * -------------------------------------------------------- + */ +class Node { +public: +const unsigned int K; +const unsigned int N; +const unsigned int M; +const unsigned int BURNIN; +const unsigned int STORES; +const bool INDICFIX; +const bool STARTPAR; +const bool HIER; +const bool RANPERM; +const bool STOREPOST; +PriorType hyperPar; +ParType par; +LogType log; +const arma::mat y; +arma::ivec S; +const arma::mat expos; +const arma::vec T; +arma::urowvec compIndex; +arma::urowvec permIndex; +arma::urowvec compIndex2; - Node (const FinmixData&, const FinmixModel&, - const FinmixPrior&, const FinmixMCMC&); - virtual void update (); - }; - /** - * ------------------------------------------------------- - * Output mixin - * ------------------------------------------------------- - * - * @brief Stores all sampled parameters and additional - * information in container pointers. - * @detail This class defines container pointers needed - * to store any information from sampling. - * The workhorse of this inner mixin is the - * 'store()' method that performs the storing - * process thereby calling all 'store()' methods - * of related classes. - * @see IND, BASE, HIER, POST, ADAPTER - * ------------------------------------------------------ - */ - class Output { - public: - const unsigned int M; - const bool RANPERM; - ParOutType par; - arma::vec* mixlik; - arma::vec* mixprior; - - Output (Rcpp::S4&); - virtual void store (const unsigned int&, Node&); - }; - Node node; - Output output; +Node (const FinmixData&, const FinmixModel&, + const FinmixPrior&, const FinmixMCMC&); +virtual void update(); +}; +/** + * ------------------------------------------------------- + * Output mixin + * ------------------------------------------------------- + * + * @brief Stores all sampled parameters and additional + * information in container pointers. + * @detail This class defines container pointers needed + * to store any information from sampling. + * The workhorse of this inner mixin is the + * 'store()' method that performs the storing + * process thereby calling all 'store()' methods + * of related classes. + * @see IND, BASE, HIER, POST, ADAPTER + * ------------------------------------------------------ + */ +class Output { +public: +const unsigned int M; +const bool RANPERM; +ParOutType par; +arma::vec* mixlik; +arma::vec* mixprior; - FIX (const FinmixData&, const FinmixModel&, const FinmixPrior&, - const FinmixMCMC&, Rcpp::S4&); - virtual ~FIX () {} - virtual void update (); - virtual void store (const unsigned int&); +Output (Rcpp::S4&); +virtual void store(const unsigned int&, Node&); +}; +Node node; +Output output; + +FIX (const FinmixData&, const FinmixModel&, const FinmixPrior&, + const FinmixMCMC&, Rcpp::S4&); +virtual ~FIX () +{ +} +virtual void update(); +virtual void store(const unsigned int&); }; // ============================================================ @@ -161,51 +163,54 @@ class FIX { * ------------------------------------------------------------ **/ template + typename ParOutType> FIX ::Node::Node (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, - const FinmixMCMC& mcmc) : - K(model.K), N(data.N), M(mcmc.M), BURNIN(mcmc.burnIn), - STORES(mcmc.storeS), INDICFIX(model.indicFix), - STARTPAR(mcmc.startPar), HIER(prior.hier), - RANPERM(mcmc.ranPerm), STOREPOST(mcmc.storePost), - hyperPar(prior), par(mcmc.startPar, model), log(), - y(data.y), S(data.S), expos(data.expos), T(data.T), - compIndex(model.K), permIndex(model.K), compIndex2(model.K) + const FinmixModel& model, const FinmixPrior& prior, + const FinmixMCMC& mcmc) : + K(model.K), N(data.N), M(mcmc.M), BURNIN(mcmc.burnIn), + STORES(mcmc.storeS), INDICFIX(model.indicFix), + STARTPAR(mcmc.startPar), HIER(prior.hier), + RANPERM(mcmc.ranPerm), STOREPOST(mcmc.storePost), + hyperPar(prior), par(mcmc.startPar, model), log(), + y(data.y), S(data.S), expos(data.expos), T(data.T), + compIndex(model.K), permIndex(model.K), compIndex2(model.K) { - for (unsigned int k = 0; k < K; ++k) { - compIndex(k) = k; - } + for (unsigned int k = 0; k < K; ++k) + { + compIndex(k) = k; + } } /** * ----------------------------------------------------------- * Node::update * @brief Updates the 'node' object. - * @detail Virtual. Performs any updates on parameters and + * @detail Virtual. Performs any updates on parameters and * then starts random permutation of sampled parameters. * It is this function, that is passed forward via * inheritance to any other mixin. - * @see IND::Node::update, POST::Node::update, + * @see IND::Node::update, POST::Node::update, * HIER::Node::update * @author Lars Simon Zehnder * ----------------------------------------------------------- **/ template -void FIX ::Node::update () + typename ParOutType> +void FIX ::Node::update() { - hyperPar.update(K, y, S, T, par); - par.update(hyperPar); - hyperPar.updateHier(par); - log.update(K, y, S, expos, T, par, hyperPar); - if(RANPERM && K > 1) { - permIndex = arma::shuffle(compIndex, 1); - compIndex2 = (permIndex == compIndex); - if(arma::sum(compIndex) != K) { - par.permute(compIndex, permIndex); - } - } + hyperPar.update(K, y, S, T, par); + par.update(hyperPar); + hyperPar.updateHier(par); + log.update(K, y, S, expos, T, par, hyperPar); + if (RANPERM && K > 1) + { + permIndex = arma::shuffle(compIndex, 1); + compIndex2 = (permIndex == compIndex); + if (arma::sum(compIndex) != K) + { + par.permute(compIndex, permIndex); + } + } } // ========================================================== @@ -218,14 +223,14 @@ void FIX ::Node::update () * @brief Constructs an object of class 'Output' inside of * the mixin layer. * @par classS4 object of class Rcpp::S4 - * @detail 'classS4' is an R S4 class object wrapped by an - * Rcpp::S4 object holding a certain structure of + * @detail 'classS4' is an R S4 class object wrapped by an + * Rcpp::S4 object holding a certain structure of * containers to store sampled parameters, log-like- - * lihoods, etc. Note, the Rcpp::S4 object references - * in its objects to memory allocated in R. To avoid - * copying memory, pointers are used to represent the - * containers in the C++ application. For each - * Armadillo object its advanced constructor is + * lihoods, etc. Note, the Rcpp::S4 object references + * in its objects to memory allocated in R. To avoid + * copying memory, pointers are used to represent the + * containers in the C++ application. For each + * Armadillo object its advanced constructor is * called to reuse auxiliary memory and fix the size. * @see FIX::Output::Output, HIER::Output::Output, * POST::Output::Output, Rcpp::S4, ?S4 (in R), arma::mat @@ -233,16 +238,17 @@ void FIX ::Node::update () * ---------------------------------------------------------- **/ template -FIX ::Output::Output (Rcpp::S4& classS4) : - M(Rcpp::as((SEXP) classS4.slot("M"))), - RANPERM(Rcpp::as((SEXP) classS4.slot("ranperm"))), - par(Rcpp::as((SEXP) classS4.slot("par"))) +FIX ::Output::Output (Rcpp::S4& classS4) : + M(Rcpp::as((SEXP)classS4.slot("M"))), + RANPERM(Rcpp::as((SEXP)classS4.slot("ranperm"))), + par(Rcpp::as((SEXP)classS4.slot("par"))) { - Rcpp::List tmpLog((SEXP) classS4.slot("log")); - Rcpp::NumericVector tmpMixLik((SEXP) tmpLog["mixlik"]); - Rcpp::NumericVector tmpMixPrior((SEXP) tmpLog["mixprior"]); - mixlik = new arma::vec(tmpMixLik.begin(), M, false, true); - mixprior = new arma::vec(tmpMixPrior.begin(), M, false, true); + Rcpp::List tmpLog((SEXP)classS4.slot("log")); + Rcpp::NumericVector tmpMixLik((SEXP)tmpLog["mixlik"]); + Rcpp::NumericVector tmpMixPrior((SEXP)tmpLog["mixprior"]); + + mixlik = new arma::vec(tmpMixLik.begin(), M, false, true); + mixprior = new arma::vec(tmpMixPrior.begin(), M, false, true); } /** @@ -251,29 +257,30 @@ FIX ::Output::Output (Rcpp::S4& classS4 * @brief Stores the sampled parameters into containers. * @par m iteration count * @par node object this->Node - * @detail Takes the iteration number and a 'Node' object + * @detail Takes the iteration number and a 'Node' object * holding all information from one sampling step * and stores it to the containers pointed to in- - * side the 'Output' class. It thereby always - * checks if the iteration is part of the burnin + * side the 'Output' class. It thereby always + * checks if the iteration is part of the burnin * phase or the sampling phase, if indicators * should be stored at all, etc. * @see IND::Output::store, HIER::Output::store, - * POST::Output::store, + * POST::Output::store, * @author Lars Simon Zehnder * --------------------------------------------------------- **/ template -void FIX ::Output::store (const unsigned - int& m, Node& node) + typename ParOutType> +void FIX ::Output::store(const unsigned + int& m, Node& node) { - if (m >= node.BURNIN) { - const unsigned int index = m - node.BURNIN; - (*mixlik)(index) = node.log.mixlik; - (*mixprior)(index) = node.log.mixprior; - par.store(index, node.par); - } + if (m >= node.BURNIN) + { + const unsigned int index = m - node.BURNIN; + (*mixlik)(index) = node.log.mixlik; + (*mixprior)(index) = node.log.mixprior; + par.store(index, node.par); + } } // ======================================================== @@ -287,28 +294,30 @@ void FIX ::Output::store (const unsigne * layer. * @par data object of class FinmixData, holds the data * @par model object of class FinmixModel, holds model - * information + * information * @par prior object of class FinmixPrior, holds prior * information - * @par mcmc object of class FinmixMCMC, holds info for + * @par mcmc object of class FinmixMCMC, holds info for * algorithmic configurations * @par classS4 object of class Rcpp::S4 to pass output * container pointer * @detail Note, that this constructor must include all * parameters needed in construction of the inner * mixins. - * @see FinmixData, FinmixModel, FinmixPrior, + * @see FinmixData, FinmixModel, FinmixPrior, * FinmixMCMC, Rcpp::S4, IND::IND, * POST::POST, HIER::HIER * @author Lars Simon Zehnder * ------------------------------------------------------- **/ template + typename ParOutType> FIX ::FIX (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, const FinmixMCMC& - mcmc, Rcpp::S4& classS4) : - node(data, model, prior, mcmc), output(classS4) {} + const FinmixModel& model, const FinmixPrior& prior, const FinmixMCMC& + mcmc, Rcpp::S4& classS4) : + node(data, model, prior, mcmc), output(classS4) +{ +} /** * ------------------------------------------------------- @@ -320,11 +329,11 @@ FIX ::FIX (const FinmixData& data, * @author Lars Simon Zehnder * ------------------------------------------------------- **/ -template -void FIX ::update () +template +void FIX ::update() { - node.update(); + node.update(); } /** @@ -338,9 +347,9 @@ void FIX ::update () * ------------------------------------------------------- **/ template -void FIX ::store (const unsigned int& m) + typename ParOutType> +void FIX ::store(const unsigned int& m) { - output.store(m, node); + output.store(m, node); } #endif diff --git a/src/FinmixData.h b/src/FinmixData.h index a2c5b9d..84d5869 100644 --- a/src/FinmixData.h +++ b/src/FinmixData.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef FINMIXDATA_H #define FINMIXDATA_H @@ -28,29 +28,33 @@ #include class FinmixData { - public: - arma::mat y; - arma::ivec S; - arma::vec expos; - arma::vec T; - /** - * finmix 'data' objects arriving in C++ - * are always column-wise ordered - * therefore slot 'bycolumn' is left out - */ - std::string dataType; - unsigned int N; - unsigned int r; - - /* constructor */ - FinmixData (Rcpp::S4& classS4) : - y(Rcpp::as((SEXP) classS4.slot("y"))), - S(Rcpp::as((SEXP) classS4.slot("S"))), - expos(Rcpp::as((SEXP) classS4.slot("exp"))), - T(Rcpp::as((SEXP) classS4.slot("T"))), - dataType(Rcpp::as((SEXP) classS4.slot("type"))), - N(Rcpp::as((SEXP) classS4.slot("N"))), - r(Rcpp::as((SEXP) classS4.slot("r"))) {} - ~FinmixData () {} +public: +arma::mat y; +arma::ivec S; +arma::vec expos; +arma::vec T; +/** + * finmix 'data' objects arriving in C++ + * are always column-wise ordered + * therefore slot 'bycolumn' is left out + */ +std::string dataType; +unsigned int N; +unsigned int r; + +/* constructor */ +FinmixData (Rcpp::S4& classS4) : + y(Rcpp::as((SEXP)classS4.slot("y"))), + S(Rcpp::as((SEXP)classS4.slot("S"))), + expos(Rcpp::as((SEXP)classS4.slot("exp"))), + T(Rcpp::as((SEXP)classS4.slot("T"))), + dataType(Rcpp::as((SEXP)classS4.slot("type"))), + N(Rcpp::as((SEXP)classS4.slot("N"))), + r(Rcpp::as((SEXP)classS4.slot("r"))) +{ +} +~FinmixData () +{ +} }; #endif diff --git a/src/FinmixMCMC.h b/src/FinmixMCMC.h index 6a0120d..a47aa78 100644 --- a/src/FinmixMCMC.h +++ b/src/FinmixMCMC.h @@ -1,50 +1,53 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef FINMIXMCMC_H #define FINMIXMCMC_H #include class FinmixMCMC { - - public: - unsigned int burnIn; - unsigned int M; - bool startPar; - unsigned int storeS; - bool storePost; - bool ranPerm; - - /* ctor */ - FinmixMCMC (Rcpp::S4& classS4) : - burnIn(Rcpp::as((SEXP) classS4.slot("burnin"))), - M(Rcpp::as((SEXP) classS4.slot("M"))), - startPar(Rcpp::as((SEXP) classS4.slot("startpar"))), - storeS(Rcpp::as((SEXP) classS4.slot("storeS"))), - storePost(Rcpp::as((SEXP) classS4.slot("storepost"))), - ranPerm(Rcpp::as((SEXP) classS4.slot("ranperm"))) {} - - /* dtor */ - ~FinmixMCMC() {} +public: +unsigned int burnIn; +unsigned int M; +bool startPar; +unsigned int storeS; +bool storePost; +bool ranPerm; + +/* ctor */ +FinmixMCMC (Rcpp::S4& classS4) : + burnIn(Rcpp::as((SEXP)classS4.slot("burnin"))), + M(Rcpp::as((SEXP)classS4.slot("M"))), + startPar(Rcpp::as((SEXP)classS4.slot("startpar"))), + storeS(Rcpp::as((SEXP)classS4.slot("storeS"))), + storePost(Rcpp::as((SEXP)classS4.slot("storepost"))), + ranPerm(Rcpp::as((SEXP)classS4.slot("ranperm"))) +{ +} + +/* dtor */ +~FinmixMCMC() +{ +} }; #endif diff --git a/src/FinmixModel.h b/src/FinmixModel.h index 2e670ca..45b0f02 100644 --- a/src/FinmixModel.h +++ b/src/FinmixModel.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef FINMIXMODEL_H #define FINMIXMODEL_H @@ -27,24 +27,27 @@ #include class FinmixModel { - - public: - Rcpp::List par; - arma::rowvec weight; - - bool indicFix; - unsigned int K; - unsigned int r; - - /* ctor */ - FinmixModel (Rcpp::S4& classS4) : - par(classS4.slot("par")), - weight(Rcpp::as((SEXP) classS4.slot("weight"))), - indicFix(Rcpp::as((SEXP) classS4.slot("indicfix"))), - K(Rcpp::as((SEXP) classS4.slot("K"))), - r(Rcpp::as((SEXP) classS4.slot("r"))) {} - - /* dtor */ - ~FinmixModel() {} +public: +Rcpp::List par; +arma::rowvec weight; + +bool indicFix; +unsigned int K; +unsigned int r; + +/* ctor */ +FinmixModel (Rcpp::S4& classS4) : + par(classS4.slot("par")), + weight(Rcpp::as((SEXP)classS4.slot("weight"))), + indicFix(Rcpp::as((SEXP)classS4.slot("indicfix"))), + K(Rcpp::as((SEXP)classS4.slot("K"))), + r(Rcpp::as((SEXP)classS4.slot("r"))) +{ +} + +/* dtor */ +~FinmixModel() +{ +} }; #endif diff --git a/src/FinmixPrior.h b/src/FinmixPrior.h index 8791b00..88bda7c 100644 --- a/src/FinmixPrior.h +++ b/src/FinmixPrior.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_FINMIXPRIOR_H__ #define __FINMIX_FINMIXPRIOR_H__ @@ -27,19 +27,20 @@ #include class FinmixPrior { - - public: - Rcpp::List par; - arma::rowvec weight; - - std::string type; - bool hier; - - /* ctor */ - FinmixPrior (Rcpp::S4& classS4) : - par(Rcpp::as((SEXP) classS4.slot("par"))), - weight(Rcpp::as((SEXP) classS4.slot("weight"))), - type(Rcpp::as((SEXP) classS4.slot("type"))), - hier(Rcpp::as((SEXP) classS4.slot("hier"))) {} +public: +Rcpp::List par; +arma::rowvec weight; + +std::string type; +bool hier; + +/* ctor */ +FinmixPrior (Rcpp::S4& classS4) : + par(Rcpp::as((SEXP)classS4.slot("par"))), + weight(Rcpp::as((SEXP)classS4.slot("weight"))), + type(Rcpp::as((SEXP)classS4.slot("type"))), + hier(Rcpp::as((SEXP)classS4.slot("hier"))) +{ +} }; #endif // __FINMIX_FINMIXPRIOR_H__ diff --git a/src/HIER.h b/src/HIER.h index 3e89d2c..17ed5f6 100644 --- a/src/HIER.h +++ b/src/HIER.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef HIER_H #define HIER_H @@ -30,16 +30,16 @@ // ------------------------------------------------------------------- /* * @brief Mixin layer to implement the collaboration between 'Node' - * and 'Output' objects in case of Gibbs sampling with + * and 'Output' objects in case of Gibbs sampling with * indicators. * @par Super next mixin layer in the application * @detail Any implemented mixin layer describes the whole collabo- * ration between 'Node' and 'Output' object to perform a * Gibbs sampling with hierarchical prior. The HIER mixin - * layer refines thereby its 'Super' class by defining + * layer refines thereby its 'Super' class by defining * new inner mixins 'Node' and 'Output' with additional - * variables needed to perform all actions for Gibbs - * sampling with hierarchical priors. These are e.g. + * variables needed to perform all actions for Gibbs + * sampling with hierarchical priors. These are e.g. * the additional container in the 'Output' mixin to store * sampled hyper parameters. * @see FIX, IND, POST, ADAPTER, BASE @@ -48,71 +48,77 @@ */ template class HIER : public Super { - public: - /** - * --------------------------------------------------------- - * Node mixin - * --------------------------------------------------------- - * - * @brief Holds all variables and method to perform the - * steps of a Gibbs sampler. - * @detail This class inherits directly from the 'Super' - * class' 'Node' mixin. The workhorse of this mixin - * is the inherited virtual method 'update()' that - * performs the update step and calls any 'update()' - * function of related classes. Hierarchical - * parameters are then updated in the related - * classes whose 'update()' method gets called and - * knows what to do. - * @see FIX, IND, POST, ADAPTER, BASE - * -------------------------------------------------------- - */ - class Node : public Super::Node { - public: - Node (const FinmixData&, - const FinmixModel&, - const FinmixPrior&, - const FinmixMCMC&); - virtual ~Node () {} - }; - /** - * ------------------------------------------------------- - * Output mixin - * ------------------------------------------------------- - * - * @brief Stores all sampled parameters and additional - * information in container pointers. - * @detail This class inherits directly from the 'Super' - * class' 'Output' mixin. It defines the new - * container pointers needed to store any addi- - * tional information for sampling hyper - * parameters.Reusable functionality is inherited - * from 'Super's 'Output' class. The workhorse of - * this inner mixin is the 'store()' method that - * performs the storing process thereby calling - * all 'store()' methods of related classes. - * @see FIX, BASE, IND, POST, ADAPTER - * ------------------------------------------------------ - */ - class Output : public Super::Output { - public: - HierOutType hyper; +public: +/** + * --------------------------------------------------------- + * Node mixin + * --------------------------------------------------------- + * + * @brief Holds all variables and method to perform the + * steps of a Gibbs sampler. + * @detail This class inherits directly from the 'Super' + * class' 'Node' mixin. The workhorse of this mixin + * is the inherited virtual method 'update()' that + * performs the update step and calls any 'update()' + * function of related classes. Hierarchical + * parameters are then updated in the related + * classes whose 'update()' method gets called and + * knows what to do. + * @see FIX, IND, POST, ADAPTER, BASE + * -------------------------------------------------------- + */ +class Node : public Super::Node { +public: +Node (const FinmixData&, + const FinmixModel&, + const FinmixPrior&, + const FinmixMCMC&); +virtual ~Node () +{ +} +}; +/** + * ------------------------------------------------------- + * Output mixin + * ------------------------------------------------------- + * + * @brief Stores all sampled parameters and additional + * information in container pointers. + * @detail This class inherits directly from the 'Super' + * class' 'Output' mixin. It defines the new + * container pointers needed to store any addi- + * tional information for sampling hyper + * parameters.Reusable functionality is inherited + * from 'Super's 'Output' class. The workhorse of + * this inner mixin is the 'store()' method that + * performs the storing process thereby calling + * all 'store()' methods of related classes. + * @see FIX, BASE, IND, POST, ADAPTER + * ------------------------------------------------------ + */ +class Output : public Super::Output { +public: +HierOutType hyper; - Output (Rcpp::S4&); - virtual ~Output () {} - virtual void store (const - unsigned int&, - Node&); - }; - Node node; - Output output; - - HIER (const FinmixData&, const FinmixModel&, - const FinmixPrior&, const FinmixMCMC&, - Rcpp::S4&); - virtual ~HIER () {} - virtual void update (); - virtual void store (const unsigned int&); +Output (Rcpp::S4&); +virtual ~Output () +{ +} +virtual void store(const + unsigned int&, + Node&); +}; +Node node; +Output output; + +HIER (const FinmixData&, const FinmixModel&, + const FinmixPrior&, const FinmixMCMC&, + Rcpp::S4&); +virtual ~HIER () +{ +} +virtual void update(); +virtual void store(const unsigned int&); }; // ============================================================ @@ -131,10 +137,12 @@ class HIER : public Super { * ------------------------------------------------------------ **/ template -HIER ::Node::Node (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, - const FinmixMCMC& mcmc) : - Super::Node(data, model, prior, mcmc) {} +HIER ::Node::Node (const FinmixData& data, + const FinmixModel& model, const FinmixPrior& prior, + const FinmixMCMC& mcmc) : + Super::Node(data, model, prior, mcmc) +{ +} /** * ----------------------------------------------------------- @@ -158,9 +166,9 @@ HIER ::Node::Node (const FinmixData& data, * @par classS4 object of class Rcpp::S4 * @detail Calls in its initialization list the constructor * of the super class that takes the same parameter. - * 'classS4' is an R S4 class object holding a + * 'classS4' is an R S4 class object holding a * certain structure of containers to store sampled - * parameters, log-likelihoods, etc. Note, the + * parameters, log-likelihoods, etc. Note, the * Rcpp::S4 object references in its objects to * memory allocated in R. To avoid copying pointers * are used to represent the containers in the C++ @@ -174,10 +182,12 @@ HIER ::Node::Node (const FinmixData& data, * @author Lars Simon Zehnder * ---------------------------------------------------------- **/ -template +template HIER ::Output::Output (Rcpp::S4& classS4) : - Super::Output(classS4), - hyper(Rcpp::as((SEXP) classS4.slot("hyper"))) {} + Super::Output(classS4), + hyper(Rcpp::as((SEXP)classS4.slot("hyper"))) +{ +} /** * --------------------------------------------------------- @@ -185,27 +195,28 @@ HIER ::Output::Output (Rcpp::S4& classS4) : * @brief Stores the sampled parameters into containers. * @par m iteration count * @par node object of class this->Node - * @detail Takes the iteration number and a 'Node' object + * @detail Takes the iteration number and a 'Node' object * holding all information from one sampling step * and stores it to the containers pointed to in- - * side the 'Output' class. It thereby always - * checks if the iteration is part of the burnin + * side the 'Output' class. It thereby always + * checks if the iteration is part of the burnin * phase or the sampling phase, if indicators * should be stored at all, etc. - * @see FIX::Output::store, IND::Output::store, + * @see FIX::Output::store, IND::Output::store, * POST::Output::store * @author Lars Simon Zehnder * --------------------------------------------------------- **/ template -void HIER ::Output::store (const unsigned int& m, - Node& node) +void HIER ::Output::store(const unsigned int& m, + Node& node) { - Super::Output::store(m, node); - if (m >= node.BURNIN) { - const unsigned int index = m - node.BURNIN; - hyper.store(index, node.hyperPar); - } + Super::Output::store(m, node); + if (m >= node.BURNIN) + { + const unsigned int index = m - node.BURNIN; + hyper.store(index, node.hyperPar); + } } // ======================================================== @@ -219,29 +230,31 @@ void HIER ::Output::store (const unsigned int& m, * layer. * @par data object of class FinmixData, holds the data * @par model object of class FinmixModel, holds model - * information + * information * @par prior object of class FinmixPrior, holds prior * information - * @par mcmc object of class FinmixMCMC, holds info for + * @par mcmc object of class FinmixMCMC, holds info for * algorithmic configurations * @par classS4 object of class Rcpp::S4 to pass output * container pointer * @detail Note, that this constructor must include all * parameters needed in construction of the inner - * mixins. Calls the constructor of its Super + * mixins. Calls the constructor of its Super * layer in initializing list. - * @see Super, FinmixData, FinmixModel, FinmixPrior, + * @see Super, FinmixData, FinmixModel, FinmixPrior, * FinmixMCMC, Rcpp::S4 * @author Lars Simon Zehnder * ------------------------------------------------------- **/ template -HIER ::HIER (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, - const FinmixMCMC& mcmc, Rcpp::S4& classS4) : - Super(data, model, prior, mcmc, classS4), - node(data, model, prior, mcmc), - output(classS4) {} +HIER ::HIER (const FinmixData& data, + const FinmixModel& model, const FinmixPrior& prior, + const FinmixMCMC& mcmc, Rcpp::S4& classS4) : + Super(data, model, prior, mcmc, classS4), + node(data, model, prior, mcmc), + output(classS4) +{ +} /** * ------------------------------------------------------- @@ -253,10 +266,10 @@ HIER ::HIER (const FinmixData& data, * @author Lars Simon Zehnder * ------------------------------------------------------- **/ -template -void HIER ::update () +template +void HIER ::update() { - node.update(); + node.update(); } /** @@ -270,8 +283,8 @@ void HIER ::update () * ------------------------------------------------------- **/ template -void HIER ::store (const unsigned int& m) +void HIER ::store(const unsigned int& m) { - output.store (m, node); + output.store(m, node); } #endif diff --git a/src/HierOutExponential.h b/src/HierOutExponential.h index 0b98c6d..6e7f67b 100644 --- a/src/HierOutExponential.h +++ b/src/HierOutExponential.h @@ -1,54 +1,57 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_HIEROUTEXPONENTIAL_H__ #define __FINMIX_HIEROUTEXPONENTIAL_H__ #include class HierOutExponential { - public: - arma::vec* b; +public: +arma::vec* b; - HierOutExponential () {} - HierOutExponential (const Rcpp::List&); - template - void store (const unsigned int& m, - const PriorParType&); -}; +HierOutExponential () +{ +} +HierOutExponential (const Rcpp::List&); +template +void store(const unsigned int& m, + const PriorParType&); +}; inline -HierOutExponential::HierOutExponential (const Rcpp::List& list) +HierOutExponential::HierOutExponential (const Rcpp::List& list) { - Rcpp::NumericVector tmpB((SEXP) list["b"]); - const unsigned int M = tmpB.size(); - b = new arma::vec(tmpB.begin(), M, false, true); + Rcpp::NumericVector tmpB((SEXP)list["b"]); + const unsigned int M = tmpB.size(); + + b = new arma::vec(tmpB.begin(), M, false, true); } template inline -void HierOutExponential::store (const unsigned int& m, - const PriorParType& hyperPar) +void HierOutExponential::store(const unsigned int& m, + const PriorParType& hyperPar) { - (*b)(m) = hyperPar.bStart(0); + (*b)(m) = hyperPar.bStart(0); } #endif // __FINMIX_HIEROUTEXPONENTIAL_H__ diff --git a/src/HierOutNormal.h b/src/HierOutNormal.h index e28875c..a4258a1 100644 --- a/src/HierOutNormal.h +++ b/src/HierOutNormal.h @@ -1,45 +1,50 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_HIEROUTNORMAL_H__ #define __FINMIX_HIEROUTNORMAL_H__ class HierOutNormal { - public: - arma::vec* C; - - HierOutNormal () {} - HierOutNormal (const Rcpp::List&); - ~HierOutNormal () {} - template - void store (const unsigned int&, - const PriorParType&); +public: +arma::vec* C; + +HierOutNormal () +{ +} +HierOutNormal (const Rcpp::List&); +~HierOutNormal () +{ +} +template +void store(const unsigned int&, + const PriorParType&); }; HierOutNormal::HierOutNormal (const Rcpp::List& list) { - Rcpp::NumericVector tmpC((SEXP) list["C"]); - const unsigned int M = tmpC.size(); - C = new arma::vec(tmpC.begin(), M, false, true); + Rcpp::NumericVector tmpC((SEXP)list["C"]); + const unsigned int M = tmpC.size(); + + C = new arma::vec(tmpC.begin(), M, false, true); } template inline -void HierOutNormal::store (const unsigned int& m, - const PriorParType& hyperPar) +void HierOutNormal::store(const unsigned int& m, + const PriorParType& hyperPar) { - (*C)(m) = hyperPar.CStart(0); + (*C)(m) = hyperPar.CStart(0); } #endif /* __FINMIX_HIEROUTNORMAL_H__ */ diff --git a/src/HierOutNormult.h b/src/HierOutNormult.h index fbfa9de..5c6c7dc 100644 --- a/src/HierOutNormult.h +++ b/src/HierOutNormult.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_HIEROUTNORMULT_H__ #define __FINMIX_HIEROUTNORMULT_H__ @@ -18,33 +18,38 @@ #include "mincol.h" class HierOutNormult { - public: - arma::mat* C; - unsigned int s; - - HierOutNormult () {} - HierOutNormult (const Rcpp::List&); - ~HierOutNormult () {} - template - void store (const unsigned int&, - const PriorParType&); +public: +arma::mat* C; +unsigned int s; + +HierOutNormult () +{ +} +HierOutNormult (const Rcpp::List&); +~HierOutNormult () +{ +} +template +void store(const unsigned int&, + const PriorParType&); }; inline HierOutNormult::HierOutNormult (const Rcpp::List& list) : - s(0) + s(0) { - Rcpp::NumericMatrix tmpC((SEXP) list["C"]); - s = tmpC.ncol(); - C = new arma::mat(tmpC.begin(), tmpC.nrow(), s, false, true); + Rcpp::NumericMatrix tmpC((SEXP)list["C"]); + + s = tmpC.ncol(); + C = new arma::mat(tmpC.begin(), tmpC.nrow(), s, false, true); } template inline -void HierOutNormult::store (const unsigned int& m, - const PriorParType& hyperPar) +void HierOutNormult::store(const unsigned int& m, + const PriorParType& hyperPar) { - C->row(m) = minrow(hyperPar.CStart.slice(0)); + C->row(m) = minrow(hyperPar.CStart.slice(0)); } #endif /* __FINMIX_HIEROUTNORMULT_H__ */ diff --git a/src/HierOutPoisson.h b/src/HierOutPoisson.h index 9ea1fa1..c627bdc 100644 --- a/src/HierOutPoisson.h +++ b/src/HierOutPoisson.h @@ -1,54 +1,57 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef HIEROUTPOISSON_H #define HIEROUTPOISSON_H #include class HierOutPoisson { - public: - arma::vec* b; +public: +arma::vec* b; - HierOutPoisson () {} - HierOutPoisson (const Rcpp::List&); - template - void store (const unsigned int& m, - const PriorParType&); -}; +HierOutPoisson () +{ +} +HierOutPoisson (const Rcpp::List&); +template +void store(const unsigned int& m, + const PriorParType&); +}; inline -HierOutPoisson::HierOutPoisson (const Rcpp::List& list) +HierOutPoisson::HierOutPoisson (const Rcpp::List& list) { - Rcpp::NumericVector tmpB((SEXP) list["b"]); - const unsigned int M = tmpB.size(); - b = new arma::vec(tmpB.begin(), M, false, true); + Rcpp::NumericVector tmpB((SEXP)list["b"]); + const unsigned int M = tmpB.size(); + + b = new arma::vec(tmpB.begin(), M, false, true); } template inline -void HierOutPoisson::store (const unsigned int& m, - const PriorParType& hyperPar) +void HierOutPoisson::store(const unsigned int& m, + const PriorParType& hyperPar) { - (*b)(m) = hyperPar.bStart(0); + (*b)(m) = hyperPar.bStart(0); } #endif diff --git a/src/HierOutStudent.h b/src/HierOutStudent.h index 3ece3aa..237459b 100644 --- a/src/HierOutStudent.h +++ b/src/HierOutStudent.h @@ -1,45 +1,50 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_HIEROUTSTUDENT_H__ #define __FINMIX_HIEROUTSTUDENT_H__ class HierOutStudent { - public: - arma::vec* C; - - HierOutStudent () {} - HierOutStudent (const Rcpp::List&); - ~HierOutStudent () {} - template - void store (const unsigned int&, - const PriorParType&); +public: +arma::vec* C; + +HierOutStudent () +{ +} +HierOutStudent (const Rcpp::List&); +~HierOutStudent () +{ +} +template +void store(const unsigned int&, + const PriorParType&); }; HierOutStudent::HierOutStudent (const Rcpp::List& list) { - Rcpp::NumericVector tmpC((SEXP) list["C"]); - const unsigned int M = tmpC.size(); - C = new arma::vec(tmpC.begin(), M, false, true); + Rcpp::NumericVector tmpC((SEXP)list["C"]); + const unsigned int M = tmpC.size(); + + C = new arma::vec(tmpC.begin(), M, false, true); } template inline -void HierOutStudent::store (const unsigned int& m, - const PriorParType& hyperPar) +void HierOutStudent::store(const unsigned int& m, + const PriorParType& hyperPar) { - (*C)(m) = hyperPar.CStart(0); + (*C)(m) = hyperPar.CStart(0); } #endif /* __FINMIX_HIEROUTSTUDENT_H__ */ diff --git a/src/HierOutStudmult.h b/src/HierOutStudmult.h index ffe1f2e..2767498 100644 --- a/src/HierOutStudmult.h +++ b/src/HierOutStudmult.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_HIEROUTSTUDMULT_H__ #define __FINMIX_HIEROUTSTUDMULT_H__ @@ -18,33 +18,38 @@ #include "mincol.h" class HierOutStudmult { - public: - arma::mat* C; - unsigned int s; - - HierOutStudmult () {} - HierOutStudmult (const Rcpp::List&); - ~HierOutStudmult () {} - template - void store (const unsigned int&, - const PriorParType&); +public: +arma::mat* C; +unsigned int s; + +HierOutStudmult () +{ +} +HierOutStudmult (const Rcpp::List&); +~HierOutStudmult () +{ +} +template +void store(const unsigned int&, + const PriorParType&); }; inline HierOutStudmult::HierOutStudmult (const Rcpp::List& list) : - s(0) + s(0) { - Rcpp::NumericMatrix tmpC((SEXP) list["C"]); - s = tmpC.ncol(); - C = new arma::mat(tmpC.begin(), tmpC.nrow(), s, false, true); + Rcpp::NumericMatrix tmpC((SEXP)list["C"]); + + s = tmpC.ncol(); + C = new arma::mat(tmpC.begin(), tmpC.nrow(), s, false, true); } template inline -void HierOutStudmult::store (const unsigned int& m, - const PriorParType& hyperPar) +void HierOutStudmult::store(const unsigned int& m, + const PriorParType& hyperPar) { - C->row(m) = minrow(hyperPar.CStart.slice(0)); + C->row(m) = minrow(hyperPar.CStart.slice(0)); } #endif /* __FINMIX_HIEROUTSTUDMULT_H__ */ diff --git a/src/IND.h b/src/IND.h index 60c149d..3749a97 100644 --- a/src/IND.h +++ b/src/IND.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef IND_H #define IND_H @@ -30,96 +30,102 @@ // ------------------------------------------------------------------- /* * @brief Mixin layer to implement the collaboration between 'Node' - * and 'Output' objects in case of Gibbs sampling with + * and 'Output' objects in case of Gibbs sampling with * indicators. * @par Super next mixin layer in the application * @detail Any implemented mixin layer describes the whole collabo- * ration between 'Node' and 'Output' object to perform a * Gibbs sampling of posterior parameters. The IND mixin - * layer refines thereby its 'Super' class by defining + * layer refines thereby its 'Super' class by defining * new inner mixins 'Node' and 'Output' with additional - * variables needed to perform all actions for Gibbs - * sampling with indicators. These are e.g. variables + * variables needed to perform all actions for Gibbs + * sampling with indicators. These are e.g. variables * neded to perform the permutations for random permutation - * Gibbs sampling. + * Gibbs sampling. * @see FIX, HIER, POST, ADAPTER, BASE * @author Lars SImon Zehnder * ------------------------------------------------------------------ */ -template +template class IND : public Super { - public: - /** - * --------------------------------------------------------- - * Node mixin - * --------------------------------------------------------- - * - * @brief Holds all variables and method to perform the - * steps of a Gibbs sampler. - * @detail This class inherits directly from the 'Super' - * class' 'Node' mixin. It defines the new var- - * iable 'swapIndex' needed for random permutation - * Gibbs sampling including classification sampling - * and permutating. The workhorse of this mixin is - * the inherited virtual method 'update()' that - * performs the update step and calls any 'update()' - * function of related classes. - * @see FIX, HIER, POST, ADAPTER, BASE - * -------------------------------------------------------- - */ - class Node : public Super::Node { - public: - arma::urowvec swapIndex; +public: +/** + * --------------------------------------------------------- + * Node mixin + * --------------------------------------------------------- + * + * @brief Holds all variables and method to perform the + * steps of a Gibbs sampler. + * @detail This class inherits directly from the 'Super' + * class' 'Node' mixin. It defines the new var- + * iable 'swapIndex' needed for random permutation + * Gibbs sampling including classification sampling + * and permutating. The workhorse of this mixin is + * the inherited virtual method 'update()' that + * performs the update step and calls any 'update()' + * function of related classes. + * @see FIX, HIER, POST, ADAPTER, BASE + * -------------------------------------------------------- + */ +class Node : public Super::Node { +public: +arma::urowvec swapIndex; - Node (const FinmixData&, - const FinmixModel&, - const FinmixPrior&, - const FinmixMCMC&); - virtual ~Node () {} - virtual void update (); - }; - /** - * ------------------------------------------------------- - * Output mixin - * ------------------------------------------------------- - * - * @brief Stores all sampled parameters and additional - * information in container pointers. - * @detail This class inherits directly from the 'Super' - * class' 'Output' mixin. It defines the new - * container pointers needed to store any addi- - * tional information from sampling indicators. - * Reusable functionality is inherited from - * 'Super's 'Output' class. The workhorse of this - * inner mixin is the 'store()' method that per- - * forms the storing process thereby calling all - * 'store()' methods of related classes. - * @see FIX, BASE, HIER, POST, ADAPTER - * ------------------------------------------------------ - */ - class Output : public Super::Output { - public: - arma::mat* weight; - arma::vec* cdpost; - arma::vec* entropy; - arma::ivec* ST; - arma::imat* S; - arma::imat* NK; - arma::ivec* clust; - Output (Rcpp::S4&); - virtual ~Output () {} - virtual void store (const unsigned int&, - Node&); - }; - Node node; - Output output; +Node (const FinmixData&, + const FinmixModel&, + const FinmixPrior&, + const FinmixMCMC&); +virtual ~Node () +{ +} +virtual void update(); +}; +/** + * ------------------------------------------------------- + * Output mixin + * ------------------------------------------------------- + * + * @brief Stores all sampled parameters and additional + * information in container pointers. + * @detail This class inherits directly from the 'Super' + * class' 'Output' mixin. It defines the new + * container pointers needed to store any addi- + * tional information from sampling indicators. + * Reusable functionality is inherited from + * 'Super's 'Output' class. The workhorse of this + * inner mixin is the 'store()' method that per- + * forms the storing process thereby calling all + * 'store()' methods of related classes. + * @see FIX, BASE, HIER, POST, ADAPTER + * ------------------------------------------------------ + */ +class Output : public Super::Output { +public: +arma::mat* weight; +arma::vec* cdpost; +arma::vec* entropy; +arma::ivec* ST; +arma::imat* S; +arma::imat* NK; +arma::ivec* clust; +Output (Rcpp::S4&); +virtual ~Output () +{ +} +virtual void store(const unsigned int&, + Node&); +}; +Node node; +Output output; - IND (const FinmixData&, const FinmixModel&, - const FinmixPrior&, const FinmixMCMC&, - Rcpp::S4&); - virtual ~IND () {} - virtual void update (); - virtual void store (const unsigned int&); +IND (const FinmixData&, const FinmixModel&, + const FinmixPrior&, const FinmixMCMC&, + Rcpp::S4&); +virtual ~IND () +{ +} +virtual void update(); +virtual void store(const unsigned int&); }; // ============================================================ @@ -138,37 +144,41 @@ class IND : public Super { * ------------------------------------------------------------ **/ template -IND ::Node::Node (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, - const FinmixMCMC& mcmc) : - Super::Node(data, model, prior, mcmc), - swapIndex(model.K) {} +IND ::Node::Node (const FinmixData& data, + const FinmixModel& model, const FinmixPrior& prior, + const FinmixMCMC& mcmc) : + Super::Node(data, model, prior, mcmc), + swapIndex(model.K) +{ +} /** * ----------------------------------------------------------- * Node::update * @brief Updates the 'node' object. * @detail Virtual. Calls 'Super::Node::update()', to perform - * any updates on parameters and then starts random + * any updates on parameters and then starts random * permutation of sampled parameters and indicators. * @see Super::Node::update() * @author Lars Simon Zehnder * ----------------------------------------------------------- **/ template -void IND ::Node::update () +void IND ::Node::update() { - Super::Node::update(); - if (Super::Node::RANPERM && arma::sum(Super::Node::compIndex2) != - Super::Node::K) { - Super::Node::par.weight(Super::Node::compIndex) = - Super::Node::par.weight(Super::Node::permIndex); - swapIndex = arma::sort_index(Super::Node::permIndex).t(); - for(unsigned int i = 0; i < Super::Node::N; ++i) { - Super::Node::S(i) = (int) swapIndex((unsigned int) - (Super::Node::S(i) - 1)) + 1; - } - } + Super::Node::update(); + if (Super::Node::RANPERM && arma::sum(Super::Node::compIndex2) != + Super::Node::K) + { + Super::Node::par.weight(Super::Node::compIndex) = + Super::Node::par.weight(Super::Node::permIndex); + swapIndex = arma::sort_index(Super::Node::permIndex).t(); + for (unsigned int i = 0; i < Super::Node::N; ++i) + { + Super::Node::S(i) = (int)swapIndex((unsigned int) + (Super::Node::S(i) - 1)) + 1; + } + } } // ========================================================== @@ -183,9 +193,9 @@ void IND ::Node::update () * @par classS4 object of class Rcpp::S4 * @detail Calls in its initialization list the constructor * of the super class that takes the same parameter. - * 'classS4' is an R S4 class object holding a + * 'classS4' is an R S4 class object holding a * certain structure of containers to store sampled - * parameters, log-likelihoods, etc. Note, the + * parameters, log-likelihoods, etc. Note, the * Rcpp::S4 object references in its objects to * memory allocated in R. To avoid copying pointers * are used to represent the containers in the C++ @@ -198,28 +208,29 @@ void IND ::Node::update () * ---------------------------------------------------------- **/ template -IND ::Output::Output (Rcpp::S4& classS4) : - Super::Output(classS4) +IND ::Output::Output (Rcpp::S4& classS4) : + Super::Output(classS4) { - Rcpp::NumericMatrix tmpWeight((SEXP) classS4.slot("weight")); - Rcpp::List tmpList((SEXP) classS4.slot("log")); - Rcpp::NumericVector tmpCDPost((SEXP) tmpList["cdpost"]); - Rcpp::NumericVector tmpEntropy((SEXP) classS4.slot("entropy")); - Rcpp::IntegerVector tmpST((SEXP) classS4.slot("ST")); - Rcpp::IntegerMatrix tmpS((SEXP) classS4.slot("S")); - Rcpp::IntegerMatrix tmpNK((SEXP) classS4.slot("NK")); - Rcpp::IntegerVector tmpClust((SEXP) classS4.slot("clust")); - const unsigned int tmpM = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - const unsigned int N = tmpS.nrow(); - const unsigned int STORES = tmpS.ncol(); - weight = new arma::mat(tmpWeight.begin(), tmpM, K, false, true); - cdpost = new arma::vec(tmpCDPost.begin(), tmpM, false, true); - entropy = new arma::vec(tmpEntropy.begin(), tmpM, false, true); - ST = new arma::ivec(tmpST.begin(), tmpM, false, true); - S = new arma::imat(tmpS.begin(), N, STORES, false, true); - NK = new arma::imat(tmpNK.begin(), tmpM, K, false, true); - clust = new arma::ivec(tmpClust.begin(), N, false, true); + Rcpp::NumericMatrix tmpWeight((SEXP)classS4.slot("weight")); + Rcpp::List tmpList((SEXP)classS4.slot("log")); + Rcpp::NumericVector tmpCDPost((SEXP)tmpList["cdpost"]); + Rcpp::NumericVector tmpEntropy((SEXP)classS4.slot("entropy")); + Rcpp::IntegerVector tmpST((SEXP)classS4.slot("ST")); + Rcpp::IntegerMatrix tmpS((SEXP)classS4.slot("S")); + Rcpp::IntegerMatrix tmpNK((SEXP)classS4.slot("NK")); + Rcpp::IntegerVector tmpClust((SEXP)classS4.slot("clust")); + const unsigned int tmpM = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + const unsigned int N = tmpS.nrow(); + const unsigned int STORES = tmpS.ncol(); + + weight = new arma::mat(tmpWeight.begin(), tmpM, K, false, true); + cdpost = new arma::vec(tmpCDPost.begin(), tmpM, false, true); + entropy = new arma::vec(tmpEntropy.begin(), tmpM, false, true); + ST = new arma::ivec(tmpST.begin(), tmpM, false, true); + S = new arma::imat(tmpS.begin(), N, STORES, false, true); + NK = new arma::imat(tmpNK.begin(), tmpM, K, false, true); + clust = new arma::ivec(tmpClust.begin(), N, false, true); } /** @@ -228,45 +239,51 @@ IND ::Output::Output (Rcpp::S4& classS4) : * @brief Stores the sampled parameters into containers. * @par m iteration count * @par node object of class this->Node - * @detail Takes the iteration number and a 'Node' object + * @detail Takes the iteration number and a 'Node' object * holding all information from one sampling step * and stores it to the containers pointed to in- - * side the 'Output' class. It thereby always - * checks if the iteration is part of the burnin + * side the 'Output' class. It thereby always + * checks if the iteration is part of the burnin * phase or the sampling phase, if indicators * should be stored at all, etc. * @see FIX::Output::store, HIER::Output::store * @author Lars Simon Zehnder * --------------------------------------------------------- **/ -template -void IND ::Output::store (const unsigned int& m, - Node& node) +template +void IND ::Output::store(const unsigned int& m, + Node& node) { - Super::Output::store(m,node); - if (m >= node.BURNIN) { - const unsigned int index = m - node.BURNIN; - (*weight).row(index) = node.par.weight; - (*cdpost)(index) = node.log.cdpost; - (*entropy)(index) = node.log.entropy; - (*ST)(index) = node.S(node.N - 1); - if(index >= node.M - node.STORES) { - if (!node.STARTPAR && index != node.M - 1) { - (*S).col(index - (node.M - node.STORES) + 1) = node.S; - } - if (node.STARTPAR){ - (*S).col(index - (node.M - node.STORES)) = node.S; - } - } - (*NK).row(index) = arma::conv_to::from - (node.hyperPar.weightPost - node.hyperPar.weightStart); - if (m == node.BURNIN) { - node.log.maxcdpost = node.log.cdpost - 1; - } - if (node.log.cdpost > node.log.maxcdpost) { - (*clust) = node.S; - } - } + Super::Output::store(m, node); + if (m >= node.BURNIN) + { + const unsigned int index = m - node.BURNIN; + (*weight).row(index) = node.par.weight; + (*cdpost)(index) = node.log.cdpost; + (*entropy)(index) = node.log.entropy; + (*ST)(index) = node.S(node.N - 1); + if (index >= node.M - node.STORES) + { + if (!node.STARTPAR && index != node.M - 1) + { + (*S).col(index - (node.M - node.STORES) + 1) = node.S; + } + if (node.STARTPAR) + { + (*S).col(index - (node.M - node.STORES)) = node.S; + } + } + (*NK).row(index) = arma::conv_to::from + (node.hyperPar.weightPost - node.hyperPar.weightStart); + if (m == node.BURNIN) + { + node.log.maxcdpost = node.log.cdpost - 1; + } + if (node.log.cdpost > node.log.maxcdpost) + { + (*clust) = node.S; + } + } } // ======================================================== @@ -280,29 +297,31 @@ void IND ::Output::store (const unsigned int& m, * layer. * @par data object of class FinmixData, holds the data * @par model object of class FinmixModel, holds model - * information + * information * @par prior object of class FinmixPrior, holds prior * information - * @par mcmc object of class FinmixMCMC, holds info for + * @par mcmc object of class FinmixMCMC, holds info for * algorithmic configurations * @par classS4 object of class Rcpp::S4 to pass output * container pointer * @detail Note, that this constructor must include all * parameters needed in construction of the inner - * mixins. Calls the constructor of its Super + * mixins. Calls the constructor of its Super * layer in initializing list. - * @see Super, FinmixData, FinmixModel, FinmixPrior, + * @see Super, FinmixData, FinmixModel, FinmixPrior, * FinmixMCMC, Rcpp::S4 * @author Lars Simon Zehnder * ------------------------------------------------------- **/ template IND ::IND (const FinmixData& data, const FinmixModel& model, - const FinmixPrior& prior, const FinmixMCMC& mcmc, - Rcpp::S4& classS4) : - Super(data, model, prior, mcmc, classS4), - node(data, model, prior, mcmc), - output(classS4) {} + const FinmixPrior& prior, const FinmixMCMC& mcmc, + Rcpp::S4& classS4) : + Super(data, model, prior, mcmc, classS4), + node(data, model, prior, mcmc), + output(classS4) +{ +} /** * ------------------------------------------------------- @@ -315,9 +334,9 @@ IND ::IND (const FinmixData& data, const FinmixModel& model, * ------------------------------------------------------- **/ template -void IND ::update () +void IND ::update() { - node.update(); + node.update(); } /** @@ -331,8 +350,8 @@ void IND ::update () * ------------------------------------------------------- **/ template -void IND ::store (const unsigned int& m) +void IND ::store(const unsigned int& m) { - output.store(m, node); -} + output.store(m, node); +} #endif diff --git a/src/LogBinomialFix.h b/src/LogBinomialFix.h index 42953d0..fc01e3b 100644 --- a/src/LogBinomialFix.h +++ b/src/LogBinomialFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_LOGBINOMIALFIX_H__ #define __FINMIX_LOGBINOMIALFIX_H__ @@ -30,27 +30,31 @@ #include "prior_likelihood.h" class LogBinomialFix { - public: - double mixlik; - double mixprior; +public: +double mixlik; +double mixprior; - LogBinomialFix (); - virtual ~LogBinomialFix() {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat&, const arma::vec&, - const ParBinomialFix&, const PriorBinomialFix&); +LogBinomialFix (); +virtual ~LogBinomialFix() +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat&, const arma::vec&, + const ParBinomialFix&, const PriorBinomialFix&); }; // ============================================================= // Constructor // ------------------------------------------------------------- -LogBinomialFix::LogBinomialFix () : mixlik(0.0), mixprior(0.0) {} +LogBinomialFix::LogBinomialFix () : mixlik(0.0), mixprior(0.0) +{ +} // ============================================================= // Update // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * update * @brief Updates the log-likelihoods of the Binomial model @@ -63,16 +67,17 @@ LogBinomialFix::LogBinomialFix () : mixlik(0.0), mixprior(0.0) {} * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void LogBinomialFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, const arma::vec& T, - const ParBinomialFix& par, const PriorBinomialFix& hyperPar) +void LogBinomialFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, const arma::vec& T, + const ParBinomialFix& par, const PriorBinomialFix& hyperPar) { - liklist lik = likelihood_binomial(y, par.p, T); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_binomial(par.p, hyperPar.aStart, - hyperPar.bStart); + liklist lik = likelihood_binomial(y, par.p, T); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_binomial(par.p, hyperPar.aStart, + hyperPar.bStart); } #endif /* __FINMIX_LOGBINOMIALFIX_H__ */ diff --git a/src/LogBinomialInd.h b/src/LogBinomialInd.h index eee0a80..4d82f8f 100644 --- a/src/LogBinomialInd.h +++ b/src/LogBinomialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_LOGBINOMIALIND_H__ #define __FINMIX_LOGBINOMIALIND_H__ @@ -28,29 +28,33 @@ #include "PriorBinomialInd.h" class LogBinomialInd : public LogBinomialFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogBinomialInd (); - virtual ~LogBinomialInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, - const ParBinomialInd&, const PriorBinomialInd&); +LogBinomialInd (); +virtual ~LogBinomialInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, + const ParBinomialInd&, const PriorBinomialInd&); }; // ============================================================= // Constructor // ------------------------------------------------------------- LogBinomialInd::LogBinomialInd () : LogBinomialFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} // ============================================================= // Update // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * update * @brief Updates the log-likelihoods of the Binomial model @@ -63,8 +67,8 @@ LogBinomialInd::LogBinomialInd () : LogBinomialFix(), * @par hyperPar object holding the hyper parameters * @detail The classification() function samples the indi- * cators and computes likelihoods and entropy. As the - * model with fixed indicators does use a different - * function 'classification_fix()' it cannot be made + * model with fixed indicators does use a different + * function 'classification_fix()' it cannot be made * use of inheritance, i.e. the LogBinomialFix::update() * function is of no use here. * @see DataClass, likelihood_binomial, priormixlik_binomial, @@ -72,25 +76,27 @@ LogBinomialInd::LogBinomialInd () : LogBinomialFix(), * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void LogBinomialInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParBinomialInd& par, - const PriorBinomialInd& hyperPar) -{ - liklist lik = likelihood_binomial(y, par.p, T); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute log-likelihood of the mixture prior */ - mixprior = priormixlik_binomial(par.p, hyperPar.aStart, - hyperPar.bStart); - if (K > 1) { - /* Compute log-likelihood of Dirichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } +void LogBinomialInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParBinomialInd& par, + const PriorBinomialInd& hyperPar) +{ + liklist lik = likelihood_binomial(y, par.p, T); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute log-likelihood of the mixture prior */ + mixprior = priormixlik_binomial(par.p, hyperPar.aStart, + hyperPar.bStart); + if (K > 1) + { + /* Compute log-likelihood of Dirichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif /* __FINMIX_LOGBINOMIALIND_H__ */ diff --git a/src/LogCondPoissonFix.h b/src/LogCondPoissonFix.h index e0fc009..56b0316 100644 --- a/src/LogCondPoissonFix.h +++ b/src/LogCondPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_LOGCONDPOISSONFIX_H_ #define __FINMIX_LOGCONDPOISSONFIX_H_ @@ -30,31 +30,36 @@ #include "prior_likelihood.h" class LogCondPoissonFix { - public: - double mixlik; - double mixprior; - - LogCondPoissonFix (); - virtual ~LogCondPoissonFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat& expos, - const arma::vec&, const ParCondPoissonFix&, - const PriorCondPoissonFix&); +public: +double mixlik; +double mixprior; + +LogCondPoissonFix (); +virtual ~LogCondPoissonFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat& expos, + const arma::vec&, const ParCondPoissonFix&, + const PriorCondPoissonFix&); }; -LogCondPoissonFix::LogCondPoissonFix () : mixlik(0.0), - mixprior(0.0) {} +LogCondPoissonFix::LogCondPoissonFix () : mixlik(0.0), + mixprior(0.0) +{ +} -void LogCondPoissonFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParCondPoissonFix& par, - const PriorCondPoissonFix& hyperPar) +void LogCondPoissonFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParCondPoissonFix& par, + const PriorCondPoissonFix& hyperPar) { - arma::mat lambdaM = arma::kron(expos, par.lambda); - liklist lik = likelihood_poisson(y, lambdaM); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_condpoisson(par.lambda, hyperPar); + arma::mat lambdaM = arma::kron(expos, par.lambda); + liklist lik = likelihood_poisson(y, lambdaM); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_condpoisson(par.lambda, hyperPar); } #endif // __FINMIX_LOGCONDPOISSONFIX_H_ diff --git a/src/LogCondPoissonInd.h b/src/LogCondPoissonInd.h index f88fa88..8634d6b 100644 --- a/src/LogCondPoissonInd.h +++ b/src/LogCondPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_LOGCONDPOISSONIND_H_ #define __FINMIX_LOGCONDPOISSONIND_H_ @@ -28,15 +28,17 @@ #include "ParCondPoissonInd.h" class LogCondPoissonInd : public LogCondPoissonFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogCondPoissonInd (); - virtual ~LogCondPoissonInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, +LogCondPoissonInd (); +virtual ~LogCondPoissonInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, const ParCondPoissonInd&, const PriorCondPoissonInd&); }; @@ -44,9 +46,11 @@ class LogCondPoissonInd : public LogCondPoissonFix { // Constructor // ------------------------------------------------------------- LogCondPoissonInd::LogCondPoissonInd () : LogCondPoissonFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} -/** +/** * ------------------------------------------------------------- * update * @brief Updates the log-likelihoods of the Poisson model @@ -58,8 +62,8 @@ LogCondPoissonInd::LogCondPoissonInd () : LogCondPoissonFix(), * @par hyperPar object holding the hyper parameters * @detail The classification() function samples the indi- * cators and computes likelihoods and entropy. As the - * model with fixed indicators does use a different - * function 'classification_fix()' it cannot be made + * model with fixed indicators does use a different + * function 'classification_fix()' it cannot be made * use of inheritance, i.e. the LogPoissonFix::update() * function is of no use here. * @see DataClass, likelihood_poisson, priormixlik_poisson, @@ -67,25 +71,26 @@ LogCondPoissonInd::LogCondPoissonInd () : LogCondPoissonFix(), * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void LogCondPoissonInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec &S, const arma::mat& expos, - const arma::vec& T, const ParCondPoissonInd& par, - const PriorCondPoissonInd& hyperPar) +void LogCondPoissonInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec &S, const arma::mat& expos, + const arma::vec& T, const ParCondPoissonInd& par, + const PriorCondPoissonInd& hyperPar) { - arma::mat lambdaM = arma::kron(expos, par.lambda); - liklist lik = likelihood_poisson(y, lambdaM); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_condpoisson(par.lambda, hyperPar); - if(K > 1) { - /* Compute likelihood of Dirichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } - + arma::mat lambdaM = arma::kron(expos, par.lambda); + liklist lik = likelihood_poisson(y, lambdaM); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_condpoisson(par.lambda, hyperPar); + if (K > 1) + { + /* Compute likelihood of Dirichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif diff --git a/src/LogExponentialFix.h b/src/LogExponentialFix.h index b2dfeab..1aea435 100644 --- a/src/LogExponentialFix.h +++ b/src/LogExponentialFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_LOGEXPONENTIALFIX_H__ #define __FINMIX_LOGEXPONENTIALFIX_H__ @@ -29,31 +29,36 @@ #include "prior_likelihood.h" class LogExponentialFix { - public: - double mixlik; - double mixprior; - - LogExponentialFix (); - virtual ~LogExponentialFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat& expos, - const arma::vec&, const ParExponentialFix&, - const PriorExponentialFix&); +public: +double mixlik; +double mixprior; + +LogExponentialFix (); +virtual ~LogExponentialFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat& expos, + const arma::vec&, const ParExponentialFix&, + const PriorExponentialFix&); }; -LogExponentialFix::LogExponentialFix () : mixlik(0.0), - mixprior(0.0) {} +LogExponentialFix::LogExponentialFix () : mixlik(0.0), + mixprior(0.0) +{ +} -void LogExponentialFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParExponentialFix& par, - const PriorExponentialFix& hyperPar) +void LogExponentialFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParExponentialFix& par, + const PriorExponentialFix& hyperPar) { - liklist lik = likelihood_exponential(y, par.lambda); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_poisson(par.lambda, hyperPar.aStart, hyperPar.bStart, - hyperPar.HIER, hyperPar.g, hyperPar.G); + liklist lik = likelihood_exponential(y, par.lambda); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_poisson(par.lambda, hyperPar.aStart, hyperPar.bStart, + hyperPar.HIER, hyperPar.g, hyperPar.G); } #endif // __FINMIX_LOGEXPONENTIALFIX_H__ diff --git a/src/LogExponentialInd.h b/src/LogExponentialInd.h index b8292f6..084a7a2 100644 --- a/src/LogExponentialInd.h +++ b/src/LogExponentialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_LOGEXPONENTIALIND_H__ #define __FINMIX_LOGEXPONENTIALIND_H__ @@ -28,15 +28,17 @@ #include "PriorExponentialInd.h" class LogExponentialInd : public LogExponentialFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogExponentialInd (); - virtual ~LogExponentialInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, +LogExponentialInd (); +virtual ~LogExponentialInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, const ParExponentialInd&, const PriorExponentialInd&); }; @@ -44,9 +46,11 @@ class LogExponentialInd : public LogExponentialFix { // Constructor // ------------------------------------------------------------- LogExponentialInd::LogExponentialInd () : LogExponentialFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} -/** +/** * ------------------------------------------------------------- * update * @brief Updates the log-likelihoods of the Exponential model @@ -58,8 +62,8 @@ LogExponentialInd::LogExponentialInd () : LogExponentialFix(), * @par hyperPar object holding the hyper parameters * @detail The classification() function samples the indi- * cators and computes likelihoods and entropy. As the - * model with fixed indicators does use a different - * function 'classification_fix()' it cannot be made + * model with fixed indicators does use a different + * function 'classification_fix()' it cannot be made * use of inheritance, i.e. the LogExponentialFix::update() * function is of no use here. * @see DataClass, likelihood_exponential, priormixlik_poisson, @@ -67,27 +71,27 @@ LogExponentialInd::LogExponentialInd () : LogExponentialFix(), * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void LogExponentialInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec &S, const arma::mat& expos, - const arma::vec& T, const ParExponentialInd& par, - const PriorExponentialInd& hyperPar) +void LogExponentialInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec &S, const arma::mat& expos, + const arma::vec& T, const ParExponentialInd& par, + const PriorExponentialInd& hyperPar) { - - liklist lik = likelihood_exponential(y, par.lambda); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_poisson(par.lambda, - hyperPar.aStart, hyperPar.bStart, - hyperPar.HIER, hyperPar.g, hyperPar.G); - if(K > 1) { - /* Compute likelihood of Dirichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } - + liklist lik = likelihood_exponential(y, par.lambda); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_poisson(par.lambda, + hyperPar.aStart, hyperPar.bStart, + hyperPar.HIER, hyperPar.g, hyperPar.G); + if (K > 1) + { + /* Compute likelihood of Dirichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif diff --git a/src/LogNormalFix.h b/src/LogNormalFix.h index 0022ebd..cc2d2d7 100644 --- a/src/LogNormalFix.h +++ b/src/LogNormalFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGNORMALFIX_H__ #define __FINMIX_LOGNORMALFIX_H__ @@ -21,35 +21,40 @@ #include "prior_likelihood.h" class LogNormalFix { - public: - double mixlik; - double mixprior; - - LogNormalFix (); - virtual ~LogNormalFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat&, - const arma::vec&, const ParNormalFix&, - const PriorNormalFix&); +public: +double mixlik; +double mixprior; + +LogNormalFix (); +virtual ~LogNormalFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat&, + const arma::vec&, const ParNormalFix&, + const PriorNormalFix&); }; -LogNormalFix::LogNormalFix () : mixlik(0.0), - mixprior(0.0) {} +LogNormalFix::LogNormalFix () : mixlik(0.0), + mixprior(0.0) +{ +} -void LogNormalFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParNormalFix& par, - const PriorNormalFix& hyperPar) +void LogNormalFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParNormalFix& par, + const PriorNormalFix& hyperPar) { - liklist lik = likelihood_normal(y, par.mu, par.sigma); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_normal(hyperPar.INDEPENDENT, - hyperPar.HIER, - hyperPar.bStart, hyperPar.BStart, - hyperPar.cStart, hyperPar.CStart, - par.mu, par.sigma, hyperPar.g, hyperPar.G); + liklist lik = likelihood_normal(y, par.mu, par.sigma); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_normal(hyperPar.INDEPENDENT, + hyperPar.HIER, + hyperPar.bStart, hyperPar.BStart, + hyperPar.cStart, hyperPar.CStart, + par.mu, par.sigma, hyperPar.g, hyperPar.G); } #endif /* __FINMIX_LOGNORMALFIX_H__ */ diff --git a/src/LogNormalInd.h b/src/LogNormalInd.h index d94241b..abb0373 100644 --- a/src/LogNormalInd.h +++ b/src/LogNormalInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGNORMALIND_H__ #define __FINMIX_LOGNORMALIND_H__ @@ -20,42 +20,48 @@ #include "PriorNormalInd.h" class LogNormalInd : public LogNormalFix { - public: - double cdpost; - double entropy; - double maxcdpost; - - LogNormalInd (); - virtual ~LogNormalInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, - const ParNormalInd&, const PriorNormalInd&); +public: +double cdpost; +double entropy; +double maxcdpost; + +LogNormalInd (); +virtual ~LogNormalInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, + const ParNormalInd&, const PriorNormalInd&); }; LogNormalInd::LogNormalInd () : LogNormalFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} -void LogNormalInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParNormalInd& par, - const PriorNormalInd& hyperPar) +void LogNormalInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParNormalInd& par, + const PriorNormalInd& hyperPar) { - liklist lik = likelihood_normal(y, par.mu, par.sigma); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_normal(hyperPar.INDEPENDENT, - hyperPar.HIER, hyperPar.bStart, hyperPar.BStart, - hyperPar.cStart, hyperPar.CStart, par.mu, - par.sigma, hyperPar.g, hyperPar.G); - if (K > 1) { - /* Compute likelihood of Dirichlet prio */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } + liklist lik = likelihood_normal(y, par.mu, par.sigma); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_normal(hyperPar.INDEPENDENT, + hyperPar.HIER, hyperPar.bStart, hyperPar.BStart, + hyperPar.cStart, hyperPar.CStart, par.mu, + par.sigma, hyperPar.g, hyperPar.G); + if (K > 1) + { + /* Compute likelihood of Dirichlet prio */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif /* __FINMIX_LOGNORMALIND_H__ */ diff --git a/src/LogNormultFix.h b/src/LogNormultFix.h index 6d1be97..d819590 100644 --- a/src/LogNormultFix.h +++ b/src/LogNormultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGNORMULTFIX_H__ #define __FINMIX_LOGNORMULTFIX_H__ @@ -21,37 +21,42 @@ #include "prior_likelihood.h" class LogNormultFix { - public: - double mixlik; - double mixprior; - - LogNormultFix (); - virtual ~LogNormultFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat&, - const arma::vec&, const ParNormultFix&, - const PriorNormultFix&); +public: +double mixlik; +double mixprior; + +LogNormultFix (); +virtual ~LogNormultFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat&, + const arma::vec&, const ParNormultFix&, + const PriorNormultFix&); }; inline LogNormultFix::LogNormultFix () : mixlik(0.0), - mixprior(0.0) {} + mixprior(0.0) +{ +} inline -void LogNormultFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParNormultFix& par, - const PriorNormultFix& hyperPar) +void LogNormultFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParNormultFix& par, + const PriorNormultFix& hyperPar) { - liklist lik = likelihood_normult(y, par.mu, par.sigma); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_normult(hyperPar.INDEPENDENT, - hyperPar.HIER, hyperPar.bStart, hyperPar.BInvStart, - hyperPar.BStart, hyperPar.cStart, hyperPar.CStart, - hyperPar.logdetC, hyperPar.g, hyperPar.G, par.mu, - par.sigma); + liklist lik = likelihood_normult(y, par.mu, par.sigma); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_normult(hyperPar.INDEPENDENT, + hyperPar.HIER, hyperPar.bStart, hyperPar.BInvStart, + hyperPar.BStart, hyperPar.cStart, hyperPar.CStart, + hyperPar.logdetC, hyperPar.g, hyperPar.G, par.mu, + par.sigma); } #endif /* __FINMIX_LOGNORMULTFIX_H__ */ diff --git a/src/LogNormultInd.h b/src/LogNormultInd.h index f9f73a3..ddbabff 100644 --- a/src/LogNormultInd.h +++ b/src/LogNormultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGNORMULTIND_H__ #define __FINMIX_LOGNORMULTIND_H__ @@ -20,45 +20,51 @@ #include "PriorNormultFix.h" class LogNormultInd : public LogNormultFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogNormultInd (); - virtual ~LogNormultInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, - const ParNormultInd&, const PriorNormultInd&); +LogNormultInd (); +virtual ~LogNormultInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, + const ParNormultInd&, const PriorNormultInd&); }; inline LogNormultInd::LogNormultInd () : LogNormultFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} inline -void LogNormultInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParNormultInd& par, - const PriorNormultInd& hyperPar) +void LogNormultInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParNormultInd& par, + const PriorNormultInd& hyperPar) { - liklist lik = likelihood_normult(y, par.mu, par.sigma); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_normult(hyperPar.INDEPENDENT, - hyperPar.HIER, hyperPar.bStart, hyperPar.BInvStart, - hyperPar.BStart, hyperPar.cStart, hyperPar.CStart, - hyperPar.logdetC, hyperPar.g, hyperPar.G, par.mu, - par.sigma); - if (K > 1) { - /* Compute likelihood of DIrichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } + liklist lik = likelihood_normult(y, par.mu, par.sigma); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_normult(hyperPar.INDEPENDENT, + hyperPar.HIER, hyperPar.bStart, hyperPar.BInvStart, + hyperPar.BStart, hyperPar.cStart, hyperPar.CStart, + hyperPar.logdetC, hyperPar.g, hyperPar.G, par.mu, + par.sigma); + if (K > 1) + { + /* Compute likelihood of DIrichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif /* __FINMIX_LOGNORMULTIND_H__ */ diff --git a/src/LogPoissonFix.h b/src/LogPoissonFix.h index 3cd64c2..61d346e 100644 --- a/src/LogPoissonFix.h +++ b/src/LogPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef LOGPOISSONFIX_H #define LOGPOISSONFIX_H @@ -30,32 +30,37 @@ #include "prior_likelihood.h" class LogPoissonFix { - public: - double mixlik; - double mixprior; - - LogPoissonFix (); - virtual ~LogPoissonFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat& expos, - const arma::vec&, const ParPoissonFix&, - const PriorPoissonFix&); +public: +double mixlik; +double mixprior; + +LogPoissonFix (); +virtual ~LogPoissonFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat& expos, + const arma::vec&, const ParPoissonFix&, + const PriorPoissonFix&); }; -LogPoissonFix::LogPoissonFix () : mixlik(0.0), - mixprior(0.0) {} +LogPoissonFix::LogPoissonFix () : mixlik(0.0), + mixprior(0.0) +{ +} -void LogPoissonFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParPoissonFix& par, - const PriorPoissonFix& hyperPar) +void LogPoissonFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParPoissonFix& par, + const PriorPoissonFix& hyperPar) { - arma::mat lambdaM = arma::kron(expos, par.lambda); - liklist lik = likelihood_poisson(y, lambdaM); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_poisson(par.lambda, hyperPar.aStart, hyperPar.bStart, - hyperPar.HIER, hyperPar.g, hyperPar.G); + arma::mat lambdaM = arma::kron(expos, par.lambda); + liklist lik = likelihood_poisson(y, lambdaM); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_poisson(par.lambda, hyperPar.aStart, hyperPar.bStart, + hyperPar.HIER, hyperPar.g, hyperPar.G); } #endif diff --git a/src/LogPoissonInd.h b/src/LogPoissonInd.h index 80aea2c..a61b218 100644 --- a/src/LogPoissonInd.h +++ b/src/LogPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef LOGPOISSONIND_H #define LOGPOISSONIND_H @@ -29,15 +29,17 @@ #include "PriorPoissonInd.h" class LogPoissonInd : public LogPoissonFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogPoissonInd (); - virtual ~LogPoissonInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, +LogPoissonInd (); +virtual ~LogPoissonInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, const ParPoissonInd&, const PriorPoissonInd&); }; @@ -45,9 +47,11 @@ class LogPoissonInd : public LogPoissonFix { // Constructor // ------------------------------------------------------------- LogPoissonInd::LogPoissonInd () : LogPoissonFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} -/** +/** * ------------------------------------------------------------- * update * @brief Updates the log-likelihoods of the Poisson model @@ -59,8 +63,8 @@ LogPoissonInd::LogPoissonInd () : LogPoissonFix(), * @par hyperPar object holding the hyper parameters * @detail The classification() function samples the indi- * cators and computes likelihoods and entropy. As the - * model with fixed indicators does use a different - * function 'classification_fix()' it cannot be made + * model with fixed indicators does use a different + * function 'classification_fix()' it cannot be made * use of inheritance, i.e. the LogPoissonFix::update() * function is of no use here. * @see DataClass, likelihood_poisson, priormixlik_poisson, @@ -68,26 +72,28 @@ LogPoissonInd::LogPoissonInd () : LogPoissonFix(), * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void LogPoissonInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec &S, const arma::mat& expos, - const arma::vec& T, const ParPoissonInd& par, - const PriorPoissonInd& hyperPar) +void LogPoissonInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec &S, const arma::mat& expos, + const arma::vec& T, const ParPoissonInd& par, + const PriorPoissonInd& hyperPar) { - arma::mat lambdaM = arma::kron(expos, par.lambda); - liklist lik = likelihood_poisson(y, lambdaM); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_poisson(par.lambda, - hyperPar.aStart, hyperPar.bStart, - hyperPar.HIER, hyperPar.g, hyperPar.G); - if(K > 1) { - /* Compute likelihood of Dirichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } + arma::mat lambdaM = arma::kron(expos, par.lambda); + liklist lik = likelihood_poisson(y, lambdaM); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_poisson(par.lambda, + hyperPar.aStart, hyperPar.bStart, + hyperPar.HIER, hyperPar.g, hyperPar.G); + if (K > 1) + { + /* Compute likelihood of Dirichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif diff --git a/src/LogStudentFix.h b/src/LogStudentFix.h index 1fdc7be..78463ba 100644 --- a/src/LogStudentFix.h +++ b/src/LogStudentFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGSTUDENTFIX_H__ #define __FINMIX_LOGSTUDENTFIX_H__ @@ -21,36 +21,40 @@ #include "prior_likelihood.h" class LogStudentFix { - public: - double mixlik; - double mixprior; - - LogStudentFix (); - virtual ~LogStudentFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat&, - const arma::vec&, const ParStudentFix&, - const PriorStudentFix&); +public: +double mixlik; +double mixprior; + +LogStudentFix (); +virtual ~LogStudentFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat&, + const arma::vec&, const ParStudentFix&, + const PriorStudentFix&); }; LogStudentFix::LogStudentFix () : mixlik(0.0), - mixprior(0.0) {} + mixprior(0.0) +{ +} inline -void LogStudentFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParStudentFix& par, - const PriorStudentFix& hyperPar) +void LogStudentFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParStudentFix& par, + const PriorStudentFix& hyperPar) { - liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_student(hyperPar.INDEPENDENT, hyperPar.HIER, - hyperPar.bStart, hyperPar.BStart, hyperPar.cStart, hyperPar.CStart, - par.mu, par.sigma, hyperPar.g, hyperPar.G, par.df, hyperPar.trans, - hyperPar.a0, hyperPar.b0, hyperPar.d); - + liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); + DataClass dataC = classification_fix(K, S, lik); + + mixlik = arma::sum(dataC.logLikCd); + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_student(hyperPar.INDEPENDENT, hyperPar.HIER, + hyperPar.bStart, hyperPar.BStart, hyperPar.cStart, hyperPar.CStart, + par.mu, par.sigma, hyperPar.g, hyperPar.G, par.df, hyperPar.trans, + hyperPar.a0, hyperPar.b0, hyperPar.d); } #endif /* __FINMIX_LOGSTUDENTFIX_H__ */ diff --git a/src/LogStudentInd.h b/src/LogStudentInd.h index 441d4ad..608c45c 100644 --- a/src/LogStudentInd.h +++ b/src/LogStudentInd.h @@ -1,63 +1,69 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGSTUDENTIND_H__ #define __FINMIX_LOGSTUDENTIND_H__ #include "LogStudentFix.h" -#include "ParNormalInd.h" +#include "ParNormalInd.h" #include "PriorStudentInd.h" class LogStudentInd : public LogStudentFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogStudentInd (); - virtual ~LogStudentInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, - const ParStudentInd&, const PriorStudentInd&); +LogStudentInd (); +virtual ~LogStudentInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, + const ParStudentInd&, const PriorStudentInd&); }; LogStudentInd::LogStudentInd () : LogStudentFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} inline -void LogStudentInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParStudentInd& par, - const PriorStudentInd& hyperPar) +void LogStudentInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParStudentInd& par, + const PriorStudentInd& hyperPar) { - liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_student(hyperPar.INDEPENDENT, - hyperPar.HIER, hyperPar.bStart, hyperPar.BStart, - hyperPar.cStart, hyperPar.CStart, par.mu, par.sigma, - hyperPar.g, hyperPar.G, par.df, hyperPar.trans, - hyperPar.a0, hyperPar.b0, hyperPar.d); - if (K > 1) { - /* Compute likelihood of Dirichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } + liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_student(hyperPar.INDEPENDENT, + hyperPar.HIER, hyperPar.bStart, hyperPar.BStart, + hyperPar.cStart, hyperPar.CStart, par.mu, par.sigma, + hyperPar.g, hyperPar.G, par.df, hyperPar.trans, + hyperPar.a0, hyperPar.b0, hyperPar.d); + if (K > 1) + { + /* Compute likelihood of Dirichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif /* __FINMIX_LOGSTUDENTIND_H__ */ diff --git a/src/LogStudmultFix.h b/src/LogStudmultFix.h index 08ffa7c..f9731aa 100644 --- a/src/LogStudmultFix.h +++ b/src/LogStudmultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGSTUDMULTFIX_H__ #define __FINMIX_LOGSTUDMULTFIX_H__ @@ -21,43 +21,48 @@ #include "prior_likelihood.h" class LogStudmultFix { - public: - double mixlik; - double mixprior; +public: +double mixlik; +double mixprior; - LogStudmultFix (); - virtual ~LogStudmultFix () {} - void update (const unsigned int&, const arma::mat&, - const arma::ivec&, const arma::mat&, - const arma::vec&, const ParStudmultFix&, - const PriorStudmultFix&); +LogStudmultFix (); +virtual ~LogStudmultFix () +{ +} +void update(const unsigned int&, const arma::mat&, + const arma::ivec&, const arma::mat&, + const arma::vec&, const ParStudmultFix&, + const PriorStudmultFix&); }; LogStudmultFix::LogStudmultFix () : mixlik(0.0), - mixprior(0.0) {} + mixprior(0.0) +{ +} inline -void LogStudmultFix::update (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParStudmultFix& par, - const PriorStudmultFix& hyperPar) +void LogStudmultFix::update(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParStudmultFix& par, + const PriorStudmultFix& hyperPar) { - liklist lik = likelihood_studmult(y, par.mu, par.sigma, par.df); - DataClass dataC = classification_fix(K, S, lik); - mixlik = arma::sum(dataC.logLikCd); - if (mixlik > 0.0) { - hyperPar.bPost.print("bPost"); - hyperPar.BPost.print("BPost"); - hyperPar.cPost.print("cPost"); - hyperPar.CPost.print("CPost"); - } - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_studmult(hyperPar.INDEPENDENT, hyperPar.HIER, - hyperPar.bStart, hyperPar.BInvStart, hyperPar.BStart, hyperPar.cStart, - hyperPar.CStart, hyperPar.logdetC, hyperPar.g, hyperPar.G, - par.mu, par.sigma, par.df, hyperPar.trans, - hyperPar.a0, hyperPar.b0, hyperPar.d); + liklist lik = likelihood_studmult(y, par.mu, par.sigma, par.df); + DataClass dataC = classification_fix(K, S, lik); + mixlik = arma::sum(dataC.logLikCd); + if (mixlik > 0.0) + { + hyperPar.bPost.print("bPost"); + hyperPar.BPost.print("BPost"); + hyperPar.cPost.print("cPost"); + hyperPar.CPost.print("CPost"); + } + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_studmult(hyperPar.INDEPENDENT, hyperPar.HIER, + hyperPar.bStart, hyperPar.BInvStart, hyperPar.BStart, hyperPar.cStart, + hyperPar.CStart, hyperPar.logdetC, hyperPar.g, hyperPar.G, + par.mu, par.sigma, par.df, hyperPar.trans, + hyperPar.a0, hyperPar.b0, hyperPar.d); } #endif /* __FINMIX_LOGSTUDENTFIX_H__ */ diff --git a/src/LogStudmultInd.h b/src/LogStudmultInd.h index d841df0..b9f9fba 100644 --- a/src/LogStudmultInd.h +++ b/src/LogStudmultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_LOGSTUDMULTIND_H__ #define __FINMIX_LOGSTUDMULTIND_H__ @@ -20,46 +20,52 @@ #include "PriorStudmultFix.h" class LogStudmultInd : public LogStudmultFix { - public: - double cdpost; - double entropy; - double maxcdpost; +public: +double cdpost; +double entropy; +double maxcdpost; - LogStudmultInd (); - virtual ~LogStudmultInd () {} - void update (const unsigned int&, const arma::mat&, - arma::ivec&, const arma::mat&, const arma::vec&, - const ParStudmultInd&, const PriorStudmultInd&); +LogStudmultInd (); +virtual ~LogStudmultInd () +{ +} +void update(const unsigned int&, const arma::mat&, + arma::ivec&, const arma::mat&, const arma::vec&, + const ParStudmultInd&, const PriorStudmultInd&); }; inline LogStudmultInd::LogStudmultInd () : LogStudmultFix(), - cdpost(0.0), entropy(0.0), maxcdpost(0.0) {} + cdpost(0.0), entropy(0.0), maxcdpost(0.0) +{ +} inline -void LogStudmultInd::update (const unsigned int& K, - const arma::mat& y, arma::ivec& S, const arma::mat& expos, - const arma::vec& T, const ParStudmultInd& par, - const PriorStudmultInd& hyperPar) +void LogStudmultInd::update(const unsigned int& K, + const arma::mat& y, arma::ivec& S, const arma::mat& expos, + const arma::vec& T, const ParStudmultInd& par, + const PriorStudmultInd& hyperPar) { - liklist lik = likelihood_studmult(y, par.mu, par.sigmainv, par.df); - DataClass dataC = classification(S, lik, par.weight); - S = dataC.newS; - mixlik = dataC.mixLik; + liklist lik = likelihood_studmult(y, par.mu, par.sigmainv, par.df); + DataClass dataC = classification(S, lik, par.weight); + + S = dataC.newS; + mixlik = dataC.mixLik; - /* Compute likelihood of mixture prior */ - mixprior = priormixlik_studmult(hyperPar.INDEPENDENT, hyperPar.HIER, - hyperPar.bStart, hyperPar.BInvStart, hyperPar.BStart, hyperPar.cStart, - hyperPar.CStart, hyperPar.logdetC, hyperPar.g, hyperPar.G, - par.mu, par.sigma, par.df, hyperPar.trans, - hyperPar.a0, hyperPar.b0, hyperPar.d); - if (K > 1) { - /* Compute likelihood of DIrichlet prior */ - mixprior += priormixlik_dirichlet(par.weight, - hyperPar.weightStart); - cdpost = mixlik + mixprior + dataC.postS; - entropy = dataC.entropy; - } + /* Compute likelihood of mixture prior */ + mixprior = priormixlik_studmult(hyperPar.INDEPENDENT, hyperPar.HIER, + hyperPar.bStart, hyperPar.BInvStart, hyperPar.BStart, hyperPar.cStart, + hyperPar.CStart, hyperPar.logdetC, hyperPar.g, hyperPar.G, + par.mu, par.sigma, par.df, hyperPar.trans, + hyperPar.a0, hyperPar.b0, hyperPar.d); + if (K > 1) + { + /* Compute likelihood of DIrichlet prior */ + mixprior += priormixlik_dirichlet(par.weight, + hyperPar.weightStart); + cdpost = mixlik + mixprior + dataC.postS; + entropy = dataC.entropy; + } } #endif /* __FINMIX_LOGSTUDMULTIND_H__ */ diff --git a/src/POST.h b/src/POST.h index ad019e5..8e2765b 100644 --- a/src/POST.h +++ b/src/POST.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef POST_H #define POST_H @@ -30,17 +30,17 @@ // ------------------------------------------------------------------- /* * @brief Mixin layer to implement the collaboration between 'Node' - * and 'Output' objects in case of Gibbs sampling when - * posterior hyper parameters should be stored. + * and 'Output' objects in case of Gibbs sampling when + * posterior hyper parameters should be stored. * @par Super next mixin layer in the application * @detail Any implemented mixin layer describes the whole collabo- * ration between 'Node' and 'Output' object to perform a - * Gibbs sampling with storage of posterior hyper parameters. - * The mixin layer refines thereby its 'Super' class by - * defining new inner mixins 'Node' and 'Output' with - * additional variables needed to perform all actions for - * Gibbs sampling with storage of posterior hyper parameters. - * These are e.g. the additional container in the 'Output' + * Gibbs sampling with storage of posterior hyper parameters. + * The mixin layer refines thereby its 'Super' class by + * defining new inner mixins 'Node' and 'Output' with + * additional variables needed to perform all actions for + * Gibbs sampling with storage of posterior hyper parameters. + * These are e.g. the additional container in the 'Output' * mixin to store posterior hyper parameters. * @see FIX, IND, HIER, ADAPTER, BASE * @author Lars SImon Zehnder @@ -48,71 +48,77 @@ */ template class POST : public Super { - public: - /** - * --------------------------------------------------------- - * Node mixin - * --------------------------------------------------------- - * - * @brief Holds all variables and method to perform the - * steps of a Gibbs sampler. - * @detail This class inherits directly from the 'Super' - * class' 'Node' mixin. The workhorse of this mixin - * is the inherited virtual method 'update()' that - * performs the update step and calls any 'update()' - * function of related classes. Hierarchical - * parameters are then updated in the related - * classes whose 'update()' method gets called and - * knows what to do. - * @see FIX, IND, POST, ADAPTER, BASE - * -------------------------------------------------------- - */ - class Node : public Super::Node { - public: - Node (const FinmixData&, - const FinmixModel&, - const FinmixPrior&, - const FinmixMCMC&); - virtual ~Node () {} - }; - /** - * ------------------------------------------------------- - * Output mixin - * ------------------------------------------------------- - * - * @brief Stores all sampled parameters and additional - * information in container pointers. - * @detail This class inherits directly from the 'Super' - * class' 'Output' mixin. It defines the new - * container pointers needed to store any addi- - * tional information for sampling hyper - * parameters.Reusable functionality is inherited - * from 'Super's 'Output' class. The workhorse of - * this inner mixin is the 'store()' method that - * performs the storing process thereby calling - * all 'store()' methods of related classes. - * @see FIX, BASE, IND, HIER, ADAPTER - * ------------------------------------------------------ - */ - class Output : public Super::Output { - public: - PostOutType post; - - Output (Rcpp::S4&); - virtual ~Output () {} - virtual void store (const - unsigned int&, - Node&); - }; - Node node; - Output output; - - POST (const FinmixData&, const FinmixModel&, - const FinmixPrior&, const FinmixMCMC&, - Rcpp::S4&); - virtual ~POST () {} - virtual void update (); - virtual void store (const unsigned int&); +public: +/** + * --------------------------------------------------------- + * Node mixin + * --------------------------------------------------------- + * + * @brief Holds all variables and method to perform the + * steps of a Gibbs sampler. + * @detail This class inherits directly from the 'Super' + * class' 'Node' mixin. The workhorse of this mixin + * is the inherited virtual method 'update()' that + * performs the update step and calls any 'update()' + * function of related classes. Hierarchical + * parameters are then updated in the related + * classes whose 'update()' method gets called and + * knows what to do. + * @see FIX, IND, POST, ADAPTER, BASE + * -------------------------------------------------------- + */ +class Node : public Super::Node { +public: +Node (const FinmixData&, + const FinmixModel&, + const FinmixPrior&, + const FinmixMCMC&); +virtual ~Node () +{ +} +}; +/** + * ------------------------------------------------------- + * Output mixin + * ------------------------------------------------------- + * + * @brief Stores all sampled parameters and additional + * information in container pointers. + * @detail This class inherits directly from the 'Super' + * class' 'Output' mixin. It defines the new + * container pointers needed to store any addi- + * tional information for sampling hyper + * parameters.Reusable functionality is inherited + * from 'Super's 'Output' class. The workhorse of + * this inner mixin is the 'store()' method that + * performs the storing process thereby calling + * all 'store()' methods of related classes. + * @see FIX, BASE, IND, HIER, ADAPTER + * ------------------------------------------------------ + */ +class Output : public Super::Output { +public: +PostOutType post; + +Output (Rcpp::S4&); +virtual ~Output () +{ +} +virtual void store(const + unsigned int&, + Node&); +}; +Node node; +Output output; + +POST (const FinmixData&, const FinmixModel&, + const FinmixPrior&, const FinmixMCMC&, + Rcpp::S4&); +virtual ~POST () +{ +} +virtual void update(); +virtual void store(const unsigned int&); }; // ============================================================ @@ -132,9 +138,11 @@ class POST : public Super { **/ template POST ::Node::Node (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, - const FinmixMCMC& mcmc) : - Super::Node(data, model, prior, mcmc) {} + const FinmixModel& model, const FinmixPrior& prior, + const FinmixMCMC& mcmc) : + Super::Node(data, model, prior, mcmc) +{ +} /** * ----------------------------------------------------------- @@ -158,9 +166,9 @@ POST ::Node::Node (const FinmixData& data, * @par classS4 object of class Rcpp::S4 * @detail Calls in its initialization list the constructor * of the super class that takes the same parameter. - * 'classS4' is an R S4 class object holding a + * 'classS4' is an R S4 class object holding a * certain structure of containers to store sampled - * parameters, log-likelihoods, etc. Note, the + * parameters, log-likelihoods, etc. Note, the * Rcpp::S4 object references in its objects to * memory allocated in R. To avoid copying pointers * are used to represent the containers in the C++ @@ -170,15 +178,17 @@ POST ::Node::Node (const FinmixData& data, * modeling an additional container 'hyper' has to * be prepared to store posterior hyper parameters. * @see FIX::Output::Output, IND::Output::Output, - * HIER::Output::Output, Rcpp::S4, ?S4 (in R), + * HIER::Output::Output, Rcpp::S4, ?S4 (in R), * arma::mat * @author Lars Simon Zehnder * ---------------------------------------------------------- **/ -template +template POST ::Output::Output (Rcpp::S4& classS4) : - Super::Output(classS4), - post(Rcpp::as((SEXP) classS4.slot("post"))) {} + Super::Output(classS4), + post(Rcpp::as((SEXP)classS4.slot("post"))) +{ +} /** * --------------------------------------------------------- @@ -186,26 +196,27 @@ POST ::Output::Output (Rcpp::S4& classS4) : * @brief Stores the sampled parameters into containers. * @par m iteration count * @par node object of class this->Node - * @detail Takes the iteration number and a 'Node' object + * @detail Takes the iteration number and a 'Node' object * holding all information from one sampling step * and stores it to the containers pointed to in- - * side the 'Output' class. It thereby always - * checks if the iteration is part of the burnin + * side the 'Output' class. It thereby always + * checks if the iteration is part of the burnin * phase or the sampling phase, etc. - * @see FIX::Output::store, IND::Output::store, - * HIER::Output::store, + * @see FIX::Output::store, IND::Output::store, + * HIER::Output::store, * @author Lars Simon Zehnder * --------------------------------------------------------- **/ template -void POST ::Output::store (const unsigned int& m, - Node& node) +void POST ::Output::store(const unsigned int& m, + Node& node) { - Super::Output::store(m, node); - if(m >= node.BURNIN) { - const unsigned int index = m - node.BURNIN; - post.store(index, node.hyperPar); - } + Super::Output::store(m, node); + if (m >= node.BURNIN) + { + const unsigned int index = m - node.BURNIN; + post.store(index, node.hyperPar); + } } // ======================================================== @@ -219,29 +230,31 @@ void POST ::Output::store (const unsigned int& m, * layer. * @par data object of class FinmixData, holds the data * @par model object of class FinmixModel, holds model - * information + * information * @par prior object of class FinmixPrior, holds prior * information - * @par mcmc object of class FinmixMCMC, holds info for + * @par mcmc object of class FinmixMCMC, holds info for * algorithmic configurations * @par classS4 object of class Rcpp::S4 to pass output * container pointer * @detail Note, that this constructor must include all * parameters needed in construction of the inner - * mixins. Calls the constructor of its Super + * mixins. Calls the constructor of its Super * layer in initializing list. - * @see Super, FinmixData, FinmixModel, FinmixPrior, + * @see Super, FinmixData, FinmixModel, FinmixPrior, * FinmixMCMC, Rcpp::S4 * @author Lars Simon Zehnder * ------------------------------------------------------- **/ template -POST ::POST (const FinmixData& data, - const FinmixModel& model, const FinmixPrior& prior, - const FinmixMCMC& mcmc, Rcpp::S4& classS4) : - Super(data, model, prior, mcmc, classS4), - node(data, model, prior, mcmc), - output(classS4) {} +POST ::POST (const FinmixData& data, + const FinmixModel& model, const FinmixPrior& prior, + const FinmixMCMC& mcmc, Rcpp::S4& classS4) : + Super(data, model, prior, mcmc, classS4), + node(data, model, prior, mcmc), + output(classS4) +{ +} /** * ------------------------------------------------------- @@ -254,10 +267,10 @@ POST ::POST (const FinmixData& data, * ------------------------------------------------------- **/ template -void POST ::update () +void POST ::update() { - node.update(); -} + node.update(); +} /** * ------------------------------------------------------- @@ -270,8 +283,8 @@ void POST ::update () * ------------------------------------------------------- **/ template -void POST ::store (const unsigned int& m) +void POST ::store(const unsigned int& m) { - output.store(m, node); + output.store(m, node); } #endif diff --git a/src/ParBinomialFix.cpp b/src/ParBinomialFix.cpp index d498c99..4fb33ad 100644 --- a/src/ParBinomialFix.cpp +++ b/src/ParBinomialFix.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "ParBinomialFix.h" // ============================================================= @@ -31,31 +31,32 @@ * @brief Constructs object from model parameters. * @par STARTPAR boolean, indicating if it should be started * by sampling the parameters - * @par model FinmixModel object, holding model + * @par model FinmixModel object, holding model * definitions and starting parameters * @return an object of class ParBinomialFix * @detail If STARTPAR == FALSE it should be started by sampling - * the indicators and starting parameters are provided + * the indicators and starting parameters are provided * by the model parameter * @see ?model in R * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ ParBinomialFix::ParBinomialFix(const bool& STARTPAR, - const FinmixModel& model) : p(model.K) + const FinmixModel& model) : p(model.K) { - if (!STARTPAR && model.K > 1) { - arma::rowvec tmp = Rcpp::as - ((SEXP) model.par["p"]); - p = tmp; - } + if (!STARTPAR && model.K > 1) + { + arma::rowvec tmp = Rcpp::as + ((SEXP)model.par["p"]); + p = tmp; + } } // ============================================================= // Update // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * update * @brief Updates the parameters of the Binomial model @@ -66,13 +67,13 @@ ParBinomialFix::ParBinomialFix(const bool& STARTPAR, * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParBinomialFix::update (const PriorBinomialFix& hyperPar) +void ParBinomialFix::update(const PriorBinomialFix& hyperPar) { - p = rbetaprod(hyperPar.aPost, hyperPar.bPost); + p = rbetaprod(hyperPar.aPost, hyperPar.bPost); } -void ParBinomialFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +void ParBinomialFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - p(compIndex) = p(permIndex); + p(compIndex) = p(permIndex); } diff --git a/src/ParBinomialFix.h b/src/ParBinomialFix.h index 0c95723..01d713a 100644 --- a/src/ParBinomialFix.h +++ b/src/ParBinomialFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PARBINOMIALFIX_H__ #define __FINMIX_PARBINOMIALFIX_H__ @@ -28,14 +28,16 @@ #include "distributions.h" class ParBinomialFix { - public: - arma::rowvec p; - ParBinomialFix (const bool&, +public: +arma::rowvec p; +ParBinomialFix (const bool&, const FinmixModel&); - virtual ~ParBinomialFix () {} - void update (const PriorBinomialFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +virtual ~ParBinomialFix () +{ +} +void update(const PriorBinomialFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif /* __FINMIX_PARBINOMIALFIX_H__ */ diff --git a/src/ParBinomialInd.cpp b/src/ParBinomialInd.cpp index 772c7f5..a18bf34 100644 --- a/src/ParBinomialInd.cpp +++ b/src/ParBinomialInd.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "ParBinomialInd.h" // ============================================================= @@ -30,24 +30,25 @@ * ------------------------------------------------------------- * ParBinomialInd * @brief Constructs a ParBinomialInd object from a model. - * @par STARTPAR indicator for starting with sampling the + * @par STARTPAR indicator for starting with sampling the * parameters * @par model FinmixModel object holding model info * @return ParBinomialInd object * @detail The only difference to a ParBinomialFix object is * the weight vector, all other members stay the same. - * This is achieved by a virtual inheritance from the - * ParBinomialFix class. + * This is achieved by a virtual inheritance from the + * ParBinomialFix class. * @see FinmixModel, ParBinomialFix * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ ParBinomialInd::ParBinomialInd (const bool& STARTPAR, - const FinmixModel& model) : ParBinomialFix(STARTPAR, model) + const FinmixModel& model) : ParBinomialFix(STARTPAR, model) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } // ============================================================ @@ -60,19 +61,19 @@ ParBinomialInd::ParBinomialInd (const bool& STARTPAR, * @par hyperPar PriorBinomialInd object containing the hyper * parameters * @detail Updates the parameters by sampling from a Beta - * distribution for the component parameters and a - * Dirichlet distribution for the weights. All hyper - * üparameters are provided by the PriorBinomialInd + * distribution for the component parameters and a + * Dirichlet distribution for the weights. All hyper + * üparameters are provided by the PriorBinomialInd * argument. For updating the component parameters it - * is made use of the inheritance scheme and the - * corresponding update member function of the + * is made use of the inheritance scheme and the + * corresponding update member function of the * ParBinomialFix class is called. * @see ParBinomialFix::update, PriorBinomialInd, rdirichlet * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -void ParBinomialInd::update (const PriorBinomialInd& hyperPar) +void ParBinomialInd::update(const PriorBinomialInd& hyperPar) { - ParBinomialFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParBinomialFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParBinomialInd.h b/src/ParBinomialInd.h index e0a7f75..cd6c776 100644 --- a/src/ParBinomialInd.h +++ b/src/ParBinomialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PARBINOMIALIND_H__ #define __FINMIX_PARBINOMIALIND_H__ @@ -27,13 +27,15 @@ #include "PriorBinomialInd.h" class ParBinomialInd : virtual public ParBinomialFix { - public: - arma::rowvec weight; +public: +arma::rowvec weight; - ParBinomialInd (const bool&, +ParBinomialInd (const bool&, const FinmixModel&); - virtual ~ParBinomialInd () {} - void update (const PriorBinomialInd&); +virtual ~ParBinomialInd () +{ +} +void update(const PriorBinomialInd&); }; #endif /* __FINMIX_PARBINOMIALIND_H__ */ diff --git a/src/ParCondPoissonFix.cpp b/src/ParCondPoissonFix.cpp index 8597996..cebad57 100644 --- a/src/ParCondPoissonFix.cpp +++ b/src/ParCondPoissonFix.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #include "ParCondPoissonFix.h" #include "rtruncnorm.h" // ============================================================= @@ -31,58 +31,63 @@ * @brief Constructs object from model parameters. * @par STARTPAR boolean, indicating if it should be started * by sampling the parameters - * @par model FinmixModel object, holding model + * @par model FinmixModel object, holding model * definitions and starting parameters * @return an object of class ParPoissonFix * @detail If STARTPAR == FALSE it should be started by sampling - * the indicators and starting parameters are provided + * the indicators and starting parameters are provided * by the model parameter * @see ?model in R * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -ParCondPoissonFix::ParCondPoissonFix (const bool& STARTPAR, - const FinmixModel& model) : lambda(model.K), - acc(0.0) +ParCondPoissonFix::ParCondPoissonFix (const bool& STARTPAR, + const FinmixModel& model) : lambda(model.K), + acc(0.0) { - if(!STARTPAR && model.K > 1) { - arma::rowvec tmp = Rcpp::as - ((SEXP) model.par["lambda"]); - lambda = tmp; - } -} + if (!STARTPAR && model.K > 1) + { + arma::rowvec tmp = Rcpp::as + ((SEXP)model.par["lambda"]); + lambda = tmp; + } +} -double ParCondPoissonFix::metropolis (const arma::rowvec& can, - const PriorCondPoissonFix& hyperPar) +double ParCondPoissonFix::metropolis(const arma::rowvec& can, + const PriorCondPoissonFix& hyperPar) { - unsigned int K = can.n_elem; - double output = std::pow(can(0), hyperPar.Q(0)) - * std::exp(-hyperPar.N(0) * can(0)) - * R::dunif(can(0), hyperPar.a, hyperPar.b, 0); - for(unsigned int k = 1; k < K; ++k) { - output *= std::pow(can(k), hyperPar.Q(k)) - * std::exp(-hyperPar.N(k) * can(k)) - * do_dtruncnorm(can(k), can(k - 1), R_PosInf, can(k - 1), hyperPar.s); - } - return output; + unsigned int K = can.n_elem; + double output = std::pow(can(0), hyperPar.Q(0)) + * std::exp(-hyperPar.N(0) * can(0)) + * R::dunif(can(0), hyperPar.a, hyperPar.b, 0); + + for (unsigned int k = 1; k < K; ++k) + { + output *= std::pow(can(k), hyperPar.Q(k)) + * std::exp(-hyperPar.N(k) * can(k)) + * do_dtruncnorm(can(k), can(k - 1), R_PosInf, can(k - 1), hyperPar.s); + } + return output; } -double ParCondPoissonFix::proposal_prob (const arma::rowvec& can, - const PriorCondPoissonFix& hyperPar) +double ParCondPoissonFix::proposal_prob(const arma::rowvec& can, + const PriorCondPoissonFix& hyperPar) { - const unsigned int K = can.n_elem; - double proposal = R::dunif(can(0), hyperPar.a, hyperPar.b, 0); - for(unsigned int k = 1; k < K; ++k) { - proposal *= do_dtruncnorm(can(k), can(k - 1), R_PosInf, can(k - 1), hyperPar.s); - } - return proposal; + const unsigned int K = can.n_elem; + double proposal = R::dunif(can(0), hyperPar.a, hyperPar.b, 0); + + for (unsigned int k = 1; k < K; ++k) + { + proposal *= do_dtruncnorm(can(k), can(k - 1), R_PosInf, can(k - 1), hyperPar.s); + } + return proposal; } // ============================================================= // Update // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * update * @brief Updates the parameters of the conditional Poisson model @@ -93,28 +98,34 @@ double ParCondPoissonFix::proposal_prob (const arma::rowvec& can, * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParCondPoissonFix::update (const PriorCondPoissonFix& hyperPar) +void ParCondPoissonFix::update(const PriorCondPoissonFix& hyperPar) { - acc = 0.0; - unsigned int K = lambda.n_elem; - arma::rowvec can(K); - can(0) = R::runif(hyperPar.a, hyperPar.b); - for(unsigned int k = 1; k < K; ++k) { - can(k) = do_rtruncnorm(1, can(k - 1), R_PosInf, can(k - 1), hyperPar.s)(0); - } - double aprob = std::min(1.0, (metropolis(can, hyperPar) / metropolis(lambda, hyperPar)) - / (proposal_prob(can, hyperPar) / proposal_prob(lambda, hyperPar))); + acc = 0.0; + unsigned int K = lambda.n_elem; + arma::rowvec can(K); + + can(0) = R::runif(hyperPar.a, hyperPar.b); + for (unsigned int k = 1; k < K; ++k) + { + can(k) = do_rtruncnorm(1, can(k - 1), R_PosInf, can(k - 1), hyperPar.s)(0); + } + double aprob = std::min(1.0, (metropolis(can, hyperPar) / metropolis(lambda, hyperPar)) + / (proposal_prob(can, hyperPar) / proposal_prob(lambda, hyperPar))); /* double aprob = std::min(1.0, (metropolis(can, hyperPar.N, hyperPar.Q, hyperPar.s, hyperPar.a, hyperPar.b) - /metropolis(lambda, hyperPar.N, hyperPar.Q, hyperPar.s, hyperPar.a, hyperPar.b)) - / ((R::dunif(can(1), hyperPar.a, hyperPar.b, 0) * do_dtruncnorm(can(0), can(1), R_PosInf, can(1), hyperPar.s)) - / (R::dunif(lambda(1), hyperPar.a, hyperPar.b, 0) * do_dtruncnorm(lambda(0), can(1), R_PosInf, can(1), hyperPar.s))));*/ - double u = R::runif(0.0, 1.0); - if(u < aprob && NA_REAL != arma::prod(can)) { - lambda = can; - acc = 1.0; - } + * /metropolis(lambda, hyperPar.N, hyperPar.Q, hyperPar.s, hyperPar.a, hyperPar.b)) + * / ((R::dunif(can(1), hyperPar.a, hyperPar.b, 0) * do_dtruncnorm(can(0), can(1), R_PosInf, can(1), hyperPar.s)) + * / (R::dunif(lambda(1), hyperPar.a, hyperPar.b, 0) * do_dtruncnorm(lambda(0), can(1), R_PosInf, can(1), hyperPar.s))));*/ + double u = R::runif(0.0, 1.0); + + if (u < aprob && NA_REAL != arma::prod(can)) + { + lambda = can; + acc = 1.0; + } } -void ParCondPoissonFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) {} +void ParCondPoissonFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) +{ +} diff --git a/src/ParCondPoissonFix.h b/src/ParCondPoissonFix.h index fd8f041..0a7e41d 100644 --- a/src/ParCondPoissonFix.h +++ b/src/ParCondPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PARCONDPOISSONFIX_H_ #define __FINMIX_PARCONDPOISSONFIX_H_ @@ -29,19 +29,21 @@ #include "distributions.h" class ParCondPoissonFix { - public: - arma::rowvec lambda; - double acc; - - ParCondPoissonFix (const bool&, - const FinmixModel&); - virtual ~ParCondPoissonFix () {} - double metropolis (const arma::rowvec&, - const PriorCondPoissonFix&); - double proposal_prob (const arma::rowvec&, - const PriorCondPoissonFix&); - void update (const PriorCondPoissonFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +public: +arma::rowvec lambda; +double acc; + +ParCondPoissonFix (const bool&, + const FinmixModel&); +virtual ~ParCondPoissonFix () +{ +} +double metropolis(const arma::rowvec&, + const PriorCondPoissonFix&); +double proposal_prob(const arma::rowvec&, + const PriorCondPoissonFix&); +void update(const PriorCondPoissonFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif // __FINMIX_PARCONDPOISSON_H_ diff --git a/src/ParCondPoissonInd.cpp b/src/ParCondPoissonInd.cpp index d6b2790..ea31ea6 100644 --- a/src/ParCondPoissonInd.cpp +++ b/src/ParCondPoissonInd.cpp @@ -1,39 +1,40 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "ParCondPoissonInd.h" -ParCondPoissonInd::ParCondPoissonInd (const bool& STARTPAR, - const FinmixModel& model) : - ParCondPoissonFix(STARTPAR, model), - weight(model.K) +ParCondPoissonInd::ParCondPoissonInd (const bool& STARTPAR, + const FinmixModel& model) : + ParCondPoissonFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } -void ParCondPoissonInd::update (const PriorCondPoissonInd& hyperPar) +void ParCondPoissonInd::update(const PriorCondPoissonInd& hyperPar) { - ParCondPoissonFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParCondPoissonFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParCondPoissonInd.h b/src/ParCondPoissonInd.h index af7b637..aa154cd 100644 --- a/src/ParCondPoissonInd.h +++ b/src/ParCondPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PARCONDPOISSONIND_H_ #define __FINMIX_PARCONDPOISSONIND_H_ @@ -28,12 +28,14 @@ #include "PriorCondPoissonInd.h" class ParCondPoissonInd : virtual public ParCondPoissonFix { - public: - arma::rowvec weight; - - ParCondPoissonInd (const bool&, - const FinmixModel&); - virtual ~ParCondPoissonInd () {} - void update (const PriorCondPoissonInd&); +public: +arma::rowvec weight; + +ParCondPoissonInd (const bool&, + const FinmixModel&); +virtual ~ParCondPoissonInd () +{ +} +void update(const PriorCondPoissonInd&); }; #endif // __FINMIX_PARCONDPOISSONIND_H_ diff --git a/src/ParExponentialFix.cpp b/src/ParExponentialFix.cpp index d879fcd..ddeca0c 100644 --- a/src/ParExponentialFix.cpp +++ b/src/ParExponentialFix.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #include "ParExponentialFix.h" // ============================================================= @@ -31,32 +31,33 @@ * @brief Constructs object from model parameters. * @par STARTPAR boolean, indicating if it should be started * by sampling the parameters - * @par model FinmixModel object, holding model + * @par model FinmixModel object, holding model * definitions and starting parameters * @return an object of class ParExponentialFix * @detail If STARTPAR == FALSE it should be started by sampling - * the indicators and starting parameters are provided + * the indicators and starting parameters are provided * by the model parameter * @see ?model in R * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -ParExponentialFix::ParExponentialFix (const bool& STARTPAR, - const FinmixModel& model) : lambda(model.K) +ParExponentialFix::ParExponentialFix (const bool& STARTPAR, + const FinmixModel& model) : lambda(model.K) { - if(!STARTPAR && model.K > 1) { - arma::rowvec tmp = Rcpp::as - ((SEXP) model.par["lambda"]); - lambda = tmp; - } -} + if (!STARTPAR && model.K > 1) + { + arma::rowvec tmp = Rcpp::as + ((SEXP)model.par["lambda"]); + lambda = tmp; + } +} // ============================================================= // Update // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * update * @brief Updates the parameters of the Exponential model @@ -68,9 +69,9 @@ ParExponentialFix::ParExponentialFix (const bool& STARTPAR, * ------------------------------------------------------------- **/ -void ParExponentialFix::update (const PriorExponentialFix& hyperPar) +void ParExponentialFix::update(const PriorExponentialFix& hyperPar) { - lambda = rgammaprod(hyperPar.aPost, hyperPar.bPost); + lambda = rgammaprod(hyperPar.aPost, hyperPar.bPost); } // ============================================================= @@ -87,8 +88,8 @@ void ParExponentialFix::update (const PriorExponentialFix& hyperPar) * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParExponentialFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +void ParExponentialFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - lambda(compIndex) = lambda(permIndex); + lambda(compIndex) = lambda(permIndex); } diff --git a/src/ParExponentialFix.h b/src/ParExponentialFix.h index b2a1a2a..769baad 100644 --- a/src/ParExponentialFix.h +++ b/src/ParExponentialFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PAREXPONENTIALFIX_H__ #define __FINMIX_PAREXPONENTIALFIX_H__ @@ -28,14 +28,16 @@ #include "distributions.h" class ParExponentialFix { - public: - arma::rowvec lambda; - - ParExponentialFix (const bool&, - const FinmixModel&); - virtual ~ParExponentialFix () {} - void update (const PriorExponentialFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +public: +arma::rowvec lambda; + +ParExponentialFix (const bool&, + const FinmixModel&); +virtual ~ParExponentialFix () +{ +} +void update(const PriorExponentialFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif diff --git a/src/ParExponentialInd.cpp b/src/ParExponentialInd.cpp index fe4c495..8c4d4d0 100644 --- a/src/ParExponentialInd.cpp +++ b/src/ParExponentialInd.cpp @@ -1,39 +1,40 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "ParExponentialInd.h" -ParExponentialInd::ParExponentialInd (const bool& STARTPAR, - const FinmixModel& model) : - ParExponentialFix(STARTPAR, model), - weight(model.K) +ParExponentialInd::ParExponentialInd (const bool& STARTPAR, + const FinmixModel& model) : + ParExponentialFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } -void ParExponentialInd::update (const PriorExponentialInd& hyperPar) +void ParExponentialInd::update(const PriorExponentialInd& hyperPar) { - ParExponentialFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParExponentialFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParExponentialInd.h b/src/ParExponentialInd.h index 621fc3b..7880409 100644 --- a/src/ParExponentialInd.h +++ b/src/ParExponentialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PAREXPONENTIALIND_H__ #define __FINMIX_PAREXPONENTIALIND_H__ @@ -27,12 +27,14 @@ #include "PriorExponentialInd.h" class ParExponentialInd : virtual public ParExponentialFix { - public: - arma::rowvec weight; - - ParExponentialInd (const bool&, - const FinmixModel&); - virtual ~ParExponentialInd () {} - void update (const PriorExponentialInd&); +public: +arma::rowvec weight; + +ParExponentialInd (const bool&, + const FinmixModel&); +virtual ~ParExponentialInd () +{ +} +void update(const PriorExponentialInd&); }; #endif // __FINMIX_PAREXPONENTIALIND_H__ diff --git a/src/ParNormalFix.cpp b/src/ParNormalFix.cpp index 5e99b80..cfa665b 100644 --- a/src/ParNormalFix.cpp +++ b/src/ParNormalFix.cpp @@ -2,32 +2,37 @@ #include "distributions.h" ParNormalFix::ParNormalFix (const bool& STARTPAR, - const FinmixModel& model) : mu(model.K), sigma(model.K), - INDEPENDENT(false) -{ - if (!Rf_isNull(model.par)) { - mu = Rcpp::as(model.par["mu"]); - } - if (!STARTPAR && model.K > 1) { - sigma = Rcpp::as(model.par["sigma"]); - } + const FinmixModel& model) : mu(model.K), sigma(model.K), + INDEPENDENT(false) +{ + if (!Rf_isNull(model.par)) + { + mu = Rcpp::as(model.par["mu"]); + } + if (!STARTPAR && model.K > 1) + { + sigma = Rcpp::as(model.par["sigma"]); + } } -void ParNormalFix::update (const PriorNormalFix& hyperPar) +void ParNormalFix::update(const PriorNormalFix& hyperPar) { - if (INDEPENDENT) { - mu = rnormal(hyperPar.bPost, hyperPar.BPost); - } else { /* conditionally conjugate prior */ - sigma = 1.0 / rgammaprod(hyperPar.cPost, hyperPar.CPost); - mu = rnormal(hyperPar.bPost, sigma % hyperPar.BPost); - } + if (INDEPENDENT) + { + mu = rnormal(hyperPar.bPost, hyperPar.BPost); + } + else /* conditionally conjugate prior */ + { + sigma = 1.0 / rgammaprod(hyperPar.cPost, hyperPar.CPost); + mu = rnormal(hyperPar.bPost, sigma % hyperPar.BPost); + } } -void ParNormalFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +void ParNormalFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - mu(compIndex) = mu(permIndex); - sigma(compIndex) = sigma(permIndex); + mu(compIndex) = mu(permIndex); + sigma(compIndex) = sigma(permIndex); } diff --git a/src/ParNormalFix.h b/src/ParNormalFix.h index 9a85bb8..a61a18c 100644 --- a/src/ParNormalFix.h +++ b/src/ParNormalFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARNORMALFIX_H__ #define __FINMIX_PARNORMALFIX_H__ @@ -19,16 +19,18 @@ #include "PriorNormalFix.h" class ParNormalFix { - public: - arma::rowvec mu; - arma::rowvec sigma; - bool INDEPENDENT; +public: +arma::rowvec mu; +arma::rowvec sigma; +bool INDEPENDENT; - ParNormalFix (const bool&, const FinmixModel&); - virtual ~ParNormalFix () {} - void update (const PriorNormalFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +ParNormalFix (const bool&, const FinmixModel&); +virtual ~ParNormalFix () +{ +} +void update(const PriorNormalFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif /* __FINMIX_PARNORMALFIX_H__ */ diff --git a/src/ParNormalInd.cpp b/src/ParNormalInd.cpp index fbac54f..8220f53 100644 --- a/src/ParNormalInd.cpp +++ b/src/ParNormalInd.cpp @@ -2,17 +2,18 @@ #include "distributions.h" ParNormalInd::ParNormalInd (const bool& STARTPAR, - const FinmixModel& model) : - ParNormalFix(STARTPAR, model), - weight(model.K) + const FinmixModel& model) : + ParNormalFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } -void ParNormalInd::update (const PriorNormalInd& hyperPar) +void ParNormalInd::update(const PriorNormalInd& hyperPar) { - ParNormalFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParNormalFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParNormalInd.h b/src/ParNormalInd.h index e6a479c..61397da 100644 --- a/src/ParNormalInd.h +++ b/src/ParNormalInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARNORMALIND_H__ #define __FINMIX_PARNORMALIND_H__ @@ -19,13 +19,15 @@ #include "PriorNormalInd.h" class ParNormalInd : virtual public ParNormalFix { - public: - arma::rowvec weight; - - ParNormalInd (const bool&, - const FinmixModel&); - virtual ~ParNormalInd () {} - void update (const PriorNormalInd&); +public: +arma::rowvec weight; + +ParNormalInd (const bool&, + const FinmixModel&); +virtual ~ParNormalInd () +{ +} +void update(const PriorNormalInd&); }; #endif /* __FINMIX_PARNORMALIND_H__ */ diff --git a/src/ParNormultFix.cpp b/src/ParNormultFix.cpp index 4cddf0f..17b574c 100644 --- a/src/ParNormultFix.cpp +++ b/src/ParNormultFix.cpp @@ -2,46 +2,54 @@ #include "distributions.h" ParNormultFix::ParNormultFix (const bool& STARTPAR, - const FinmixModel& model) : mu(model.K, model.r), - sigma(model.r, model.r, model.K), sigmainv(model.r, model.r, model.K), - INDEPENDENT(true) + const FinmixModel& model) : mu(model.K, model.r), + sigma(model.r, model.r, model.K), sigmainv(model.r, model.r, model.K), + INDEPENDENT(true) { - if (model.par.size() > 0) { - mu = Rcpp::as(model.par["mu"]); - } - if (!STARTPAR && model.K > 1) { - Rcpp::NumericVector tmpSigma((SEXP) model.par["sigma"]); - Rcpp::IntegerVector tmpDim = tmpSigma.attr("dim"); - sigma = arma::cube(tmpSigma.begin(), tmpDim[0], tmpDim[1], tmpDim[2], true, true); - } + if (model.par.size() > 0) + { + mu = Rcpp::as(model.par["mu"]); + } + if (!STARTPAR && model.K > 1) + { + Rcpp::NumericVector tmpSigma((SEXP)model.par["sigma"]); + Rcpp::IntegerVector tmpDim = tmpSigma.attr("dim"); + sigma = arma::cube(tmpSigma.begin(), tmpDim[0], tmpDim[1], tmpDim[2], true, true); + } } inline -void ParNormultFix::update (PriorNormultFix& hyperPar) +void ParNormultFix::update(PriorNormultFix& hyperPar) { - if (INDEPENDENT) { - mu = rnormult(hyperPar.bPost, hyperPar.BPost); - } else { /* conditionally conjugate prior */ - for (unsigned int k = 0; k < sigma.n_slices; ++k) { - sigma.slice(k) = rinvwishart(hyperPar.cPost(k), - hyperPar.CPost.slice(k)); - sigmainv.slice(k) = arma::inv(sigma.slice(k)); - hyperPar.BPost.slice(k) = sigma.slice(k) / hyperPar.N0Post(k); - hyperPar.BInvPost.slice(k) = arma::inv(hyperPar.BPost.slice(k)); - } - mu = rnormult(hyperPar.bPost, hyperPar.BPost); - } + if (INDEPENDENT) + { + mu = rnormult(hyperPar.bPost, hyperPar.BPost); + } + else /* conditionally conjugate prior */ + { + for (unsigned int k = 0; k < sigma.n_slices; ++k) + { + sigma.slice(k) = rinvwishart(hyperPar.cPost(k), + hyperPar.CPost.slice(k)); + sigmainv.slice(k) = arma::inv(sigma.slice(k)); + hyperPar.BPost.slice(k) = sigma.slice(k) / hyperPar.N0Post(k); + hyperPar.BInvPost.slice(k) = arma::inv(hyperPar.BPost.slice(k)); + } + mu = rnormult(hyperPar.bPost, hyperPar.BPost); + } } -inline -void ParNormultFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +inline +void ParNormultFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - mu.cols(compIndex) = mu.cols(permIndex); - arma::cube tmpSigma = sigma; - arma::cube tmpSigmaInv = sigmainv; - for (unsigned int k = 0; k < sigma.n_slices; ++k) { - sigma.slice(compIndex(k)) = tmpSigma.slice(permIndex(k)); - sigmainv.slice(compIndex(k)) = tmpSigmaInv.slice(permIndex(k)); - } + mu.cols(compIndex) = mu.cols(permIndex); + arma::cube tmpSigma = sigma; + arma::cube tmpSigmaInv = sigmainv; + + for (unsigned int k = 0; k < sigma.n_slices; ++k) + { + sigma.slice(compIndex(k)) = tmpSigma.slice(permIndex(k)); + sigmainv.slice(compIndex(k)) = tmpSigmaInv.slice(permIndex(k)); + } } diff --git a/src/ParNormultFix.h b/src/ParNormultFix.h index ac3ccb6..31ce771 100644 --- a/src/ParNormultFix.h +++ b/src/ParNormultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARNORMULTFIX_H__ #define __FINMIX_PARNORMULTFIX_H__ @@ -19,17 +19,19 @@ #include "PriorNormultFix.h" class ParNormultFix { - public: - arma::mat mu; - arma::cube sigma; - arma::cube sigmainv; - bool INDEPENDENT; +public: +arma::mat mu; +arma::cube sigma; +arma::cube sigmainv; +bool INDEPENDENT; - ParNormultFix (const bool&, const FinmixModel&); - virtual ~ParNormultFix () {} - virtual void update (PriorNormultFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +ParNormultFix (const bool&, const FinmixModel&); +virtual ~ParNormultFix () +{ +} +virtual void update(PriorNormultFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif /* __FINMIX_PARNORMULTFIX_H__ */ diff --git a/src/ParNormultInd.cpp b/src/ParNormultInd.cpp index 2f1b7ce..c0fe9ed 100644 --- a/src/ParNormultInd.cpp +++ b/src/ParNormultInd.cpp @@ -2,17 +2,18 @@ #include "distributions.h" ParNormultInd::ParNormultInd (const bool& STARTPAR, - const FinmixModel& model) : - ParNormultFix(STARTPAR, model), - weight(model.K) + const FinmixModel& model) : + ParNormultFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } -void ParNormultInd::update (PriorNormultInd& hyperPar) +void ParNormultInd::update(PriorNormultInd& hyperPar) { - ParNormultFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParNormultFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParNormultInd.h b/src/ParNormultInd.h index 862f733..d2c7dce 100644 --- a/src/ParNormultInd.h +++ b/src/ParNormultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARNORMULTIND_H__ #define __FINMIX_PARNORMULTIND_H__ @@ -19,12 +19,14 @@ #include "PriorNormultInd.h" class ParNormultInd : virtual public ParNormultFix { - public: - arma::rowvec weight; +public: +arma::rowvec weight; - ParNormultInd (const bool&, const FinmixModel&); - virtual ~ParNormultInd () {} - void update (PriorNormultInd&); +ParNormultInd (const bool&, const FinmixModel&); +virtual ~ParNormultInd () +{ +} +void update(PriorNormultInd&); }; #endif /* __FINMIX_PARNORMULTIND_H__ */ diff --git a/src/ParOutBinomial.h b/src/ParOutBinomial.h index ae394a8..8a126e8 100644 --- a/src/ParOutBinomial.h +++ b/src/ParOutBinomial.h @@ -1,37 +1,39 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PAROUTBINOMIAL_H__ #define __FINMIX_PAROUTBINOMIAL_H__ #include "ParBinomialFix.h" class ParOutBinomial { - public: - arma::mat* p; +public: +arma::mat* p; - ParOutBinomial () {} - ParOutBinomial (const Rcpp::List&); - void store(const unsigned int&, const ParBinomialFix&); +ParOutBinomial () +{ +} +ParOutBinomial (const Rcpp::List&); +void store(const unsigned int&, const ParBinomialFix&); }; // ============================================================= @@ -47,7 +49,7 @@ class ParOutBinomial { * object, M x K, to store the sampled para- * meters * @return ParOutBinomial object - * @detail reusage of memory allocated in R is done via the + * @detail reusage of memory allocated in R is done via the * Rcpp API and passing apointer to the Armadillo * matrix * @see arma::mat::mat(), Rcpp::List @@ -56,17 +58,18 @@ class ParOutBinomial { **/ ParOutBinomial::ParOutBinomial (const Rcpp::List& list) { - Rcpp::NumericMatrix tmpP((SEXP) list["p"]); - const unsigned int M = tmpP.nrow(); - const unsigned int K = tmpP.ncol(); - p = new arma::mat(tmpP.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpP((SEXP)list["p"]); + const unsigned int M = tmpP.nrow(); + const unsigned int K = tmpP.ncol(); + + p = new arma::mat(tmpP.begin(), M, K, false, true); } // ============================================================= // Store // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * store * @brief Stores the sampled parameters from step 'm'. @@ -77,10 +80,10 @@ ParOutBinomial::ParOutBinomial (const Rcpp::List& list) * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParOutBinomial::store (const unsigned int& m, - const ParBinomialFix& par) +void ParOutBinomial::store(const unsigned int& m, + const ParBinomialFix& par) { - (*p).row(m) = par.p; + (*p).row(m) = par.p; } #endif /* __FINMIX_PAROUTBINOMIAL_H__ */ diff --git a/src/ParOutCondPoisson.h b/src/ParOutCondPoisson.h index 10c23a0..1a971e7 100644 --- a/src/ParOutCondPoisson.h +++ b/src/ParOutCondPoisson.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PAROUTCONDPOISSON_H_ #define __FINMIX_PAROUTCONDPOISSON_H_ @@ -27,13 +27,15 @@ #include "ParCondPoissonFix.h" class ParOutCondPoisson { - public: - arma::mat* lambda; - Rcpp::NumericVector acc; +public: +arma::mat* lambda; +Rcpp::NumericVector acc; - ParOutCondPoisson () {} - ParOutCondPoisson (const Rcpp::List&); - void store(const unsigned int&, const ParCondPoissonFix&); +ParOutCondPoisson () +{ +} +ParOutCondPoisson (const Rcpp::List&); +void store(const unsigned int&, const ParCondPoissonFix&); }; // ============================================================= @@ -49,7 +51,7 @@ class ParOutCondPoisson { * object, M x K, to store the sampled para- * meters * @return ParOutPoisson object - * @detail Reusage of memory allocated in R is done via the + * @detail Reusage of memory allocated in R is done via the * Rcpp API and passing a pointer to the Armadillo * matrix. * @see arma::mat::mat(), Rcpp::List @@ -57,19 +59,20 @@ class ParOutCondPoisson { * ------------------------------------------------------------ **/ ParOutCondPoisson::ParOutCondPoisson(const Rcpp::List& list) : - acc((SEXP) list["acc"]) + acc((SEXP)list["acc"]) { - Rcpp::NumericMatrix tmpLambda((SEXP) list["lambda"]); - const unsigned int M = tmpLambda.nrow(); - const unsigned int K = tmpLambda.ncol(); - lambda = new arma::mat(tmpLambda.begin(), M, K, false, true); -} + Rcpp::NumericMatrix tmpLambda((SEXP)list["lambda"]); + const unsigned int M = tmpLambda.nrow(); + const unsigned int K = tmpLambda.ncol(); + + lambda = new arma::mat(tmpLambda.begin(), M, K, false, true); +} // ============================================================= // Store // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * store * @brief Stores the sampled parameters from step 'm'. @@ -80,10 +83,10 @@ ParOutCondPoisson::ParOutCondPoisson(const Rcpp::List& list) : * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParOutCondPoisson::store (const unsigned int& m, const ParCondPoissonFix& par) +void ParOutCondPoisson::store(const unsigned int& m, const ParCondPoissonFix& par) { - (*lambda).row(m) = par.lambda; - acc(0) = acc(0) + par.acc / (double) lambda->n_rows; + (*lambda).row(m) = par.lambda; + acc(0) = acc(0) + par.acc / (double)lambda->n_rows; } #endif diff --git a/src/ParOutExponential.h b/src/ParOutExponential.h index e06d849..ab4bc1a 100644 --- a/src/ParOutExponential.h +++ b/src/ParOutExponential.h @@ -1,37 +1,39 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PAROUTEXPONENTIAL_H__ #define __FINMIX_PAROUTEXPONENTIAL_H__ #include "ParExponentialFix.h" class ParOutExponential { - public: - arma::mat* lambda; +public: +arma::mat* lambda; - ParOutExponential () {} - ParOutExponential (const Rcpp::List&); - void store(const unsigned int&, const ParExponentialFix&); +ParOutExponential () +{ +} +ParOutExponential (const Rcpp::List&); +void store(const unsigned int&, const ParExponentialFix&); }; // ============================================================= @@ -47,26 +49,27 @@ class ParOutExponential { * object, M x K, to store the sampled para- * meters * @return ParOutExponential object - * @detail Reusage of memory allocated in R is done via the + * @detail Reusage of memory allocated in R is done via the * Rcpp API and passing a pointer to the Armadillo * matrix. * @see arma::mat::mat(), Rcpp::List * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -ParOutExponential::ParOutExponential(const Rcpp::List& list) +ParOutExponential::ParOutExponential(const Rcpp::List& list) { - Rcpp::NumericMatrix tmpLambda((SEXP) list["lambda"]); - const unsigned int M = tmpLambda.nrow(); - const unsigned int K = tmpLambda.ncol(); - lambda = new arma::mat(tmpLambda.begin(), M, K, false, true); -} + Rcpp::NumericMatrix tmpLambda((SEXP)list["lambda"]); + const unsigned int M = tmpLambda.nrow(); + const unsigned int K = tmpLambda.ncol(); + + lambda = new arma::mat(tmpLambda.begin(), M, K, false, true); +} // ============================================================= // Store // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * store * @brief Stores the sampled parameters from step 'm'. @@ -77,8 +80,8 @@ ParOutExponential::ParOutExponential(const Rcpp::List& list) * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParOutExponential::store (const unsigned int& m, const ParExponentialFix& par) +void ParOutExponential::store(const unsigned int& m, const ParExponentialFix& par) { - (*lambda).row(m) = par.lambda; + (*lambda).row(m) = par.lambda; } #endif// __FINMIX_PAROUTEXPONENTIAL_H__ diff --git a/src/ParOutNormal.h b/src/ParOutNormal.h index 378b9c5..e8d4e4b 100644 --- a/src/ParOutNormal.h +++ b/src/ParOutNormal.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PAROUTNORMAL_H__ #define __FINMIX_PAROUTNORMAL_H__ @@ -18,30 +18,35 @@ #include "ParNormalFix.h" class ParOutNormal { - public: - arma::mat* mu; - arma::mat* sigma; - - ParOutNormal () {} - ParOutNormal (const Rcpp::List&); - ~ParOutNormal () {} - void store (const unsigned int&, const ParNormalFix&); +public: +arma::mat* mu; +arma::mat* sigma; + +ParOutNormal () +{ +} +ParOutNormal (const Rcpp::List&); +~ParOutNormal () +{ +} +void store(const unsigned int&, const ParNormalFix&); }; ParOutNormal::ParOutNormal (const Rcpp::List& list) { - Rcpp::NumericMatrix tmpMu((SEXP) list["mu"]); - Rcpp::NumericMatrix tmpSigma((SEXP) list["sigma"]); - const unsigned int M = tmpMu.nrow(); - const unsigned int K = tmpMu.ncol(); - mu = new arma::mat(tmpMu.begin(), M, K, false, true); - sigma = new arma::mat(tmpSigma.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpMu((SEXP)list["mu"]); + Rcpp::NumericMatrix tmpSigma((SEXP)list["sigma"]); + const unsigned int M = tmpMu.nrow(); + const unsigned int K = tmpMu.ncol(); + + mu = new arma::mat(tmpMu.begin(), M, K, false, true); + sigma = new arma::mat(tmpSigma.begin(), M, K, false, true); } -void ParOutNormal::store (const unsigned int& m, const ParNormalFix& par) +void ParOutNormal::store(const unsigned int& m, const ParNormalFix& par) { - (*mu).row(m) = par.mu; - (*sigma).row(m) = par.sigma; + (*mu).row(m) = par.mu; + (*sigma).row(m) = par.sigma; } #endif /* __FINMIX_PAROUTNORMAL_H__ */ diff --git a/src/ParOutNormult.h b/src/ParOutNormult.h index b111156..d63b2a2 100644 --- a/src/ParOutNormult.h +++ b/src/ParOutNormult.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PAROUTNORMULT_H__ #define __FINMIX_PAROUTNORMULT_H__ @@ -19,55 +19,63 @@ #include "mincol.h" class ParOutNormult { - public: - arma::cube* mu; - arma::cube* sigma; - arma::cube* sigmainv; - unsigned int M; - unsigned int r; - unsigned int s; - unsigned int K; - bool STOREINV; +public: +arma::cube* mu; +arma::cube* sigma; +arma::cube* sigmainv; +unsigned int M; +unsigned int r; +unsigned int s; +unsigned int K; +bool STOREINV; - ParOutNormult () {} - ParOutNormult (const Rcpp::List&); - ~ParOutNormult () {} - void store (const unsigned int&, const ParNormultFix&); +ParOutNormult () +{ +} +ParOutNormult (const Rcpp::List&); +~ParOutNormult () +{ +} +void store(const unsigned int&, const ParNormultFix&); }; ParOutNormult::ParOutNormult (const Rcpp::List& list) : - M(0), r(0), s(0), K(0), STOREINV(false) + M(0), r(0), s(0), K(0), STOREINV(false) { - STOREINV = Rcpp::as(list["storeinv"]); - /* mu is an (M x r x K) array */ - Rcpp::NumericVector tmpMu((SEXP) list["mu"]); - Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); - M = tmpMuDim[0]; - r = tmpMuDim[1]; - s = r * (r + 1) / 2; - K = tmpMuDim[2]; - mu = new arma::cube(tmpMu.begin(), M, r, K, false, true); - /* sigma is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpSigma((SEXP) list["sigma"]); - sigma = new arma::cube(tmpSigma.begin(), M, s, K, false, true); - if (STOREINV) { - /* sigmainv is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpSigmaInv((SEXP) list["sigmainv"]); - sigmainv = new arma::cube(tmpSigmaInv.begin(), M, s, K, false, true); - } + STOREINV = Rcpp::as(list["storeinv"]); + /* mu is an (M x r x K) array */ + Rcpp::NumericVector tmpMu((SEXP)list["mu"]); + Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); + + M = tmpMuDim[0]; + r = tmpMuDim[1]; + s = r * (r + 1) / 2; + K = tmpMuDim[2]; + mu = new arma::cube(tmpMu.begin(), M, r, K, false, true); + /* sigma is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpSigma((SEXP)list["sigma"]); + + sigma = new arma::cube(tmpSigma.begin(), M, s, K, false, true); + if (STOREINV) + { + /* sigmainv is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpSigmaInv((SEXP)list["sigmainv"]); + sigmainv = new arma::cube(tmpSigmaInv.begin(), M, s, K, false, true); + } } -void ParOutNormult::store (const unsigned int& m, const ParNormultFix& par) +void ParOutNormult::store(const unsigned int& m, const ParNormultFix& par) { - /* mu is a r x K matrix */ - mu->tube(m, 0, m, r - 1) = par.mu; - /* sigma is a cube and is transformed to an r * (r + 1) / 2 matrix */ - sigma->tube(m, 0, m, s - 1) = cincolmat(par.sigma); - if (STOREINV) { - /* sigmainv is a cube and is transformed to an r * (r + 1) / 2 matrix */ - arma::mat tmp = cincolmat(par.sigmainv); - sigmainv->tube(m, 0, m, s - 1) = cincolmat(par.sigmainv); - } + /* mu is a r x K matrix */ + mu->tube(m, 0, m, r - 1) = par.mu; + /* sigma is a cube and is transformed to an r * (r + 1) / 2 matrix */ + sigma->tube(m, 0, m, s - 1) = cincolmat(par.sigma); + if (STOREINV) + { + /* sigmainv is a cube and is transformed to an r * (r + 1) / 2 matrix */ + arma::mat tmp = cincolmat(par.sigmainv); + sigmainv->tube(m, 0, m, s - 1) = cincolmat(par.sigmainv); + } } #endif /* __FINMIX_PAROUTNORMULT_H__ */ diff --git a/src/ParOutPoisson.h b/src/ParOutPoisson.h index 9525852..5c1bb2d 100644 --- a/src/ParOutPoisson.h +++ b/src/ParOutPoisson.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #ifndef PAROUTPOISSON_H #define PAROUTPOISSON_H @@ -27,12 +27,14 @@ #include "ParPoissonFix.h" class ParOutPoisson { - public: - arma::mat* lambda; +public: +arma::mat* lambda; - ParOutPoisson () {} - ParOutPoisson (const Rcpp::List&); - void store(const unsigned int&, const ParPoissonFix&); +ParOutPoisson () +{ +} +ParOutPoisson (const Rcpp::List&); +void store(const unsigned int&, const ParPoissonFix&); }; // ============================================================= @@ -48,26 +50,27 @@ class ParOutPoisson { * object, M x K, to store the sampled para- * meters * @return ParOutPoisson object - * @detail Reusage of memory allocated in R is done via the + * @detail Reusage of memory allocated in R is done via the * Rcpp API and passing a pointer to the Armadillo * matrix. * @see arma::mat::mat(), Rcpp::List * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -ParOutPoisson::ParOutPoisson(const Rcpp::List& list) +ParOutPoisson::ParOutPoisson(const Rcpp::List& list) { - Rcpp::NumericMatrix tmpLambda((SEXP) list["lambda"]); - const unsigned int M = tmpLambda.nrow(); - const unsigned int K = tmpLambda.ncol(); - lambda = new arma::mat(tmpLambda.begin(), M, K, false, true); -} + Rcpp::NumericMatrix tmpLambda((SEXP)list["lambda"]); + const unsigned int M = tmpLambda.nrow(); + const unsigned int K = tmpLambda.ncol(); + + lambda = new arma::mat(tmpLambda.begin(), M, K, false, true); +} // ============================================================= // Store // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * store * @brief Stores the sampled parameters from step 'm'. @@ -78,8 +81,8 @@ ParOutPoisson::ParOutPoisson(const Rcpp::List& list) * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void ParOutPoisson::store (const unsigned int& m, const ParPoissonFix& par) +void ParOutPoisson::store(const unsigned int& m, const ParPoissonFix& par) { - (*lambda).row(m) = par.lambda; + (*lambda).row(m) = par.lambda; } #endif diff --git a/src/ParOutStudent.h b/src/ParOutStudent.h index 44bfac4..8cc3e4a 100644 --- a/src/ParOutStudent.h +++ b/src/ParOutStudent.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PAROUTSTUDENT_H__ #define __FINMIX_PAROUTSTUDENT_H__ @@ -18,39 +18,44 @@ #include "ParStudentFix.h" class ParOutStudent { - public: - arma::mat* mu; - arma::mat* sigma; - arma::mat* df; - arma::rowvec* acc; - - ParOutStudent () {} - ParOutStudent (const Rcpp::List& list); - ~ParOutStudent () {} - void store (const unsigned int&, const ParStudentFix&); +public: +arma::mat* mu; +arma::mat* sigma; +arma::mat* df; +arma::rowvec* acc; + +ParOutStudent () +{ +} +ParOutStudent (const Rcpp::List& list); +~ParOutStudent () +{ +} +void store(const unsigned int&, const ParStudentFix&); }; ParOutStudent::ParOutStudent (const Rcpp::List& list) { - Rcpp::NumericMatrix tmpMu((SEXP) list["mu"]); - Rcpp::NumericMatrix tmpSigma((SEXP) list["sigma"]); - Rcpp::NumericMatrix tmpDf((SEXP) list["df"]); - Rcpp::NumericVector tmpAcc((SEXP) list["acc"]); - const unsigned int M = tmpMu.nrow(); - const unsigned int K = tmpMu.ncol(); - mu = new arma::mat(tmpMu.begin(), M, K, false, true); - sigma = new arma::mat(tmpSigma.begin(), M, K, false, true); - df = new arma::mat(tmpDf.begin(), M, K, false, true); - acc = new arma::rowvec(tmpAcc.begin(), K, false, true); + Rcpp::NumericMatrix tmpMu((SEXP)list["mu"]); + Rcpp::NumericMatrix tmpSigma((SEXP)list["sigma"]); + Rcpp::NumericMatrix tmpDf((SEXP)list["df"]); + Rcpp::NumericVector tmpAcc((SEXP)list["acc"]); + const unsigned int M = tmpMu.nrow(); + const unsigned int K = tmpMu.ncol(); + + mu = new arma::mat(tmpMu.begin(), M, K, false, true); + sigma = new arma::mat(tmpSigma.begin(), M, K, false, true); + df = new arma::mat(tmpDf.begin(), M, K, false, true); + acc = new arma::rowvec(tmpAcc.begin(), K, false, true); } inline -void ParOutStudent::store (const unsigned int& m, const ParStudentFix& par) +void ParOutStudent::store(const unsigned int& m, const ParStudentFix& par) { - (*mu).row(m) = par.mu; - (*sigma).row(m) = par.sigma; - (*df).row(m) = par.df; - *acc = *acc + par.acc / (double) mu->n_rows; + (*mu).row(m) = par.mu; + (*sigma).row(m) = par.sigma; + (*df).row(m) = par.df; + *acc = *acc + par.acc / (double)mu->n_rows; } #endif /* __FINMIX_PAROUTSTUDENT_H__ */ diff --git a/src/ParOutStudmult.h b/src/ParOutStudmult.h index c386c4b..99c4088 100644 --- a/src/ParOutStudmult.h +++ b/src/ParOutStudmult.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PAROUTSTUDMULT_H__ #define __FINMIX_PAROUTSTUDMULT_H__ @@ -19,64 +19,73 @@ #include "mincol.h" class ParOutStudmult { - public: - arma::cube* mu; - arma::cube* sigma; - arma::cube* sigmainv; - arma::mat* df; - arma::rowvec* acc; - unsigned int M; - unsigned int r; - unsigned int s; - unsigned int K; - bool STOREINV; +public: +arma::cube* mu; +arma::cube* sigma; +arma::cube* sigmainv; +arma::mat* df; +arma::rowvec* acc; +unsigned int M; +unsigned int r; +unsigned int s; +unsigned int K; +bool STOREINV; - ParOutStudmult () {} - ParOutStudmult (const Rcpp::List&); - ~ParOutStudmult () {} - void store (const unsigned int&, const ParStudmultFix&); +ParOutStudmult () +{ +} +ParOutStudmult (const Rcpp::List&); +~ParOutStudmult () +{ +} +void store(const unsigned int&, const ParStudmultFix&); }; ParOutStudmult::ParOutStudmult (const Rcpp::List& list) : - M(0), r(0), s(0), K(0),STOREINV(false) + M(0), r(0), s(0), K(0), STOREINV(false) { - STOREINV = Rcpp::as(list["storeinv"]); - /* mu is an (M x r x K) array */ - Rcpp::NumericVector tmpMu((SEXP) list["mu"]); - Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); - M = tmpMuDim[0]; - r = tmpMuDim[1]; - s = r * (r + 1) / 2; - K = tmpMuDim[2]; - mu = new arma::cube(tmpMu.begin(), M, r, K, false, true); - /* sigma is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpSigma((SEXP) list["sigma"]); - sigma = new arma::cube(tmpSigma.begin(), M, s, K, false, true); - if (STOREINV) { - /* sigmainv is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpSigmaInv((SEXP) list["sigmainv"]); - sigmainv = new arma::cube(tmpSigmaInv.begin(), M, s, K, false, true); - } - /* df is an M x K array */ - Rcpp::NumericMatrix tmpDf((SEXP) list["df"]); - Rcpp::NumericVector tmpAcc((SEXP) list["acc"]); - df = new arma::mat(tmpDf.begin(), M, K, false, true); - acc = new arma::rowvec(tmpAcc.begin(), K, false, true); + STOREINV = Rcpp::as(list["storeinv"]); + /* mu is an (M x r x K) array */ + Rcpp::NumericVector tmpMu((SEXP)list["mu"]); + Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); + + M = tmpMuDim[0]; + r = tmpMuDim[1]; + s = r * (r + 1) / 2; + K = tmpMuDim[2]; + mu = new arma::cube(tmpMu.begin(), M, r, K, false, true); + /* sigma is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpSigma((SEXP)list["sigma"]); + + sigma = new arma::cube(tmpSigma.begin(), M, s, K, false, true); + if (STOREINV) + { + /* sigmainv is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpSigmaInv((SEXP)list["sigmainv"]); + sigmainv = new arma::cube(tmpSigmaInv.begin(), M, s, K, false, true); + } + /* df is an M x K array */ + Rcpp::NumericMatrix tmpDf((SEXP)list["df"]); + Rcpp::NumericVector tmpAcc((SEXP)list["acc"]); + + df = new arma::mat(tmpDf.begin(), M, K, false, true); + acc = new arma::rowvec(tmpAcc.begin(), K, false, true); } -void ParOutStudmult::store (const unsigned int& m, const ParStudmultFix& par) +void ParOutStudmult::store(const unsigned int& m, const ParStudmultFix& par) { - /* mu is a r x K matrix */ - mu->tube(m, 0, m, r - 1) = par.mu; - /* sigma is a cube and is transformed to an r * (r + 1) / 2 matrix */ - sigma->tube(m, 0, m, s - 1) = cincolmat(par.sigma); - if (STOREINV) { - /* sigmainv is a cube and is transformed to an r * (r + 1) / 2 matrix */ - arma::mat tmp = cincolmat(par.sigmainv); - sigmainv->tube(m, 0, m, s - 1) = cincolmat(par.sigmainv); - } - df->row(m) = par.df; - *acc = *acc + par.acc / (double) mu->n_rows; + /* mu is a r x K matrix */ + mu->tube(m, 0, m, r - 1) = par.mu; + /* sigma is a cube and is transformed to an r * (r + 1) / 2 matrix */ + sigma->tube(m, 0, m, s - 1) = cincolmat(par.sigma); + if (STOREINV) + { + /* sigmainv is a cube and is transformed to an r * (r + 1) / 2 matrix */ + arma::mat tmp = cincolmat(par.sigmainv); + sigmainv->tube(m, 0, m, s - 1) = cincolmat(par.sigmainv); + } + df->row(m) = par.df; + *acc = *acc + par.acc / (double)mu->n_rows; } #endif /* __FINMIX_PAROUTSTUDMULT_H__ */ diff --git a/src/ParPoissonFix.cpp b/src/ParPoissonFix.cpp index 0e039a3..97768da 100644 --- a/src/ParPoissonFix.cpp +++ b/src/ParPoissonFix.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with 'finmix'. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with 'finmix'. If not, see . +* +******************************************************************************/ #include "ParPoissonFix.h" // ============================================================= @@ -31,32 +31,33 @@ * @brief Constructs object from model parameters. * @par STARTPAR boolean, indicating if it should be started * by sampling the parameters - * @par model FinmixModel object, holding model + * @par model FinmixModel object, holding model * definitions and starting parameters * @return an object of class ParPoissonFix * @detail If STARTPAR == FALSE it should be started by sampling - * the indicators and starting parameters are provided + * the indicators and starting parameters are provided * by the model parameter * @see ?model in R * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -ParPoissonFix::ParPoissonFix (const bool& STARTPAR, - const FinmixModel& model) : lambda(model.K) +ParPoissonFix::ParPoissonFix (const bool& STARTPAR, + const FinmixModel& model) : lambda(model.K) { - if(!STARTPAR && model.K > 1) { - arma::rowvec tmp = Rcpp::as - ((SEXP) model.par["lambda"]); - lambda = tmp; - } -} + if (!STARTPAR && model.K > 1) + { + arma::rowvec tmp = Rcpp::as + ((SEXP)model.par["lambda"]); + lambda = tmp; + } +} // ============================================================= // Update // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * update * @brief Updates the parameters of the Poisson model @@ -68,13 +69,13 @@ ParPoissonFix::ParPoissonFix (const bool& STARTPAR, * ------------------------------------------------------------- **/ -void ParPoissonFix::update (const PriorPoissonFix& hyperPar) +void ParPoissonFix::update(const PriorPoissonFix& hyperPar) { - lambda = rgammaprod(hyperPar.aPost, hyperPar.bPost); + lambda = rgammaprod(hyperPar.aPost, hyperPar.bPost); } -void ParPoissonFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +void ParPoissonFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - lambda(compIndex) = lambda(permIndex); + lambda(compIndex) = lambda(permIndex); } diff --git a/src/ParPoissonFix.h b/src/ParPoissonFix.h index 7da54bd..c0395e6 100644 --- a/src/ParPoissonFix.h +++ b/src/ParPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef PARPOISSONFIX_H #define PARPOISSONFIX_H @@ -29,14 +29,16 @@ #include "distributions.h" class ParPoissonFix { - public: - arma::rowvec lambda; - - ParPoissonFix (const bool&, - const FinmixModel&); - virtual ~ParPoissonFix () {} - void update (const PriorPoissonFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +public: +arma::rowvec lambda; + +ParPoissonFix (const bool&, + const FinmixModel&); +virtual ~ParPoissonFix () +{ +} +void update(const PriorPoissonFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif diff --git a/src/ParPoissonInd.cpp b/src/ParPoissonInd.cpp index 3a44898..3910bb7 100644 --- a/src/ParPoissonInd.cpp +++ b/src/ParPoissonInd.cpp @@ -1,39 +1,40 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "ParPoissonInd.h" -ParPoissonInd::ParPoissonInd (const bool& STARTPAR, - const FinmixModel& model) : - ParPoissonFix(STARTPAR, model), - weight(model.K) +ParPoissonInd::ParPoissonInd (const bool& STARTPAR, + const FinmixModel& model) : + ParPoissonFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } -void ParPoissonInd::update (const PriorPoissonInd& hyperPar) +void ParPoissonInd::update(const PriorPoissonInd& hyperPar) { - ParPoissonFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParPoissonFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParPoissonInd.h b/src/ParPoissonInd.h index c28dad5..db11312 100644 --- a/src/ParPoissonInd.h +++ b/src/ParPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef PARPOISSONIND_H #define PARPOISSONIND_H @@ -28,12 +28,14 @@ #include "PriorPoissonInd.h" class ParPoissonInd : virtual public ParPoissonFix { - public: - arma::rowvec weight; - - ParPoissonInd (const bool&, - const FinmixModel&); - virtual ~ParPoissonInd () {} - void update (const PriorPoissonInd&); +public: +arma::rowvec weight; + +ParPoissonInd (const bool&, + const FinmixModel&); +virtual ~ParPoissonInd () +{ +} +void update(const PriorPoissonInd&); }; #endif diff --git a/src/ParStudentFix.cpp b/src/ParStudentFix.cpp index 51befc5..719ec16 100644 --- a/src/ParStudentFix.cpp +++ b/src/ParStudentFix.cpp @@ -1,35 +1,39 @@ #include "ParStudentFix.h" -ParStudentFix::ParStudentFix (const bool& STARTPAR, - const FinmixModel& model) : mu(model.K), - sigma(model.K), acc(model.K), INDEPENDENT(false) +ParStudentFix::ParStudentFix (const bool& STARTPAR, + const FinmixModel& model) : mu(model.K), + sigma(model.K), acc(model.K), INDEPENDENT(false) { - if (!Rf_isNull(model.par)) { - if (!Rf_isNull(model.par["mu"])) { - mu = Rcpp::as(model.par["mu"]); - } - if (!Rf_isNull(model.par["df"])) { - df = Rcpp::as(model.par["df"]); - } - } - if (!STARTPAR && model.K > 1) { - arma::rowvec tmpsigma = Rcpp::as - ((SEXP) model.par["sigma"]); - sigma = tmpsigma; - } + if (!Rf_isNull(model.par)) + { + if (!Rf_isNull(model.par["mu"])) + { + mu = Rcpp::as(model.par["mu"]); + } + if (!Rf_isNull(model.par["df"])) + { + df = Rcpp::as(model.par["df"]); + } + } + if (!STARTPAR && model.K > 1) + { + arma::rowvec tmpsigma = Rcpp::as + ((SEXP)model.par["sigma"]); + sigma = tmpsigma; + } } inline -void ParStudentFix::update (const PriorStudentFix& hyperPar) +void ParStudentFix::update(const PriorStudentFix& hyperPar) { - /* See PriorStudentFix.cc */ + /* See PriorStudentFix.cc */ } inline -void ParStudentFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +void ParStudentFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - mu(compIndex) = mu(permIndex); - sigma(compIndex) = sigma(permIndex); - df(compIndex) = df(permIndex); + mu(compIndex) = mu(permIndex); + sigma(compIndex) = sigma(permIndex); + df(compIndex) = df(permIndex); } diff --git a/src/ParStudentFix.h b/src/ParStudentFix.h index eb50b1c..58735f2 100644 --- a/src/ParStudentFix.h +++ b/src/ParStudentFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARSTUDENTFIX_H__ #define __FINMIX_PARSTUDENTFIX_H__ @@ -19,18 +19,20 @@ #include "PriorStudentFix.h" class ParStudentFix { - public: - arma::rowvec mu; - arma::rowvec sigma; - arma::rowvec df; - arma::rowvec acc; - bool INDEPENDENT; +public: +arma::rowvec mu; +arma::rowvec sigma; +arma::rowvec df; +arma::rowvec acc; +bool INDEPENDENT; - ParStudentFix (const bool&, const FinmixModel&); - virtual ~ParStudentFix () {} - virtual void update (const PriorStudentFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +ParStudentFix (const bool&, const FinmixModel&); +virtual ~ParStudentFix () +{ +} +virtual void update(const PriorStudentFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif /* __FINMIX_PARSTUDENTFIX_H__ */ diff --git a/src/ParStudentInd.cpp b/src/ParStudentInd.cpp index 4ab5b87..d944440 100644 --- a/src/ParStudentInd.cpp +++ b/src/ParStudentInd.cpp @@ -1,18 +1,19 @@ #include "ParStudentInd.h" #include "distributions.h" -ParStudentInd::ParStudentInd (const bool& STARTPAR, - const FinmixModel& model) : - ParStudentFix(STARTPAR, model), - weight(model.K) +ParStudentInd::ParStudentInd (const bool& STARTPAR, + const FinmixModel& model) : + ParStudentFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } inline -void ParStudentInd::update (const PriorStudentInd& hyperPar) +void ParStudentInd::update(const PriorStudentInd& hyperPar) { - weight = rdirichlet(hyperPar.weightPost); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParStudentInd.h b/src/ParStudentInd.h index f860fa1..c7efd45 100644 --- a/src/ParStudentInd.h +++ b/src/ParStudentInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARSTUDENTIND_H__ #define __FINMIX_PARSTUDENTIND_H__ @@ -19,13 +19,15 @@ #include "PriorStudentInd.h" class ParStudentInd : virtual public ParStudentFix { - public: - arma::rowvec weight; +public: +arma::rowvec weight; - ParStudentInd (const bool&, - const FinmixModel&); - virtual ~ParStudentInd () {} - virtual void update (const PriorStudentInd&); +ParStudentInd (const bool&, + const FinmixModel&); +virtual ~ParStudentInd () +{ +} +virtual void update(const PriorStudentInd&); }; #endif /* __FINMIX_PARSTUDENTIND_H__ */ diff --git a/src/ParStudmultFix.cpp b/src/ParStudmultFix.cpp index 3e02843..9d35036 100644 --- a/src/ParStudmultFix.cpp +++ b/src/ParStudmultFix.cpp @@ -2,44 +2,50 @@ #include "distributions.h" ParStudmultFix::ParStudmultFix (const bool& STARTPAR, - const FinmixModel& model) : mu(model.K, model.r), - sigma(model.r, model.r, model.K), - sigmainv(model.r, model.r, model.K), df(model.K), - acc(model.K), INDEPENDENT(true) + const FinmixModel& model) : mu(model.K, model.r), + sigma(model.r, model.r, model.K), + sigmainv(model.r, model.r, model.K), df(model.K), + acc(model.K), INDEPENDENT(true) { - acc.fill(0.0); - if (model.par.size() > 0) { - if (!Rf_isNull(model.par["mu"])) { - mu = Rcpp::as(model.par["mu"]); - } - if (!Rf_isNull(model.par["df"])) { - df = Rcpp::as(model.par["df"]); - } - } - if (!STARTPAR && model.K > 1) { - Rcpp::NumericVector tmpSigma((SEXP) model.par["sigma"]); - Rcpp::IntegerVector tmpDim = tmpSigma.attr("dim"); - sigma = arma::cube(tmpSigma.begin(), tmpDim[0], tmpDim[1], tmpDim[2], true, true); - Rcpp::NumericVector tmpDf((SEXP) model.par["df"]); - df = arma::rowvec(tmpDf.begin(), model.K, true, true); - } + acc.fill(0.0); + if (model.par.size() > 0) + { + if (!Rf_isNull(model.par["mu"])) + { + mu = Rcpp::as(model.par["mu"]); + } + if (!Rf_isNull(model.par["df"])) + { + df = Rcpp::as(model.par["df"]); + } + } + if (!STARTPAR && model.K > 1) + { + Rcpp::NumericVector tmpSigma((SEXP)model.par["sigma"]); + Rcpp::IntegerVector tmpDim = tmpSigma.attr("dim"); + sigma = arma::cube(tmpSigma.begin(), tmpDim[0], tmpDim[1], tmpDim[2], true, true); + Rcpp::NumericVector tmpDf((SEXP)model.par["df"]); + df = arma::rowvec(tmpDf.begin(), model.K, true, true); + } } inline -void ParStudmultFix::update (PriorStudmultFix& hyperPar) +void ParStudmultFix::update(PriorStudmultFix& hyperPar) { - /* See PriorStudmultFix.cc */ + /* See PriorStudmultFix.cc */ } -inline -void ParStudmultFix::permute (const arma::urowvec& compIndex, - const arma::urowvec& permIndex) +inline +void ParStudmultFix::permute(const arma::urowvec& compIndex, + const arma::urowvec& permIndex) { - mu.cols(compIndex) = mu.cols(permIndex); - arma::cube tmpSigma = sigma; - arma::cube tmpSigmaInv = sigmainv; - for (unsigned int k = 0; k < sigma.n_slices; ++k) { - sigma.slice(compIndex(k)) = tmpSigma.slice(permIndex(k)); - sigmainv.slice(compIndex(k)) = tmpSigmaInv.slice(permIndex(k)); - } + mu.cols(compIndex) = mu.cols(permIndex); + arma::cube tmpSigma = sigma; + arma::cube tmpSigmaInv = sigmainv; + + for (unsigned int k = 0; k < sigma.n_slices; ++k) + { + sigma.slice(compIndex(k)) = tmpSigma.slice(permIndex(k)); + sigmainv.slice(compIndex(k)) = tmpSigmaInv.slice(permIndex(k)); + } } diff --git a/src/ParStudmultFix.h b/src/ParStudmultFix.h index 26bd620..570c724 100644 --- a/src/ParStudmultFix.h +++ b/src/ParStudmultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARSTUDMULTFIX_H__ #define __FINMIX_PARSTUDMULTFIX_H__ @@ -19,19 +19,21 @@ #include "PriorStudmultFix.h" class ParStudmultFix { - public: - arma::mat mu; - arma::cube sigma; - arma::cube sigmainv; - arma::rowvec df; - arma::rowvec acc; - bool INDEPENDENT; +public: +arma::mat mu; +arma::cube sigma; +arma::cube sigmainv; +arma::rowvec df; +arma::rowvec acc; +bool INDEPENDENT; - ParStudmultFix (const bool&, const FinmixModel&); - virtual ~ParStudmultFix () {} - virtual void update (PriorStudmultFix&); - virtual void permute (const arma::urowvec&, - const arma::urowvec&); +ParStudmultFix (const bool&, const FinmixModel&); +virtual ~ParStudmultFix () +{ +} +virtual void update(PriorStudmultFix&); +virtual void permute(const arma::urowvec&, + const arma::urowvec&); }; #endif /* __FINMIX_PARSTUDMULTFIX_H__ */ diff --git a/src/ParStudmultInd.cpp b/src/ParStudmultInd.cpp index 77e12df..d9be2a2 100644 --- a/src/ParStudmultInd.cpp +++ b/src/ParStudmultInd.cpp @@ -2,17 +2,18 @@ #include "distributions.h" ParStudmultInd::ParStudmultInd (const bool& STARTPAR, - const FinmixModel& model) : - ParStudmultFix(STARTPAR, model), - weight(model.K) + const FinmixModel& model) : + ParStudmultFix(STARTPAR, model), + weight(model.K) { - if (!STARTPAR && model.K > 1) { - weight = model.weight; - } + if (!STARTPAR && model.K > 1) + { + weight = model.weight; + } } -void ParStudmultInd::update (PriorStudmultInd& hyperPar) +void ParStudmultInd::update(PriorStudmultInd& hyperPar) { - ParStudmultFix::update(hyperPar); - weight = rdirichlet(hyperPar.weightPost); + ParStudmultFix::update(hyperPar); + weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParStudmultInd.h b/src/ParStudmultInd.h index afe59f2..f5b6ec0 100644 --- a/src/ParStudmultInd.h +++ b/src/ParStudmultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PARSTUDMULTIND_H__ #define __FINMIX_PARSTUDMULTIND_H__ @@ -19,12 +19,14 @@ #include "PriorStudmultInd.h" class ParStudmultInd : virtual public ParStudmultFix { - public: - arma::rowvec weight; +public: +arma::rowvec weight; - ParStudmultInd (const bool&, const FinmixModel&); - virtual ~ParStudmultInd () {} - void update (PriorStudmultInd&); +ParStudmultInd (const bool&, const FinmixModel&); +virtual ~ParStudmultInd () +{ +} +void update(PriorStudmultInd&); }; #endif /* __FINMIX_PARSTUDMULTIND_H__ */ diff --git a/src/PostOutBinomialFix.h b/src/PostOutBinomialFix.h index 9367cd8..b5eece7 100644 --- a/src/PostOutBinomialFix.h +++ b/src/PostOutBinomialFix.h @@ -1,40 +1,44 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTBINOMIALFIX_H__ #define __FINMIX_POSTOUTBINOMIALFIX_H__ #include "PriorBinomialFix.h" class PostOutBinomialFix { - public: - arma::mat *a; - arma::mat *b; +public: +arma::mat *a; +arma::mat *b; - PostOutBinomialFix () {} - PostOutBinomialFix (const Rcpp::List&); - ~PostOutBinomialFix () {} - void store (const unsigned int&, - const PriorBinomialFix&); +PostOutBinomialFix () +{ +} +PostOutBinomialFix (const Rcpp::List&); +~PostOutBinomialFix () +{ +} +void store(const unsigned int&, + const PriorBinomialFix&); }; // ============================================================= @@ -50,7 +54,7 @@ class PostOutBinomialFix { * object, M x K, to store the sampled para- * meters * @return ParOutBinomial object - * @detail reusage of memory allocated in R is done via the + * @detail reusage of memory allocated in R is done via the * Rcpp API and passing apointer to the Armadillo * matrix * @see arma::mat::mat(), Rcpp::List @@ -59,20 +63,21 @@ class PostOutBinomialFix { **/ PostOutBinomialFix::PostOutBinomialFix (const Rcpp::List& list) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::NumericMatrix tmpA((SEXP) tmpList["a"]); - Rcpp::NumericMatrix tmpB((SEXP) tmpList["b"]); - const unsigned int M = tmpA.nrow(); - const unsigned int K = tmpA.ncol(); - a = new arma::mat(tmpA.begin(), M, K, false, true); - b = new arma::mat(tmpB.begin(), M, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::NumericMatrix tmpA((SEXP)tmpList["a"]); + Rcpp::NumericMatrix tmpB((SEXP)tmpList["b"]); + const unsigned int M = tmpA.nrow(); + const unsigned int K = tmpA.ncol(); + + a = new arma::mat(tmpA.begin(), M, K, false, true); + b = new arma::mat(tmpB.begin(), M, K, false, true); } // ============================================================= // Store // ------------------------------------------------------------- -/** +/** * ------------------------------------------------------------- * store * @brief Stores the posterior hyper parameters from step 'm'. @@ -83,11 +88,11 @@ PostOutBinomialFix::PostOutBinomialFix (const Rcpp::List& list) * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -void PostOutBinomialFix::store (const unsigned int& m, - const PriorBinomialFix& hyperPar) +void PostOutBinomialFix::store(const unsigned int& m, + const PriorBinomialFix& hyperPar) { - (*a).row(m) = hyperPar.aPost; - (*b).row(m) = hyperPar.bPost; + (*a).row(m) = hyperPar.aPost; + (*b).row(m) = hyperPar.bPost; } #endif /* __FINMIX_POSTOUTBINOMIALFIX_H__ */ diff --git a/src/PostOutBinomialInd.h b/src/PostOutBinomialInd.h index 1e4a9e7..38baeea 100644 --- a/src/PostOutBinomialInd.h +++ b/src/PostOutBinomialInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTBINOMIALIND_H__ #define __FINMIX_POSTOUTBINOMIALIND_H__ @@ -19,30 +19,32 @@ #include "PriorBinomialInd.h" class PostOutBinomialInd : public PostOutBinomialFix { - public: - arma::mat* weight; - - PostOutBinomialInd (const Rcpp::List&); - virtual ~PostOutBinomialInd () {} - virtual void store (const unsigned int& m, - const PriorBinomialInd&); - +public: +arma::mat* weight; + +PostOutBinomialInd (const Rcpp::List&); +virtual ~PostOutBinomialInd () +{ +} +virtual void store(const unsigned int& m, + const PriorBinomialInd&); }; PostOutBinomialInd::PostOutBinomialInd (const Rcpp::List& list) : - PostOutBinomialFix(list) + PostOutBinomialFix(list) { - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - const unsigned int M = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + const unsigned int M = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } void PostOutBinomialInd::store(const unsigned int& m, - const PriorBinomialInd& hyperPar) + const PriorBinomialInd& hyperPar) { - PostOutBinomialFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutBinomialFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif /* __FINMIX_POSTOUTBINOMIALIND_H__ */ diff --git a/src/PostOutCondPoissonFix.h b/src/PostOutCondPoissonFix.h index c78949c..7f9b919 100644 --- a/src/PostOutCondPoissonFix.h +++ b/src/PostOutCondPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTPOISSONFIX_H_ #define __FINMIX_POSTOUTPOISSONFIX_H_ @@ -27,32 +27,37 @@ #include "PriorCondPoissonFix.h" class PostOutCondPoissonFix { - public: - arma::mat *Q; - arma::mat *N; +public: +arma::mat *Q; +arma::mat *N; - PostOutCondPoissonFix () {} - PostOutCondPoissonFix (const Rcpp::List&); - ~PostOutCondPoissonFix () {} - void store (const unsigned int&, - const PriorCondPoissonFix&); +PostOutCondPoissonFix () +{ +} +PostOutCondPoissonFix (const Rcpp::List&); +~PostOutCondPoissonFix () +{ +} +void store(const unsigned int&, + const PriorCondPoissonFix&); }; -PostOutCondPoissonFix::PostOutCondPoissonFix (const Rcpp::List& list) +PostOutCondPoissonFix::PostOutCondPoissonFix (const Rcpp::List& list) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::NumericMatrix tmpQ((SEXP) tmpList["Q"]); - Rcpp::NumericMatrix tmpN((SEXP) tmpList["N"]); - const unsigned int M = tmpQ.nrow(); - const unsigned int K = tmpQ.ncol(); - Q = new arma::mat(tmpQ.begin(), M, K, false, true); - N = new arma::mat(tmpN.begin(), M, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::NumericMatrix tmpQ((SEXP)tmpList["Q"]); + Rcpp::NumericMatrix tmpN((SEXP)tmpList["N"]); + const unsigned int M = tmpQ.nrow(); + const unsigned int K = tmpQ.ncol(); + + Q = new arma::mat(tmpQ.begin(), M, K, false, true); + N = new arma::mat(tmpN.begin(), M, K, false, true); } -void PostOutCondPoissonFix::store (const unsigned int& m, - const PriorCondPoissonFix& hyperPar) +void PostOutCondPoissonFix::store(const unsigned int& m, + const PriorCondPoissonFix& hyperPar) { - (*Q).row(m) = hyperPar.Q; - (*N).row(m) = hyperPar.N; + (*Q).row(m) = hyperPar.Q; + (*N).row(m) = hyperPar.N; } #endif diff --git a/src/PostOutCondPoissonInd.h b/src/PostOutCondPoissonInd.h index f11cfe5..9517632 100644 --- a/src/PostOutCondPoissonInd.h +++ b/src/PostOutCondPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTCONDPOISSONIND_H_ #define __FINMIX_POSTOUTCONDPOISSONIND_H_ @@ -28,28 +28,31 @@ #include "PriorCondPoissonInd.h" class PostOutCondPoissonInd : public PostOutCondPoissonFix { - public: - arma::mat* weight; - - PostOutCondPoissonInd (const Rcpp::List&); - virtual ~PostOutCondPoissonInd () {} - virtual void store (const unsigned int&, - const PriorCondPoissonInd&); +public: +arma::mat* weight; + +PostOutCondPoissonInd (const Rcpp::List&); +virtual ~PostOutCondPoissonInd () +{ +} +virtual void store(const unsigned int&, + const PriorCondPoissonInd&); }; PostOutCondPoissonInd::PostOutCondPoissonInd (const Rcpp::List& list) : - PostOutCondPoissonFix(list) -{ - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - const unsigned int M = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + PostOutCondPoissonFix(list) +{ + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + const unsigned int M = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } -void PostOutCondPoissonInd::store (const unsigned int& m, - const PriorCondPoissonInd& hyperPar) +void PostOutCondPoissonInd::store(const unsigned int& m, + const PriorCondPoissonInd& hyperPar) { - PostOutCondPoissonFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutCondPoissonFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif // __FINMIX_POSTOUTCONDPOISSOND_H_ diff --git a/src/PostOutExponentialFix.h b/src/PostOutExponentialFix.h index 94672c6..07fdfd7 100644 --- a/src/PostOutExponentialFix.h +++ b/src/PostOutExponentialFix.h @@ -1,57 +1,62 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTEXPONENTIALFIX_H__ #define __FINMIX_POSTOUTEXPONENTIALFIX_H__ #include "PriorExponentialFix.h" class PostOutExponentialFix { - public: - arma::mat *a; - arma::mat *b; +public: +arma::mat *a; +arma::mat *b; - PostOutExponentialFix () {} - PostOutExponentialFix (const Rcpp::List&); - ~PostOutExponentialFix () {} - void store (const unsigned int&, - const PriorExponentialFix&); +PostOutExponentialFix () +{ +} +PostOutExponentialFix (const Rcpp::List&); +~PostOutExponentialFix () +{ +} +void store(const unsigned int&, + const PriorExponentialFix&); }; -PostOutExponentialFix::PostOutExponentialFix (const Rcpp::List& list) +PostOutExponentialFix::PostOutExponentialFix (const Rcpp::List& list) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::NumericMatrix tmpA((SEXP) tmpList["a"]); - Rcpp::NumericMatrix tmpB((SEXP) tmpList["b"]); - const unsigned int M = tmpA.nrow(); - const unsigned int K = tmpA.ncol(); - a = new arma::mat(tmpA.begin(), M, K, false, true); - b = new arma::mat(tmpB.begin(), M, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::NumericMatrix tmpA((SEXP)tmpList["a"]); + Rcpp::NumericMatrix tmpB((SEXP)tmpList["b"]); + const unsigned int M = tmpA.nrow(); + const unsigned int K = tmpA.ncol(); + + a = new arma::mat(tmpA.begin(), M, K, false, true); + b = new arma::mat(tmpB.begin(), M, K, false, true); } -void PostOutExponentialFix::store (const unsigned int& m, - const PriorExponentialFix& hyperPar) +void PostOutExponentialFix::store(const unsigned int& m, + const PriorExponentialFix& hyperPar) { - (*a).row(m) = hyperPar.aPost; - (*b).row(m) = hyperPar.bPost; + (*a).row(m) = hyperPar.aPost; + (*b).row(m) = hyperPar.bPost; } #endif // __FINMIX_POSTOUTEXPONENTIALFIX_H__ diff --git a/src/PostOutExponentialInd.h b/src/PostOutExponentialInd.h index eaf32cf..de82a15 100644 --- a/src/PostOutExponentialInd.h +++ b/src/PostOutExponentialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTEXPONENTIALIND_H__ #define __FINMIX_POSTOUTEXPONENTIALIND_H__ @@ -27,28 +27,31 @@ #include "PriorExponentialInd.h" class PostOutExponentialInd : public PostOutExponentialFix { - public: - arma::mat* weight; - - PostOutExponentialInd (const Rcpp::List&); - virtual ~PostOutExponentialInd () {} - virtual void store (const unsigned int&, - const PriorExponentialInd&); +public: +arma::mat* weight; + +PostOutExponentialInd (const Rcpp::List&); +virtual ~PostOutExponentialInd () +{ +} +virtual void store(const unsigned int&, + const PriorExponentialInd&); }; PostOutExponentialInd::PostOutExponentialInd (const Rcpp::List& list) : - PostOutExponentialFix(list) -{ - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - const unsigned int M = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + PostOutExponentialFix(list) +{ + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + const unsigned int M = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } -void PostOutExponentialInd::store (const unsigned int& m, - const PriorExponentialInd& hyperPar) +void PostOutExponentialInd::store(const unsigned int& m, + const PriorExponentialInd& hyperPar) { - PostOutExponentialFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutExponentialFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif // __FINMIX_POSTOUTEXPONENTIALIND_H__ diff --git a/src/PostOutNormalFix.h b/src/PostOutNormalFix.h index 454f6df..540629e 100644 --- a/src/PostOutNormalFix.h +++ b/src/PostOutNormalFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTNORMALFIX_H__ #define __FINMIX_POSTOUTNORMALFIX_H__ @@ -18,44 +18,49 @@ #include "PriorNormalFix.h" class PostOutNormalFix { - public: - arma::mat* b; - arma::mat* B; - arma::mat* c; - arma::mat* C; - - PostOutNormalFix () {} - PostOutNormalFix (const Rcpp::List&); - ~PostOutNormalFix () {} - void store (const unsigned int&, - const PriorNormalFix&); +public: +arma::mat* b; +arma::mat* B; +arma::mat* c; +arma::mat* C; + +PostOutNormalFix () +{ +} +PostOutNormalFix (const Rcpp::List&); +~PostOutNormalFix () +{ +} +void store(const unsigned int&, + const PriorNormalFix&); }; PostOutNormalFix::PostOutNormalFix (const Rcpp::List& list) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::List tmpMu((SEXP) tmpList["mu"]); - Rcpp::List tmpSigma((SEXP) tmpList["sigma"]); - Rcpp::NumericMatrix tmpb((SEXP) tmpMu["b"]); - Rcpp::NumericMatrix tmpB((SEXP) tmpMu["B"]); - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - Rcpp::NumericMatrix tmpC((SEXP) tmpSigma["C"]); - const unsigned int M = tmpb.nrow(); - const unsigned int K = tmpb.ncol(); - b = new arma::mat(tmpb.begin(), M, K, false, true); - B = new arma::mat(tmpB.begin(), M, K, false, true); - c = new arma::mat(tmpc.begin(), M, K, false, true); - C = new arma::mat(tmpC.begin(), M, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::List tmpMu((SEXP)tmpList["mu"]); + Rcpp::List tmpSigma((SEXP)tmpList["sigma"]); + Rcpp::NumericMatrix tmpb((SEXP)tmpMu["b"]); + Rcpp::NumericMatrix tmpB((SEXP)tmpMu["B"]); + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + Rcpp::NumericMatrix tmpC((SEXP)tmpSigma["C"]); + const unsigned int M = tmpb.nrow(); + const unsigned int K = tmpb.ncol(); + + b = new arma::mat(tmpb.begin(), M, K, false, true); + B = new arma::mat(tmpB.begin(), M, K, false, true); + c = new arma::mat(tmpc.begin(), M, K, false, true); + C = new arma::mat(tmpC.begin(), M, K, false, true); } inline -void PostOutNormalFix::store (const unsigned int& m, - const PriorNormalFix& hyperPar) +void PostOutNormalFix::store(const unsigned int& m, + const PriorNormalFix& hyperPar) { - (*b).row(m) = hyperPar.bPost; - (*B).row(m) = hyperPar.BPost; - (*c).row(m) = hyperPar.cPost; - (*C).row(m) = hyperPar.CPost; + (*b).row(m) = hyperPar.bPost; + (*B).row(m) = hyperPar.BPost; + (*c).row(m) = hyperPar.cPost; + (*C).row(m) = hyperPar.CPost; } #endif /* __FINMIX_POSTOUTNORMALFIX_H__ */ diff --git a/src/PostOutNormalInd.h b/src/PostOutNormalInd.h index e546134..d2c8deb 100644 --- a/src/PostOutNormalInd.h +++ b/src/PostOutNormalInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTNORMALIND_H__ #define __FINMIX_POSTOUTNORMALIND_H__ @@ -18,32 +18,35 @@ #include "PostOutNormalFix.h" #include "PriorNormalInd.h" -class PostOutNormalInd: public PostOutNormalFix { - public: - arma::mat* weight; +class PostOutNormalInd : public PostOutNormalFix { +public: +arma::mat* weight; - PostOutNormalInd (const Rcpp::List&); - virtual ~PostOutNormalInd () {} - virtual void store (const unsigned int&, - const PriorNormalInd&); +PostOutNormalInd (const Rcpp::List&); +virtual ~PostOutNormalInd () +{ +} +virtual void store(const unsigned int&, + const PriorNormalInd&); }; inline PostOutNormalInd::PostOutNormalInd (const Rcpp::List& list) : - PostOutNormalFix(list) + PostOutNormalFix(list) { - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - const unsigned int M = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + const unsigned int M = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } inline -void PostOutNormalInd::store (const unsigned int& m, - const PriorNormalInd& hyperPar) +void PostOutNormalInd::store(const unsigned int& m, + const PriorNormalInd& hyperPar) { - PostOutNormalFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutNormalFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif /* __FINMIX_POSTOUTNORMALIND_H__ */ diff --git a/src/PostOutNormultFix.h b/src/PostOutNormultFix.h index 60608d9..f7f6a5b 100644 --- a/src/PostOutNormultFix.h +++ b/src/PostOutNormultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTNORMULTFIX_H__ #define __FINMIX_POSTOUTNORMULTFIX_H__ @@ -19,58 +19,66 @@ #include "mincol.h" class PostOutNormultFix { - public: - arma::cube* b; - arma::cube* B; - arma::mat* c; - arma::cube* C; - unsigned int M; - unsigned int r; - unsigned int s; - unsigned int K; +public: +arma::cube* b; +arma::cube* B; +arma::mat* c; +arma::cube* C; +unsigned int M; +unsigned int r; +unsigned int s; +unsigned int K; - PostOutNormultFix () {} - PostOutNormultFix (const Rcpp::List&); - virtual ~PostOutNormultFix () {} - void store (const unsigned int&, - const PriorNormultFix&); +PostOutNormultFix () +{ +} +PostOutNormultFix (const Rcpp::List&); +virtual ~PostOutNormultFix () +{ +} +void store(const unsigned int&, + const PriorNormultFix&); }; inline PostOutNormultFix::PostOutNormultFix (const Rcpp::List& list) : - M(0), r(0), s(0), K(0) + M(0), r(0), s(0), K(0) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::List tmpMu((SEXP) tmpList["mu"]); - /* b is an (M x r x K) array */ - Rcpp::NumericVector tmpb((SEXP) tmpMu["b"]); - Rcpp::IntegerVector tmpbDim = tmpb.attr("dim"); - M = tmpbDim[0]; - r = tmpbDim[1]; - s = r * (r + 1) / 2; - K = tmpbDim[2]; - b = new arma::cube(tmpb.begin(), M, r, K, false, true); - /* B is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpB((SEXP) tmpMu["B"]); - B = new arma::cube(tmpB.begin(), M, r * (r + 1) / 2, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::List tmpMu((SEXP)tmpList["mu"]); + /* b is an (M x r x K) array */ + Rcpp::NumericVector tmpb((SEXP)tmpMu["b"]); + Rcpp::IntegerVector tmpbDim = tmpb.attr("dim"); + + M = tmpbDim[0]; + r = tmpbDim[1]; + s = r * (r + 1) / 2; + K = tmpbDim[2]; + b = new arma::cube(tmpb.begin(), M, r, K, false, true); + /* B is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpB((SEXP)tmpMu["B"]); - Rcpp::List tmpSigma((SEXP) tmpList["sigma"]); - /* c is an (M x K) array */ - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - c = new arma::mat(tmpc.begin(), M, K, false, true); - /* C is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpC((SEXP) tmpSigma["C"]); - C = new arma::cube(tmpC.begin(), M, r * (r + 1) / 2, K, false, true); + B = new arma::cube(tmpB.begin(), M, r * (r + 1) / 2, K, false, true); + + Rcpp::List tmpSigma((SEXP)tmpList["sigma"]); + /* c is an (M x K) array */ + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + + c = new arma::mat(tmpc.begin(), M, K, false, true); + /* C is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpC((SEXP)tmpSigma["C"]); + + C = new arma::cube(tmpC.begin(), M, r * (r + 1) / 2, K, false, true); } -inline -void PostOutNormultFix::store (const unsigned int& m, - const PriorNormultFix& hyperPar) +inline +void PostOutNormultFix::store(const unsigned int& m, + const PriorNormultFix& hyperPar) { - b->tube(m, 0, m, r - 1) = hyperPar.bPost; - B->tube(m, 0, m, s - 1) = cincolmat(hyperPar.BPost); - c->row(m) = hyperPar.cPost; - C->tube(m, 0, m, s - 1) = cincolmat(hyperPar.CPost); + b->tube(m, 0, m, r - 1) = hyperPar.bPost; + B->tube(m, 0, m, s - 1) = cincolmat(hyperPar.BPost); + c->row(m) = hyperPar.cPost; + C->tube(m, 0, m, s - 1) = cincolmat(hyperPar.CPost); } #endif /* __FINMIX_POSTOUTNORMULTFIX_H__ */ diff --git a/src/PostOutNormultInd.h b/src/PostOutNormultInd.h index 440870e..31ff2ac 100644 --- a/src/PostOutNormultInd.h +++ b/src/PostOutNormultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTNORMULTIND_H__ #define __FINMIX_POSTOUTNORMULTIND_H__ @@ -19,29 +19,32 @@ #include "PriorNormultInd.h" class PostOutNormultInd : public PostOutNormultFix { - public: - arma::mat* weight; - - PostOutNormultInd (const Rcpp::List&); - virtual ~PostOutNormultInd () {} - virtual void store (const unsigned int&, - const PriorNormultInd&); +public: +arma::mat* weight; + +PostOutNormultInd (const Rcpp::List&); +virtual ~PostOutNormultInd () +{ +} +virtual void store(const unsigned int&, + const PriorNormultInd&); }; inline PostOutNormultInd::PostOutNormultInd (const Rcpp::List& list) : - PostOutNormultFix(list) + PostOutNormultFix(list) { - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } inline -void PostOutNormultInd::store (const unsigned int& m, - const PriorNormultInd& hyperPar) +void PostOutNormultInd::store(const unsigned int& m, + const PriorNormultInd& hyperPar) { - PostOutNormultFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutNormultFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif /* __FINMIX_POSTOUTNORMULTIND_H__ */ diff --git a/src/PostOutPoissonFix.h b/src/PostOutPoissonFix.h index 74224c3..5bf044f 100644 --- a/src/PostOutPoissonFix.h +++ b/src/PostOutPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef POSTOUTPOISSONFIX_H #define POSTOUTPOISSONFIX_H @@ -27,32 +27,37 @@ #include "PriorPoissonFix.h" class PostOutPoissonFix { - public: - arma::mat *a; - arma::mat *b; +public: +arma::mat *a; +arma::mat *b; - PostOutPoissonFix () {} - PostOutPoissonFix (const Rcpp::List&); - ~PostOutPoissonFix () {} - void store (const unsigned int&, - const PriorPoissonFix&); +PostOutPoissonFix () +{ +} +PostOutPoissonFix (const Rcpp::List&); +~PostOutPoissonFix () +{ +} +void store(const unsigned int&, + const PriorPoissonFix&); }; -PostOutPoissonFix::PostOutPoissonFix (const Rcpp::List& list) +PostOutPoissonFix::PostOutPoissonFix (const Rcpp::List& list) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::NumericMatrix tmpA((SEXP) tmpList["a"]); - Rcpp::NumericMatrix tmpB((SEXP) tmpList["b"]); - const unsigned int M = tmpA.nrow(); - const unsigned int K = tmpA.ncol(); - a = new arma::mat(tmpA.begin(), M, K, false, true); - b = new arma::mat(tmpB.begin(), M, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::NumericMatrix tmpA((SEXP)tmpList["a"]); + Rcpp::NumericMatrix tmpB((SEXP)tmpList["b"]); + const unsigned int M = tmpA.nrow(); + const unsigned int K = tmpA.ncol(); + + a = new arma::mat(tmpA.begin(), M, K, false, true); + b = new arma::mat(tmpB.begin(), M, K, false, true); } -void PostOutPoissonFix::store (const unsigned int& m, - const PriorPoissonFix& hyperPar) +void PostOutPoissonFix::store(const unsigned int& m, + const PriorPoissonFix& hyperPar) { - (*a).row(m) = hyperPar.aPost; - (*b).row(m) = hyperPar.bPost; + (*a).row(m) = hyperPar.aPost; + (*b).row(m) = hyperPar.bPost; } #endif diff --git a/src/PostOutPoissonInd.h b/src/PostOutPoissonInd.h index 95e5d6a..6d7a504 100644 --- a/src/PostOutPoissonInd.h +++ b/src/PostOutPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTPOISSONIND_H__ #define __FINMIX_POSTOUTPOISSONIND_H__ @@ -27,28 +27,31 @@ #include "PriorPoissonInd.h" class PostOutPoissonInd : public PostOutPoissonFix { - public: - arma::mat* weight; - - PostOutPoissonInd (const Rcpp::List&); - virtual ~PostOutPoissonInd () {} - virtual void store (const unsigned int&, - const PriorPoissonInd&); +public: +arma::mat* weight; + +PostOutPoissonInd (const Rcpp::List&); +virtual ~PostOutPoissonInd () +{ +} +virtual void store(const unsigned int&, + const PriorPoissonInd&); }; PostOutPoissonInd::PostOutPoissonInd (const Rcpp::List& list) : - PostOutPoissonFix(list) -{ - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - const unsigned int M = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + PostOutPoissonFix(list) +{ + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + const unsigned int M = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } -void PostOutPoissonInd::store (const unsigned int& m, - const PriorPoissonInd& hyperPar) +void PostOutPoissonInd::store(const unsigned int& m, + const PriorPoissonInd& hyperPar) { - PostOutPoissonFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutPoissonFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif // __FINMIX_POSTOUTPOISSONIND_H_ diff --git a/src/PostOutStudentFix.h b/src/PostOutStudentFix.h index 67ec9fc..b841adb 100644 --- a/src/PostOutStudentFix.h +++ b/src/PostOutStudentFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTSTUDENTFIX_H__ #define __FINMIX_POSTOUTSTUDENTFIX_H__ @@ -18,46 +18,52 @@ #include "PriorStudentFix.h" class PostOutStudentFix { - public: - arma::mat* b; - arma::mat* B; - arma::mat* c; - arma::mat* C; - - PostOutStudentFix () {} - PostOutStudentFix (const Rcpp::List&); - ~PostOutStudentFix () {} - void store (const unsigned int&, - const PriorStudentFix&); +public: +arma::mat* b; +arma::mat* B; +arma::mat* c; +arma::mat* C; + +PostOutStudentFix () +{ +} +PostOutStudentFix (const Rcpp::List&); +~PostOutStudentFix () +{ +} +void store(const unsigned int&, + const PriorStudentFix&); }; -PostOutStudentFix::PostOutStudentFix (const Rcpp::List& list) +PostOutStudentFix::PostOutStudentFix (const Rcpp::List& list) { - Rprintf("PostOut, Line 36\n"); - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::List tmpMu((SEXP) tmpList["mu"]); - Rcpp::List tmpSigma((SEXP) tmpList["sigma"]); - Rcpp::NumericMatrix tmpb((SEXP) tmpMu["b"]); - Rcpp::NumericMatrix tmpB((SEXP) tmpMu["B"]); - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - Rcpp::NumericMatrix tmpC((SEXP) tmpSigma["C"]); - Rprintf("PostOut, Line 44\n"); - const unsigned int M = tmpb.nrow(); - const unsigned int K = tmpb.ncol(); - b = new arma::mat(tmpb.begin(), M, K, false, true); - B = new arma::mat(tmpB.begin(), M, K, false, true); - c = new arma::mat(tmpc.begin(), M, K, false, true); - C = new arma::mat(tmpC.begin(), M, K, false, true); + Rprintf("PostOut, Line 36\n"); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::List tmpMu((SEXP)tmpList["mu"]); + Rcpp::List tmpSigma((SEXP)tmpList["sigma"]); + Rcpp::NumericMatrix tmpb((SEXP)tmpMu["b"]); + Rcpp::NumericMatrix tmpB((SEXP)tmpMu["B"]); + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + Rcpp::NumericMatrix tmpC((SEXP)tmpSigma["C"]); + + Rprintf("PostOut, Line 44\n"); + const unsigned int M = tmpb.nrow(); + const unsigned int K = tmpb.ncol(); + + b = new arma::mat(tmpb.begin(), M, K, false, true); + B = new arma::mat(tmpB.begin(), M, K, false, true); + c = new arma::mat(tmpc.begin(), M, K, false, true); + C = new arma::mat(tmpC.begin(), M, K, false, true); } inline -void PostOutStudentFix::store (const unsigned int& m, - const PriorStudentFix& hyperPar) +void PostOutStudentFix::store(const unsigned int& m, + const PriorStudentFix& hyperPar) { - (*b).row(m) = hyperPar.bPost; - (*B).row(m) = hyperPar.BPost; - (*c).row(m) = hyperPar.cPost; - (*C).row(m) = hyperPar.CPost; + (*b).row(m) = hyperPar.bPost; + (*B).row(m) = hyperPar.BPost; + (*c).row(m) = hyperPar.cPost; + (*C).row(m) = hyperPar.CPost; } #endif /* __FINMIX_POSTOUTSTUDENTFIX_H__ */ diff --git a/src/PostOutStudentInd.h b/src/PostOutStudentInd.h index 996df04..2f9345c 100644 --- a/src/PostOutStudentInd.h +++ b/src/PostOutStudentInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTSTUDENTIND_H__ #define __FINMIX_POSTOUTSTUDENTIND_H__ @@ -19,29 +19,32 @@ #include "PriorStudentInd.h" class PostOutStudentInd : virtual public PostOutStudentFix { - public: - arma::mat* weight; +public: +arma::mat* weight; - PostOutStudentInd (const Rcpp::List&); - virtual ~PostOutStudentInd () {} - virtual void store (const unsigned int&, - const PriorStudentInd&); +PostOutStudentInd (const Rcpp::List&); +virtual ~PostOutStudentInd () +{ +} +virtual void store(const unsigned int&, + const PriorStudentInd&); }; PostOutStudentInd::PostOutStudentInd (const Rcpp::List& list) : - PostOutStudentFix(list) + PostOutStudentFix(list) { - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - const unsigned int M = tmpWeight.nrow(); - const unsigned int K = tmpWeight.ncol(); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + const unsigned int M = tmpWeight.nrow(); + const unsigned int K = tmpWeight.ncol(); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } -void PostOutStudentInd::store (const unsigned int& m, - const PriorStudentInd& hyperPar) +void PostOutStudentInd::store(const unsigned int& m, + const PriorStudentInd& hyperPar) { - PostOutStudentFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutStudentFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif /* __FINMIX_POSTOUTSTUDENTIND_H__ */ diff --git a/src/PostOutStudmultFix.h b/src/PostOutStudmultFix.h index d7e1d7a..cec2162 100644 --- a/src/PostOutStudmultFix.h +++ b/src/PostOutStudmultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTSTUDMULTFIX_H__ #define __FINMIX_POSTOUTSTUDMULTFIX_H__ @@ -19,58 +19,66 @@ #include "mincol.h" class PostOutStudmultFix { - public: - arma::cube* b; - arma::cube* B; - arma::mat* c; - arma::cube* C; - unsigned int M; - unsigned int r; - unsigned int s; - unsigned int K; +public: +arma::cube* b; +arma::cube* B; +arma::mat* c; +arma::cube* C; +unsigned int M; +unsigned int r; +unsigned int s; +unsigned int K; - PostOutStudmultFix () {} - PostOutStudmultFix (const Rcpp::List&); - virtual ~PostOutStudmultFix () {} - void store (const unsigned int&, - const PriorStudmultFix&); +PostOutStudmultFix () +{ +} +PostOutStudmultFix (const Rcpp::List&); +virtual ~PostOutStudmultFix () +{ +} +void store(const unsigned int&, + const PriorStudmultFix&); }; inline PostOutStudmultFix::PostOutStudmultFix (const Rcpp::List& list) : - M(0), r(0), s(0), K(0) + M(0), r(0), s(0), K(0) { - Rcpp::List tmpList((SEXP) list["par"]); - Rcpp::List tmpMu((SEXP) tmpList["mu"]); - /* b is an (M x r x K) array */ - Rcpp::NumericVector tmpb((SEXP) tmpMu["b"]); - Rcpp::IntegerVector tmpbDim = tmpb.attr("dim"); - M = tmpbDim[0]; - r = tmpbDim[1]; - s = r * (r + 1) / 2; - K = tmpbDim[2]; - b = new arma::cube(tmpb.begin(), M, r, K, false, true); - /* B is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpB((SEXP) tmpMu["B"]); - B = new arma::cube(tmpB.begin(), M, r * (r + 1) / 2, K, false, true); + Rcpp::List tmpList((SEXP)list["par"]); + Rcpp::List tmpMu((SEXP)tmpList["mu"]); + /* b is an (M x r x K) array */ + Rcpp::NumericVector tmpb((SEXP)tmpMu["b"]); + Rcpp::IntegerVector tmpbDim = tmpb.attr("dim"); + + M = tmpbDim[0]; + r = tmpbDim[1]; + s = r * (r + 1) / 2; + K = tmpbDim[2]; + b = new arma::cube(tmpb.begin(), M, r, K, false, true); + /* B is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpB((SEXP)tmpMu["B"]); - Rcpp::List tmpSigma((SEXP) tmpList["sigma"]); - /* c is an (M x K) array */ - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - c = new arma::mat(tmpc.begin(), M, K, false, true); - /* C is an (M x r(r + 1)/2 x K) array */ - Rcpp::NumericVector tmpC((SEXP) tmpSigma["C"]); - C = new arma::cube(tmpC.begin(), M, r * (r + 1) / 2, K, false, true); + B = new arma::cube(tmpB.begin(), M, r * (r + 1) / 2, K, false, true); + + Rcpp::List tmpSigma((SEXP)tmpList["sigma"]); + /* c is an (M x K) array */ + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + + c = new arma::mat(tmpc.begin(), M, K, false, true); + /* C is an (M x r(r + 1)/2 x K) array */ + Rcpp::NumericVector tmpC((SEXP)tmpSigma["C"]); + + C = new arma::cube(tmpC.begin(), M, r * (r + 1) / 2, K, false, true); } -inline -void PostOutStudmultFix::store (const unsigned int& m, - const PriorStudmultFix& hyperPar) +inline +void PostOutStudmultFix::store(const unsigned int& m, + const PriorStudmultFix& hyperPar) { - b->tube(m, 0, m, r - 1) = hyperPar.bPost; - B->tube(m, 0, m, s - 1) = cincolmat(hyperPar.BPost); - c->row(m) = hyperPar.cPost; - C->tube(m, 0, m, s - 1) = cincolmat(hyperPar.CPost); + b->tube(m, 0, m, r - 1) = hyperPar.bPost; + B->tube(m, 0, m, s - 1) = cincolmat(hyperPar.BPost); + c->row(m) = hyperPar.cPost; + C->tube(m, 0, m, s - 1) = cincolmat(hyperPar.CPost); } #endif /* __FINMIX_POSTOUTSTUDMULTFIX_H__ */ diff --git a/src/PostOutStudmultInd.h b/src/PostOutStudmultInd.h index cac25d5..37623c1 100644 --- a/src/PostOutStudmultInd.h +++ b/src/PostOutStudmultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_POSTOUTSTUDMULTIND_H__ #define __FINMIX_POSTOUTSTUDMULTIND_H__ @@ -19,29 +19,32 @@ #include "PriorStudmultInd.h" class PostOutStudmultInd : public PostOutStudmultFix { - public: - arma::mat* weight; - - PostOutStudmultInd (const Rcpp::List&); - virtual ~PostOutStudmultInd () {} - virtual void store (const unsigned int&, - const PriorStudmultInd&); +public: +arma::mat* weight; + +PostOutStudmultInd (const Rcpp::List&); +virtual ~PostOutStudmultInd () +{ +} +virtual void store(const unsigned int&, + const PriorStudmultInd&); }; inline PostOutStudmultInd::PostOutStudmultInd (const Rcpp::List& list) : - PostOutStudmultFix(list) + PostOutStudmultFix(list) { - Rcpp::NumericMatrix tmpWeight((SEXP) list["weight"]); - weight = new arma::mat(tmpWeight.begin(), M, K, false, true); + Rcpp::NumericMatrix tmpWeight((SEXP)list["weight"]); + + weight = new arma::mat(tmpWeight.begin(), M, K, false, true); } inline -void PostOutStudmultInd::store (const unsigned int& m, - const PriorStudmultInd& hyperPar) +void PostOutStudmultInd::store(const unsigned int& m, + const PriorStudmultInd& hyperPar) { - PostOutStudmultFix::store(m, hyperPar); - (*weight).row(m) = hyperPar.weightPost; + PostOutStudmultFix::store(m, hyperPar); + (*weight).row(m) = hyperPar.weightPost; } #endif /* __FINMIX_POSTOUTSTUDMULTIND_H__ */ diff --git a/src/PriorBinomialFix.cpp b/src/PriorBinomialFix.cpp index 881ccc0..01d7de9 100644 --- a/src/PriorBinomialFix.cpp +++ b/src/PriorBinomialFix.cpp @@ -1,58 +1,64 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorBinomialFix.h" #include "ParBinomialFix.h" PriorBinomialFix::PriorBinomialFix (const FinmixPrior& prior) : - aStart(Rcpp::as((SEXP) prior.par["a"])), - bStart(Rcpp::as((SEXP) prior.par["b"])), - aPost(Rcpp::as((SEXP) prior.par["a"])), - bPost(Rcpp::as((SEXP) prior.par["b"])) {} + aStart(Rcpp::as((SEXP)prior.par["a"])), + bStart(Rcpp::as((SEXP)prior.par["b"])), + aPost(Rcpp::as((SEXP)prior.par["a"])), + bPost(Rcpp::as((SEXP)prior.par["b"])) +{ +} -void PriorBinomialFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParBinomialFix& par) +void PriorBinomialFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParBinomialFix& par) { - if (K == 1) { - double ysum = arma::accu(y); - aPost(0) = aStart(0) + ysum; - bPost(1) = bStart(1) + arma::accu(T) - ysum; - } else { - arma::mat repY = arma::repmat(y, 1, K); - arma::mat repT = arma::repmat(T, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for (unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - repT %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(repT, 0); - aPost = aStart + sprod; - bPost = bStart + sind - sprod; - } + if (K == 1) + { + double ysum = arma::accu(y); + aPost(0) = aStart(0) + ysum; + bPost(1) = bStart(1) + arma::accu(T) - ysum; + } + else + { + arma::mat repY = arma::repmat(y, 1, K); + arma::mat repT = arma::repmat(T, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + repY %= indDouble; + repT %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(repT, 0); + aPost = aStart + sprod; + bPost = bStart + sind - sprod; + } } diff --git a/src/PriorBinomialFix.h b/src/PriorBinomialFix.h index 8d0bf30..bd81ae4 100644 --- a/src/PriorBinomialFix.h +++ b/src/PriorBinomialFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORBINOMIALFIX_H__ #define __FINMIX_PRIORBINOMIALFIX_H__ @@ -21,22 +21,28 @@ class ParBinomialFix; class PriorBinomialFix { - public: - arma::rowvec aStart; - arma::rowvec bStart; - arma::rowvec aPost; - arma::rowvec bPost; - - PriorBinomialFix () {} - PriorBinomialFix (const FinmixPrior&); - virtual ~PriorBinomialFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParBinomialFix&); - /* Needs to be defined even if not used - * as FIX::update() calls it regularly - */ - virtual void updateHier (const ParBinomialFix&) {}; +public: +arma::rowvec aStart; +arma::rowvec bStart; +arma::rowvec aPost; +arma::rowvec bPost; + +PriorBinomialFix () +{ +} +PriorBinomialFix (const FinmixPrior&); +virtual ~PriorBinomialFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParBinomialFix&); +/* Needs to be defined even if not used + * as FIX::update() calls it regularly + */ +virtual void updateHier(const ParBinomialFix&) +{ +}; }; #endif /* __FINMIX_PRIORBINOMIALFIX_H__ */ diff --git a/src/PriorBinomialInd.cpp b/src/PriorBinomialInd.cpp index 5785195..64af4a1 100644 --- a/src/PriorBinomialInd.cpp +++ b/src/PriorBinomialInd.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorBinomialInd.h" #include "ParBinomialInd.h" #include "posterior.h" @@ -36,16 +36,18 @@ * @return PriorBinomialInd object * @detail The only difference to a PriorBinomialFix object is * the weight vector, all other members stay the same. - * This is achieved by a virtual inheritance from the - * PriorBinomialFix class. + * This is achieved by a virtual inheritance from the + * PriorBinomialFix class. * @see FinmixPrior, PriorBinomialFix * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ PriorBinomialInd::PriorBinomialInd (const FinmixPrior& prior) : - PriorBinomialFix(prior), - weightStart(prior.weight), - weightPost(prior.weight) {} + PriorBinomialFix(prior), + weightStart(prior.weight), + weightPost(prior.weight) +{ +} // ============================================================ // Update @@ -58,20 +60,20 @@ PriorBinomialInd::PriorBinomialInd (const FinmixPrior& prior) : * parameters * @detail Updates the hyper parameters by computing posterior * parameters for a Gamma prior for the component par- - * ameters and a Dirchlet prior for the weights. - * For updating the prior of the component parameters - * it is made use of the inheritance scheme and the - * corresponding update member function of the + * ameters and a Dirchlet prior for the weights. + * For updating the prior of the component parameters + * it is made use of the inheritance scheme and the + * corresponding update member function of the * ParBinomialFix class is called. - * @see PriorBinomialFix::update, ParBinomialInd, + * @see PriorBinomialFix::update, ParBinomialInd, * posterior_multinomial * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -void PriorBinomialInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParBinomialInd& par) +void PriorBinomialInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParBinomialInd& par) { - PriorBinomialFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); + PriorBinomialFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); } diff --git a/src/PriorBinomialInd.h b/src/PriorBinomialInd.h index 706a61f..fe943c5 100644 --- a/src/PriorBinomialInd.h +++ b/src/PriorBinomialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIORBINOMIALIND_H__ #define __FINMIX_PRIORBINOMIALIND_H__ @@ -29,15 +29,17 @@ class ParBinomialInd; class PriorBinomialInd : virtual public PriorBinomialFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; +public: +arma::rowvec weightStart; +arma::rowvec weightPost; - PriorBinomialInd (const FinmixPrior&); - virtual ~PriorBinomialInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParBinomialInd&); +PriorBinomialInd (const FinmixPrior&); +virtual ~PriorBinomialInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParBinomialInd&); }; #endif /* __FINMIX_PRIORBINOMIALIND_H__ */ diff --git a/src/PriorCondPoissonFix.cpp b/src/PriorCondPoissonFix.cpp index 0db959d..4d199c3 100644 --- a/src/PriorCondPoissonFix.cpp +++ b/src/PriorCondPoissonFix.cpp @@ -1,54 +1,64 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorCondPoissonFix.h" #include "ParCondPoissonFix.h" -PriorCondPoissonFix::PriorCondPoissonFix () : HIER(false) {} +PriorCondPoissonFix::PriorCondPoissonFix () : HIER(false) +{ +} PriorCondPoissonFix::PriorCondPoissonFix (const FinmixPrior& prior) : - Q(Rcpp::as((SEXP) prior.par["Q"])), - N(Rcpp::as((SEXP) prior.par["N"])), - a(prior.par["a"]), b(prior.par["b"]), - HIER(prior.hier), s(prior.par["s"]) {} + Q(Rcpp::as((SEXP)prior.par["Q"])), + N(Rcpp::as((SEXP)prior.par["N"])), + a(prior.par["a"]), b(prior.par["b"]), + HIER(prior.hier), s(prior.par["s"]) +{ +} -void PriorCondPoissonFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParCondPoissonFix& par) +void PriorCondPoissonFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParCondPoissonFix& par) { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(indDouble, 0); - Q = sprod; - N = sind; + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + + repY %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(indDouble, 0); + + Q = sprod; + N = sind; } -void PriorCondPoissonFix::updateHier(const ParCondPoissonFix& par) {} +void PriorCondPoissonFix::updateHier(const ParCondPoissonFix& par) +{ +} diff --git a/src/PriorCondPoissonFix.h b/src/PriorCondPoissonFix.h index 210d7ef..88cd62c 100644 --- a/src/PriorCondPoissonFix.h +++ b/src/PriorCondPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIORCONDPOISSONFIX_H_ #define __FINMIX_PRIORCONDPOISSONFIX_H_ @@ -28,20 +28,22 @@ class ParCondPoissonFix; class PriorCondPoissonFix { - public: - arma::rowvec Q; - arma::rowvec N; - double a; - double b; - const bool HIER; - double s; +public: +arma::rowvec Q; +arma::rowvec N; +double a; +double b; +const bool HIER; +double s; - PriorCondPoissonFix (); - PriorCondPoissonFix (const FinmixPrior&); - virtual ~PriorCondPoissonFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParCondPoissonFix&); - virtual void updateHier(const ParCondPoissonFix&); +PriorCondPoissonFix (); +PriorCondPoissonFix (const FinmixPrior&); +virtual ~PriorCondPoissonFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParCondPoissonFix&); +virtual void updateHier(const ParCondPoissonFix&); }; #endif // __FINMIX_PRIORCONDPOISSON_H_ diff --git a/src/PriorCondPoissonInd.cpp b/src/PriorCondPoissonInd.cpp index 2a5e12d..22fa222 100644 --- a/src/PriorCondPoissonInd.cpp +++ b/src/PriorCondPoissonInd.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorCondPoissonInd.h" #include "ParCondPoissonInd.h" #include "posterior.h" @@ -36,16 +36,18 @@ * @return PriorPoissonInd object * @detail The only difference to a PriorPoissonFix object is * the weight vector, all other members stay the same. - * This is achieved by a virtual inheritance from the - * PriorPoissonFix class. + * This is achieved by a virtual inheritance from the + * PriorPoissonFix class. * @see FinmixPrior, PriorPoissonFix * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ PriorCondPoissonInd::PriorCondPoissonInd (const FinmixPrior& prior) : - PriorCondPoissonFix(prior), - weightStart(prior.weight), - weightPost(prior.weight) {} + PriorCondPoissonFix(prior), + weightStart(prior.weight), + weightPost(prior.weight) +{ +} // ============================================================ // Update @@ -58,19 +60,19 @@ PriorCondPoissonInd::PriorCondPoissonInd (const FinmixPrior& prior) : * parameters * @detail Updates the hyper parameters by computing posterior * parameters for a Gamma prior for the component par- - * ameters and a Dirchlet prior for the weights. - * For updating the prior of the component parameters - * it is made use of the inheritance scheme and the - * corresponding update member function of the + * ameters and a Dirchlet prior for the weights. + * For updating the prior of the component parameters + * it is made use of the inheritance scheme and the + * corresponding update member function of the * ParPoissonFix class is called. - * @see PriorPoissonFix::update, ParPoissonInd, + * @see PriorPoissonFix::update, ParPoissonInd, * posterior_multinomial * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -void PriorCondPoissonInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParCondPoissonInd& par) +void PriorCondPoissonInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParCondPoissonInd& par) { - PriorCondPoissonFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); + PriorCondPoissonFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); } diff --git a/src/PriorCondPoissonInd.h b/src/PriorCondPoissonInd.h index 4ed74c6..08b7c22 100644 --- a/src/PriorCondPoissonInd.h +++ b/src/PriorCondPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIORCONDPOISSONIND_H__ #define __FINMIX_PRIORCONDPOISSONIND_H__ @@ -28,14 +28,16 @@ class ParCondPoissonInd; class PriorCondPoissonInd : virtual public PriorCondPoissonFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; - - PriorCondPoissonInd (const FinmixPrior&); - virtual ~PriorCondPoissonInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParCondPoissonInd&); +public: +arma::rowvec weightStart; +arma::rowvec weightPost; + +PriorCondPoissonInd (const FinmixPrior&); +virtual ~PriorCondPoissonInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParCondPoissonInd&); }; #endif /* __FINMIX_PRIORPOISSONIND_H__ */ diff --git a/src/PriorExponentialFix.cpp b/src/PriorExponentialFix.cpp index 3697259..3fe5d95 100644 --- a/src/PriorExponentialFix.cpp +++ b/src/PriorExponentialFix.cpp @@ -1,61 +1,70 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorExponentialFix.h" #include "ParExponentialFix.h" -PriorExponentialFix::PriorExponentialFix () : HIER( false ) {} +PriorExponentialFix::PriorExponentialFix () : HIER(false) +{ +} PriorExponentialFix::PriorExponentialFix (const FinmixPrior& prior) : - aStart(Rcpp::as((SEXP) prior.par["a"])), - bStart(Rcpp::as((SEXP) prior.par["b"])), - aPost(Rcpp::as((SEXP) prior.par["a"])), - bPost(Rcpp::as((SEXP) prior.par["b"])), - HIER(false) {} + aStart(Rcpp::as((SEXP)prior.par["a"])), + bStart(Rcpp::as((SEXP)prior.par["b"])), + aPost(Rcpp::as((SEXP)prior.par["a"])), + bPost(Rcpp::as((SEXP)prior.par["b"])), + HIER(false) +{ +} -void PriorExponentialFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParExponentialFix& par) +void PriorExponentialFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParExponentialFix& par) { - if (K == 1) { - aPost(0) = aStart(0) + arma::accu(y); - bPost(0) = bStart(0) + y.n_rows; - } - else { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(indDouble, 0); - aPost = aStart + sind; - bPost = bStart + sprod; - } + if (K == 1) + { + aPost(0) = aStart(0) + arma::accu(y); + bPost(0) = bStart(0) + y.n_rows; + } + else + { + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + repY %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(indDouble, 0); + aPost = aStart + sind; + bPost = bStart + sprod; + } } -void PriorExponentialFix::updateHier(const ParExponentialFix& par) {} +void PriorExponentialFix::updateHier(const ParExponentialFix& par) +{ +} diff --git a/src/PriorExponentialFix.h b/src/PriorExponentialFix.h index 4c67dd8..eed0e4f 100644 --- a/src/PriorExponentialFix.h +++ b/src/PriorExponentialFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIOREXPONENTIALFIX_H__ #define __FINMIX_PRIOREXPONENTIALFIX_H__ @@ -28,21 +28,23 @@ class ParExponentialFix; class PriorExponentialFix { - public: - arma::rowvec aStart; - arma::rowvec bStart; - arma::rowvec aPost; - arma::rowvec bPost; - const bool HIER; - double g; - double G; +public: +arma::rowvec aStart; +arma::rowvec bStart; +arma::rowvec aPost; +arma::rowvec bPost; +const bool HIER; +double g; +double G; - PriorExponentialFix (); - PriorExponentialFix (const FinmixPrior&); - virtual ~PriorExponentialFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParExponentialFix&); - virtual void updateHier(const ParExponentialFix&); +PriorExponentialFix (); +PriorExponentialFix (const FinmixPrior&); +virtual ~PriorExponentialFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParExponentialFix&); +virtual void updateHier(const ParExponentialFix&); }; #endif // __FINMIX_PRIOREXPONENTIALFIX_H__ diff --git a/src/PriorExponentialInd.cpp b/src/PriorExponentialInd.cpp index 3efacc2..1fdb906 100644 --- a/src/PriorExponentialInd.cpp +++ b/src/PriorExponentialInd.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorExponentialInd.h" #include "ParExponentialInd.h" #include "posterior.h" @@ -36,16 +36,18 @@ * @return PriorExponentialInd object * @detail The only difference to a PriorExponentialFix object is * the weight vector, all other members stay the same. - * This is achieved by a virtual inheritance from the - * PriorExponentialFix class. + * This is achieved by a virtual inheritance from the + * PriorExponentialFix class. * @see FinmixPrior, PriorExponentialFix * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ PriorExponentialInd::PriorExponentialInd (const FinmixPrior& prior) : - PriorExponentialFix(prior), - weightStart(prior.weight), - weightPost(prior.weight) {} + PriorExponentialFix(prior), + weightStart(prior.weight), + weightPost(prior.weight) +{ +} // ============================================================ // Update @@ -58,19 +60,19 @@ PriorExponentialInd::PriorExponentialInd (const FinmixPrior& prior) : * parameters * @detail Updates the hyper parameters by computing posterior * parameters for a Gamma prior for the component par- - * ameters and a Dirchlet prior for the weights. - * For updating the prior of the component parameters - * it is made use of the inheritance scheme and the - * corresponding update member function of the + * ameters and a Dirchlet prior for the weights. + * For updating the prior of the component parameters + * it is made use of the inheritance scheme and the + * corresponding update member function of the * ParExponentialFix class is called. - * @see PriorExponentialFix::update, ParExponentialInd, + * @see PriorExponentialFix::update, ParExponentialInd, * posterior_multinomial * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -void PriorExponentialInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParExponentialInd& par) +void PriorExponentialInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParExponentialInd& par) { - PriorExponentialFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); + PriorExponentialFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); } diff --git a/src/PriorExponentialInd.h b/src/PriorExponentialInd.h index f388385..112364b 100644 --- a/src/PriorExponentialInd.h +++ b/src/PriorExponentialInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIOREXPONENTIALIND_H__ #define __FINMIX_PRIOREXPONENTIALIND_H__ @@ -27,14 +27,16 @@ class ParExponentialInd; class PriorExponentialInd : virtual public PriorExponentialFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; - - PriorExponentialInd (const FinmixPrior&); - virtual ~PriorExponentialInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParExponentialInd&); +public: +arma::rowvec weightStart; +arma::rowvec weightPost; + +PriorExponentialInd (const FinmixPrior&); +virtual ~PriorExponentialInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParExponentialInd&); }; #endif /* __FINMIX_PRIOREXPONENTIALIND_H__ */ diff --git a/src/PriorNormalFix.cpp b/src/PriorNormalFix.cpp index e983122..02823da 100644 --- a/src/PriorNormalFix.cpp +++ b/src/PriorNormalFix.cpp @@ -2,103 +2,124 @@ #include "ParNormalFix.h" #include "distributions.h" -PriorNormalFix::PriorNormalFix () : HIER( false ), - INDEPENDENT( false ) {} +PriorNormalFix::PriorNormalFix () : HIER(false), + INDEPENDENT(false) +{ +} PriorNormalFix::PriorNormalFix (const FinmixPrior& prior) : - HIER(prior.hier), - INDEPENDENT(prior.type == "condconjugate" ? false : true ) + HIER(prior.hier), + INDEPENDENT(prior.type == "condconjugate" ? false : true) { - Rcpp::List tmpMu((SEXP) prior.par["mu"]); - Rcpp::List tmpSigma((SEXP) prior.par["sigma"]); - Rcpp::NumericMatrix tmpb((SEXP) tmpMu["b"]); - const unsigned int M = tmpb.nrow(); - const unsigned int K = tmpb.ncol(); - if (INDEPENDENT) { - Rcpp::NumericMatrix tmpBinv((SEXP) tmpMu["Binv"]); - BStart = arma::mat(tmpBinv.begin(),M, K, true, true); - BPost = BStart; - } else { - Rcpp::NumericMatrix tmpN((SEXP) tmpMu["N0"]); - BStart = arma::mat(tmpN.begin(), M, K, true, true); - BPost = BStart; - } - bStart = arma::mat(tmpb.begin(), M, K, true, true); - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - Rcpp::NumericMatrix tmpC((SEXP) tmpSigma["C"]); - cStart = arma::mat(tmpc.begin(), M, K, true, true); - cPost = cStart; - CStart = arma::mat(tmpC.begin(), M, K, true, true); - CPost = CStart; - if (HIER) { - g = tmpSigma["g"]; - G = tmpSigma["G"]; - } + Rcpp::List tmpMu((SEXP)prior.par["mu"]); + Rcpp::List tmpSigma((SEXP)prior.par["sigma"]); + Rcpp::NumericMatrix tmpb((SEXP)tmpMu["b"]); + const unsigned int M = tmpb.nrow(); + const unsigned int K = tmpb.ncol(); + + if (INDEPENDENT) + { + Rcpp::NumericMatrix tmpBinv((SEXP)tmpMu["Binv"]); + BStart = arma::mat(tmpBinv.begin(), M, K, true, true); + BPost = BStart; + } + else + { + Rcpp::NumericMatrix tmpN((SEXP)tmpMu["N0"]); + BStart = arma::mat(tmpN.begin(), M, K, true, true); + BPost = BStart; + } + bStart = arma::mat(tmpb.begin(), M, K, true, true); + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + Rcpp::NumericMatrix tmpC((SEXP)tmpSigma["C"]); + + cStart = arma::mat(tmpc.begin(), M, K, true, true); + cPost = cStart; + CStart = arma::mat(tmpC.begin(), M, K, true, true); + CPost = CStart; + if (HIER) + { + g = tmpSigma["g"]; + G = tmpSigma["G"]; + } } inline -void PriorNormalFix::update ( const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParNormalFix& par) +void PriorNormalFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParNormalFix& par) { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(indDouble, 0); - if (INDEPENDENT) { - if (!par.INDEPENDENT) { - par.INDEPENDENT = true; - } - cPost = cStart + 0.5 * sind; - for (unsigned int k = 0; k < K; ++k) { - CPost(k) = CStart(k); + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + + repY %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(indDouble, 0); + + if (INDEPENDENT) + { + if (!par.INDEPENDENT) + { + par.INDEPENDENT = true; + } + cPost = cStart + 0.5 * sind; + for (unsigned int k = 0; k < K; ++k) + { + CPost(k) = CStart(k); + arma::uvec yind = find(repY.col(k) != 0.0); + arma::mat y = repY.rows(yind); + arma::vec b = y.col(k) - par.mu(k); + CPost(k) += 0.5 * arma::as_scalar(arma::trans(b) * b); + } + par.sigma = 1.0 / rgammaprod(cPost, CPost); + arma::rowvec BinvPost = BStart + sind % (1.0 / par.sigma); + BPost = 1.0 / BinvPost; + bPost = BStart % bStart; + bPost += 1.0 / par.sigma % sprod; + bPost %= BPost; + } + else /* conditionally conjugate prior */ + + { + arma::rowvec N0Post = BStart + sind; + BPost = 1.0 / N0Post; + bPost = (bStart % BStart + sprod) / N0Post; + cPost = cStart + 0.5 * sind; + arma::rowvec ck = BStart % sind / N0Post; + for (unsigned int k = 0; k < K; ++k) + { + if (sind(k) > 0) + { + double yk = sprod(k) / sind(k); + CPost(k) = CStart(k); arma::uvec yind = find(repY.col(k) != 0.0); - arma::mat y = repY.rows(yind); - arma::vec b = y.col(k) - par.mu(k); - CPost(k) += 0.5 * arma::as_scalar(arma::trans(b) * b); - } - par.sigma = 1.0 / rgammaprod(cPost, CPost); - arma::rowvec BinvPost = BStart + sind % (1.0 / par.sigma); - BPost = 1.0 / BinvPost; - bPost = BStart % bStart; - bPost += 1.0 / par.sigma % sprod; - bPost %= BPost; - } else { /* conditionally conjugate prior */ - - arma::rowvec N0Post = BStart + sind; - BPost = 1.0 / N0Post; - bPost = (bStart % BStart + sprod) / N0Post; - cPost = cStart + 0.5 * sind; - arma::rowvec ck = BStart % sind / N0Post; - for (unsigned int k = 0; k < K; ++k) { - if (sind(k) > 0) { - double yk = sprod(k) / sind(k); - CPost(k) = CStart(k); - arma::uvec yind = find(repY.col(k) != 0.0); - arma::mat y = repY.rows(yind); - arma::vec sk = y.col(k) - yk; - CPost(k) += 0.5 * arma::as_scalar(arma::trans(sk) * sk); - CPost(k) += 0.5 * (yk - bStart(k)) * (yk - bStart(k)) * ck(k); - } else { - CPost(k) = CStart(k); - CPost(k) += 0.5 * (sprod(k) - bStart(k)) * (sprod(k) - bStart(k)) * ck(k); - } - } - } - + arma::mat y = repY.rows(yind); + arma::vec sk = y.col(k) - yk; + CPost(k) += 0.5 * arma::as_scalar(arma::trans(sk) * sk); + CPost(k) += 0.5 * (yk - bStart(k)) * (yk - bStart(k)) * ck(k); + } + else + { + CPost(k) = CStart(k); + CPost(k) += 0.5 * (sprod(k) - bStart(k)) * (sprod(k) - bStart(k)) * ck(k); + } + } + } } inline -void PriorNormalFix::updateHier (const ParNormalFix& par) +void PriorNormalFix::updateHier(const ParNormalFix& par) { - double gN = arma::sum(cStart) + g; - double GN = arma::sum(1.0 / par.sigma) + G; - CStart.fill(R::rgamma(gN, 1.0)); - CStart /= GN; + double gN = arma::sum(cStart) + g; + double GN = arma::sum(1.0 / par.sigma) + G; + + CStart.fill(R::rgamma(gN, 1.0)); + CStart /= GN; } diff --git a/src/PriorNormalFix.h b/src/PriorNormalFix.h index ad81a2a..7ac3031 100644 --- a/src/PriorNormalFix.h +++ b/src/PriorNormalFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORNORMALFIX_H__ #define __FINMIX_PRIORNORMALFIX_H__ @@ -20,27 +20,29 @@ /* Forward declaration */ class ParNormalFix; class PriorNormalFix { - public: - arma::rowvec bStart; - arma::rowvec BStart; - arma::rowvec cStart; - arma::rowvec CStart; - arma::rowvec bPost; - arma::rowvec BPost; - arma::rowvec cPost; - arma::rowvec CPost; - const bool HIER; - const bool INDEPENDENT; - double g; - double G; +public: +arma::rowvec bStart; +arma::rowvec BStart; +arma::rowvec cStart; +arma::rowvec CStart; +arma::rowvec bPost; +arma::rowvec BPost; +arma::rowvec cPost; +arma::rowvec CPost; +const bool HIER; +const bool INDEPENDENT; +double g; +double G; - PriorNormalFix (); - PriorNormalFix (const FinmixPrior&); - virtual ~PriorNormalFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParNormalFix&); - virtual void updateHier (const ParNormalFix&); +PriorNormalFix (); +PriorNormalFix (const FinmixPrior&); +virtual ~PriorNormalFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParNormalFix&); +virtual void updateHier(const ParNormalFix&); }; #endif /* __FINMIX_PRIORNORMALFIX_H__ */ diff --git a/src/PriorNormalInd.cpp b/src/PriorNormalInd.cpp index 947c0f3..b009f7a 100644 --- a/src/PriorNormalInd.cpp +++ b/src/PriorNormalInd.cpp @@ -3,14 +3,16 @@ #include "posterior.h" PriorNormalInd::PriorNormalInd (const FinmixPrior& prior) : - PriorNormalFix(prior), - weightStart(prior.weight), - weightPost(prior.weight) {} + PriorNormalFix(prior), + weightStart(prior.weight), + weightPost(prior.weight) +{ +} inline -void PriorNormalInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParNormalInd& par) +void PriorNormalInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParNormalInd& par) { - PriorNormalFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); -} + PriorNormalFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); +} diff --git a/src/PriorNormalInd.h b/src/PriorNormalInd.h index 87644a4..0935018 100644 --- a/src/PriorNormalInd.h +++ b/src/PriorNormalInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORNORMALIND_H__ #define __FINMIX_PRIORNORMALIND_H__ @@ -21,15 +21,17 @@ class ParNormalInd; class PriorNormalInd : virtual public PriorNormalFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; - - PriorNormalInd (const FinmixPrior&); - virtual ~PriorNormalInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParNormalInd&); +public: +arma::rowvec weightStart; +arma::rowvec weightPost; + +PriorNormalInd (const FinmixPrior&); +virtual ~PriorNormalInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParNormalInd&); }; #endif /* __FINMIX_PRIORNORMALIND_H__ */ diff --git a/src/PriorNormultFix.cpp b/src/PriorNormultFix.cpp index 95e549f..6d34b14 100644 --- a/src/PriorNormultFix.cpp +++ b/src/PriorNormultFix.cpp @@ -2,150 +2,178 @@ #include "ParNormultFix.h" #include "distributions.h" -PriorNormultFix::PriorNormultFix () : HIER( false ), - INDEPENDENT( false ) {} +PriorNormultFix::PriorNormultFix () : HIER(false), + INDEPENDENT(false) +{ +} PriorNormultFix::PriorNormultFix (const FinmixPrior& prior) : - HIER(prior.hier), - INDEPENDENT(prior.type == "condconjugate" ? false : true ) + HIER(prior.hier), + INDEPENDENT(prior.type == "condconjugate" ? false : true) { - Rcpp::List tmpMu((SEXP) prior.par["mu"]); - Rcpp::List tmpSigma((SEXP) prior.par["sigma"]); - Rcpp::NumericMatrix tmpb((SEXP) tmpMu["b"]); - const unsigned int r = tmpb.nrow(); - const unsigned int K = tmpb.ncol(); - if (INDEPENDENT) { - Rcpp::NumericVector tmpBinv((SEXP) tmpMu["Binv"]); - Rcpp::IntegerVector tmpDims = tmpBinv.attr("dim"); - BInvStart = arma::cube(tmpBinv.begin(), tmpDims[0], tmpDims[1], - tmpDims[2], true, true); - BStart = arma::cube(tmpDims[0], tmpDims[1], tmpDims[2]); - for (unsigned int k = 0; k < K; ++k) { - BStart.slice(k) = arma::inv(BInvStart.slice(k)); - } - BPost = BStart; - BInvPost = BInvStart; - /* Initialize N0Start and N0Post (not used if INDEPENDENT) */ - N0Start = arma::rowvec(r); - N0Post = N0Start; - } else { /* conditionally conjugate prior */ - Rcpp::NumericVector tmpN((SEXP) tmpMu["N0"]); - N0Start = arma::rowvec(tmpN.begin(), K, true, true); - N0Post = N0Start; - BStart = arma::cube(r, r, K); - BInvStart = BStart; - BPost = BStart; - BInvPost = BInvStart; - } - bStart = arma::mat(tmpb.begin(), r, K, true, true); - bPost = bStart; - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - Rcpp::NumericVector tmpC((SEXP) tmpSigma["C"]); - Rcpp::IntegerVector tmpDims2 = tmpC.attr("dim"); - cStart = arma::rowvec(tmpc.begin(), K, true, true); - cPost = cStart; - CStart = arma::cube(tmpC.begin(), tmpDims2[0], - tmpDims2[1], tmpDims2[2], true, true); - CPost = CStart; - Rcpp::NumericVector tmpLogdetC((SEXP) tmpSigma["logdetC"]); - logdetC = arma::rowvec(tmpLogdetC.begin(), K, true, true); - if (HIER) { - g = tmpSigma["g"]; - Rcpp::NumericMatrix tmpG((SEXP) tmpSigma["G"]); - G = arma::mat(tmpG.begin(), r, r, true, true); - } + Rcpp::List tmpMu((SEXP)prior.par["mu"]); + Rcpp::List tmpSigma((SEXP)prior.par["sigma"]); + Rcpp::NumericMatrix tmpb((SEXP)tmpMu["b"]); + const unsigned int r = tmpb.nrow(); + const unsigned int K = tmpb.ncol(); + + if (INDEPENDENT) + { + Rcpp::NumericVector tmpBinv((SEXP)tmpMu["Binv"]); + Rcpp::IntegerVector tmpDims = tmpBinv.attr("dim"); + BInvStart = arma::cube(tmpBinv.begin(), tmpDims[0], tmpDims[1], + tmpDims[2], true, true); + BStart = arma::cube(tmpDims[0], tmpDims[1], tmpDims[2]); + for (unsigned int k = 0; k < K; ++k) + { + BStart.slice(k) = arma::inv(BInvStart.slice(k)); + } + BPost = BStart; + BInvPost = BInvStart; + /* Initialize N0Start and N0Post (not used if INDEPENDENT) */ + N0Start = arma::rowvec(r); + N0Post = N0Start; + } + else /* conditionally conjugate prior */ + { + Rcpp::NumericVector tmpN((SEXP)tmpMu["N0"]); + N0Start = arma::rowvec(tmpN.begin(), K, true, true); + N0Post = N0Start; + BStart = arma::cube(r, r, K); + BInvStart = BStart; + BPost = BStart; + BInvPost = BInvStart; + } + bStart = arma::mat(tmpb.begin(), r, K, true, true); + bPost = bStart; + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + Rcpp::NumericVector tmpC((SEXP)tmpSigma["C"]); + Rcpp::IntegerVector tmpDims2 = tmpC.attr("dim"); + + cStart = arma::rowvec(tmpc.begin(), K, true, true); + cPost = cStart; + CStart = arma::cube(tmpC.begin(), tmpDims2[0], + tmpDims2[1], tmpDims2[2], true, true); + CPost = CStart; + Rcpp::NumericVector tmpLogdetC((SEXP)tmpSigma["logdetC"]); + + logdetC = arma::rowvec(tmpLogdetC.begin(), K, true, true); + if (HIER) + { + g = tmpSigma["g"]; + Rcpp::NumericMatrix tmpG((SEXP)tmpSigma["G"]); + G = arma::mat(tmpG.begin(), r, r, true, true); + } } inline -void PriorNormultFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParNormultFix& par) +void PriorNormultFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParNormultFix& par) { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - arma::rowvec sind = sum(indDouble, 0); - if (INDEPENDENT) { - if (!par.INDEPENDENT) { - par.INDEPENDENT = true; - } - cPost = cStart + 0.5 * sind; - double sign = 0.0; - for (unsigned int k = 0; k < K; ++k) { - CPost.slice(k) = CStart.slice(k); - arma::uvec yind = find(ind.col(k) != 0.0); - arma::mat y2 = y.rows(yind); - arma::mat b = y2; - b.each_row() -= arma::trans(par.mu.col(k)); - CPost.slice(k) += 0.5 * arma::trans(b) * b; - arma::mat tmp = 0.5 * arma::trans(b) * b + CStart.slice(k); - arma::log_det(logdetC(k), sign, CPost.slice(k)); - logdetC(k) = logdetC(k) * sign; - par.sigma.slice(k) = rinvwishart(cPost(k), CPost.slice(k)); - par.sigmainv.slice(k) = arma::inv(par.sigma.slice(k)); - BInvPost.slice(k) = BInvStart.slice(k) + sind(k) * arma::inv(par.sigma.slice(k)); - BPost.slice(k) = arma::inv(BInvPost.slice(k)); - bPost.col(k) = BInvStart.slice(k) * bStart.col(k) - + arma::inv(par.sigma.slice(k)) * arma::trans(arma::sum(y2, 0)); - bPost.col(k) = BPost.slice(k) * bPost.col(k); - } - } else { /* conditionally conjugate prior */ - if (par.INDEPENDENT) { - par.INDEPENDENT = false; - } - /* BStart is actually N0Start */ - N0Post = N0Start + sind; - for (unsigned int k = 0; k < K; ++k) { - arma::uvec yind = find(ind.col(k) != 0.0); - arma::mat y2 = y.rows(yind); - bPost.col(k) = bStart.col(k) * N0Start(k); - bPost.col(k) += arma::trans(arma::sum(y2, 0)); - bPost.col(k) /= N0Post(k); - } - double sign = 0.0; - cPost = cStart + 0.5 * sind; - arma::rowvec ck = N0Start % sind / N0Post; - for (unsigned int k = 0; k < K; ++k) { - CPost.slice(k) = CStart.slice(k); - arma::uvec yind = find(ind.col(k) != 0.0); - arma::mat y2 = y.rows(yind); - arma::rowvec sk = arma::sum(y2, 0); - if (sind(k) > 0) { - arma::rowvec yk = sk / sind(k); - arma::mat dk = y2; - dk.each_row() -= yk; - CPost.slice(k) += 0.5 * arma::trans(dk) * dk; - CPost.slice(k) += 0.5 * arma::trans(yk - arma::trans(bStart.col(k))) - * (yk - arma::trans(bStart.col(k))) * ck(k); - } else { - CPost.slice(k) += 0.5 * (arma::trans(sk) - bStart.col(k)) - * (arma::trans(sk) - bStart.col(k)) * ck(k); - } - arma::log_det(logdetC(k), sign, CPost.slice(k)); - logdetC(k) = logdetC(k) * sign; - } - } + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + arma::rowvec sind = sum(indDouble, 0); + + if (INDEPENDENT) + { + if (!par.INDEPENDENT) + { + par.INDEPENDENT = true; + } + cPost = cStart + 0.5 * sind; + double sign = 0.0; + for (unsigned int k = 0; k < K; ++k) + { + CPost.slice(k) = CStart.slice(k); + arma::uvec yind = find(ind.col(k) != 0.0); + arma::mat y2 = y.rows(yind); + arma::mat b = y2; + b.each_row() -= arma::trans(par.mu.col(k)); + CPost.slice(k) += 0.5 * arma::trans(b) * b; + arma::mat tmp = 0.5 * arma::trans(b) * b + CStart.slice(k); + arma::log_det(logdetC(k), sign, CPost.slice(k)); + logdetC(k) = logdetC(k) * sign; + par.sigma.slice(k) = rinvwishart(cPost(k), CPost.slice(k)); + par.sigmainv.slice(k) = arma::inv(par.sigma.slice(k)); + BInvPost.slice(k) = BInvStart.slice(k) + sind(k) * arma::inv(par.sigma.slice(k)); + BPost.slice(k) = arma::inv(BInvPost.slice(k)); + bPost.col(k) = BInvStart.slice(k) * bStart.col(k) + + arma::inv(par.sigma.slice(k)) * arma::trans(arma::sum(y2, 0)); + bPost.col(k) = BPost.slice(k) * bPost.col(k); + } + } + else /* conditionally conjugate prior */ + { + if (par.INDEPENDENT) + { + par.INDEPENDENT = false; + } + /* BStart is actually N0Start */ + N0Post = N0Start + sind; + for (unsigned int k = 0; k < K; ++k) + { + arma::uvec yind = find(ind.col(k) != 0.0); + arma::mat y2 = y.rows(yind); + bPost.col(k) = bStart.col(k) * N0Start(k); + bPost.col(k) += arma::trans(arma::sum(y2, 0)); + bPost.col(k) /= N0Post(k); + } + double sign = 0.0; + cPost = cStart + 0.5 * sind; + arma::rowvec ck = N0Start % sind / N0Post; + for (unsigned int k = 0; k < K; ++k) + { + CPost.slice(k) = CStart.slice(k); + arma::uvec yind = find(ind.col(k) != 0.0); + arma::mat y2 = y.rows(yind); + arma::rowvec sk = arma::sum(y2, 0); + if (sind(k) > 0) + { + arma::rowvec yk = sk / sind(k); + arma::mat dk = y2; + dk.each_row() -= yk; + CPost.slice(k) += 0.5 * arma::trans(dk) * dk; + CPost.slice(k) += 0.5 * arma::trans(yk - arma::trans(bStart.col(k))) + * (yk - arma::trans(bStart.col(k))) * ck(k); + } + else + { + CPost.slice(k) += 0.5 * (arma::trans(sk) - bStart.col(k)) + * (arma::trans(sk) - bStart.col(k)) * ck(k); + } + arma::log_det(logdetC(k), sign, CPost.slice(k)); + logdetC(k) = logdetC(k) * sign; + } + } } inline -void PriorNormultFix::updateHier (const ParNormultFix& par) +void PriorNormultFix::updateHier(const ParNormultFix& par) { - if (HIER) { - const unsigned int K = cPost.n_elem; - double gN = arma::sum(cStart) + g; - arma::mat GN = G; - for (unsigned int k = 0; k < K; ++k) { - GN += par.sigma.slice(k); - } - CStart.slice(0) = arma::inv(rinvwishart(gN, GN)); - if (K > 1) { - for (unsigned int k = 1; k < K; ++k) { - CStart.slice(k) = CStart.slice(0); - } - } - } + if (HIER) + { + const unsigned int K = cPost.n_elem; + double gN = arma::sum(cStart) + g; + arma::mat GN = G; + for (unsigned int k = 0; k < K; ++k) + { + GN += par.sigma.slice(k); + } + CStart.slice(0) = arma::inv(rinvwishart(gN, GN)); + if (K > 1) + { + for (unsigned int k = 1; k < K; ++k) + { + CStart.slice(k) = CStart.slice(0); + } + } + } } diff --git a/src/PriorNormultFix.h b/src/PriorNormultFix.h index 0cd2164..65a77c1 100644 --- a/src/PriorNormultFix.h +++ b/src/PriorNormultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORNORMULTFIX_H__ #define __FINMIX_PRIORNORMULTFIX_H__ @@ -21,33 +21,35 @@ class ParNormultFix; class PriorNormultFix { - public: - arma::mat bStart; - arma::cube BStart; - arma::cube BInvStart; - arma::rowvec N0Start; - arma::rowvec cStart; - arma::cube CStart; - - arma::mat bPost; - arma::cube BPost; - arma::cube BInvPost; - arma::rowvec N0Post; - arma::rowvec cPost; - arma::cube CPost; - arma::rowvec logdetC; - const bool HIER; - bool INDEPENDENT; - double g; - arma::mat G; - - PriorNormultFix (); - PriorNormultFix (const FinmixPrior&); - virtual ~PriorNormultFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParNormultFix&); - virtual void updateHier (const ParNormultFix&); +public: +arma::mat bStart; +arma::cube BStart; +arma::cube BInvStart; +arma::rowvec N0Start; +arma::rowvec cStart; +arma::cube CStart; + +arma::mat bPost; +arma::cube BPost; +arma::cube BInvPost; +arma::rowvec N0Post; +arma::rowvec cPost; +arma::cube CPost; +arma::rowvec logdetC; +const bool HIER; +bool INDEPENDENT; +double g; +arma::mat G; + +PriorNormultFix (); +PriorNormultFix (const FinmixPrior&); +virtual ~PriorNormultFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParNormultFix&); +virtual void updateHier(const ParNormultFix&); }; #endif /* __FINMIX_PRIORNORMULTFIX_H__ */ diff --git a/src/PriorNormultInd.cpp b/src/PriorNormultInd.cpp index 2b0b08c..910c4d7 100644 --- a/src/PriorNormultInd.cpp +++ b/src/PriorNormultInd.cpp @@ -3,13 +3,15 @@ #include "posterior.h" PriorNormultInd::PriorNormultInd (const FinmixPrior& prior) : - PriorNormultFix(prior), weightStart(prior.weight), - weightPost(prior.weight) {} + PriorNormultFix(prior), weightStart(prior.weight), + weightPost(prior.weight) +{ +} inline -void PriorNormultInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParNormultInd& par) +void PriorNormultInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParNormultInd& par) { - PriorNormultFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); + PriorNormultFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); } diff --git a/src/PriorNormultInd.h b/src/PriorNormultInd.h index 04c0e90..426d08e 100644 --- a/src/PriorNormultInd.h +++ b/src/PriorNormultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORNORMULTIND_H__ #define __FINMIX_PRIORNORMULTIND_H__ @@ -21,15 +21,17 @@ class ParNormultInd; class PriorNormultInd : virtual public PriorNormultFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; - - PriorNormultInd (const FinmixPrior&); - virtual ~PriorNormultInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParNormultInd&); +public: +arma::rowvec weightStart; +arma::rowvec weightPost; + +PriorNormultInd (const FinmixPrior&); +virtual ~PriorNormultInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParNormultInd&); }; #endif /* __FINMIX_PRIORNORMULTIND_H__ */ diff --git a/src/PriorPoissonFix.cpp b/src/PriorPoissonFix.cpp index 4eacc1f..dafb708 100644 --- a/src/PriorPoissonFix.cpp +++ b/src/PriorPoissonFix.cpp @@ -1,78 +1,85 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorPoissonFix.h" #include "ParPoissonFix.h" -PriorPoissonFix::PriorPoissonFix () : HIER(false) {} +PriorPoissonFix::PriorPoissonFix () : HIER(false) +{ +} PriorPoissonFix::PriorPoissonFix (const FinmixPrior& prior) : - aStart(Rcpp::as((SEXP) prior.par["a"])), - bStart(Rcpp::as((SEXP) prior.par["b"])), - aPost(Rcpp::as((SEXP) prior.par["a"])), - bPost(Rcpp::as((SEXP) prior.par["b"])), - HIER(prior.hier) + aStart(Rcpp::as((SEXP)prior.par["a"])), + bStart(Rcpp::as((SEXP)prior.par["b"])), + aPost(Rcpp::as((SEXP)prior.par["a"])), + bPost(Rcpp::as((SEXP)prior.par["b"])), + HIER(prior.hier) { - if (HIER){ - g = Rcpp::as((SEXP) prior.par["g"]); - G = Rcpp::as((SEXP) prior.par["G"]); - } + if (HIER) + { + g = Rcpp::as((SEXP)prior.par["g"]); + G = Rcpp::as((SEXP)prior.par["G"]); + } } -void PriorPoissonFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParPoissonFix& par) +void PriorPoissonFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParPoissonFix& par) { - if (K == 1) { - aPost(0) = aStart(0) + arma::accu(y); - bPost(0) = bStart(0) + y.n_rows; - } - else { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(indDouble, 0); - aPost = aStart + sprod; - bPost = bStart + sind; - } + if (K == 1) + { + aPost(0) = aStart(0) + arma::accu(y); + bPost(0) = bStart(0) + y.n_rows; + } + else + { + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + repY %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(indDouble, 0); + aPost = aStart + sprod; + bPost = bStart + sind; + } } void PriorPoissonFix::updateHier(const ParPoissonFix& par) { - if(HIER){ // Hierarchical prior for 'b' - GetRNGstate(); // Get RNG state from R - // Sample from G(g_0 + Ka_0, G_0 + sum lambda_k) - double gN = g + arma::sum(aStart); - double GN = G + arma::sum(par.lambda); - double b = R::rgamma(gN, 1/GN); - PutRNGstate(); - bStart.fill(b); - } + if (HIER) // Hierarchical prior for 'b' + { + GetRNGstate(); // Get RNG state from R + // Sample from G(g_0 + Ka_0, G_0 + sum lambda_k) + double gN = g + arma::sum(aStart); + double GN = G + arma::sum(par.lambda); + double b = R::rgamma(gN, 1 / GN); + PutRNGstate(); + bStart.fill(b); + } } diff --git a/src/PriorPoissonFix.h b/src/PriorPoissonFix.h index c69b918..478064c 100644 --- a/src/PriorPoissonFix.h +++ b/src/PriorPoissonFix.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef PRIORPOISSONFIX_H #define PRIORPOISSONFIX_H @@ -28,21 +28,23 @@ class ParPoissonFix; class PriorPoissonFix { - public: - arma::rowvec aStart; - arma::rowvec bStart; - arma::rowvec aPost; - arma::rowvec bPost; - const bool HIER; - double g; - double G; +public: +arma::rowvec aStart; +arma::rowvec bStart; +arma::rowvec aPost; +arma::rowvec bPost; +const bool HIER; +double g; +double G; - PriorPoissonFix (); - PriorPoissonFix (const FinmixPrior&); - virtual ~PriorPoissonFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParPoissonFix&); - virtual void updateHier(const ParPoissonFix&); +PriorPoissonFix (); +PriorPoissonFix (const FinmixPrior&); +virtual ~PriorPoissonFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParPoissonFix&); +virtual void updateHier(const ParPoissonFix&); }; #endif diff --git a/src/PriorPoissonInd.cpp b/src/PriorPoissonInd.cpp index 6096488..c0c8815 100644 --- a/src/PriorPoissonInd.cpp +++ b/src/PriorPoissonInd.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "PriorPoissonInd.h" #include "ParPoissonInd.h" #include "posterior.h" @@ -36,16 +36,18 @@ * @return PriorPoissonInd object * @detail The only difference to a PriorPoissonFix object is * the weight vector, all other members stay the same. - * This is achieved by a virtual inheritance from the - * PriorPoissonFix class. + * This is achieved by a virtual inheritance from the + * PriorPoissonFix class. * @see FinmixPrior, PriorPoissonFix * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ PriorPoissonInd::PriorPoissonInd (const FinmixPrior& prior) : - PriorPoissonFix(prior), - weightStart(prior.weight), - weightPost(prior.weight) {} + PriorPoissonFix(prior), + weightStart(prior.weight), + weightPost(prior.weight) +{ +} // ============================================================ // Update @@ -58,19 +60,19 @@ PriorPoissonInd::PriorPoissonInd (const FinmixPrior& prior) : * parameters * @detail Updates the hyper parameters by computing posterior * parameters for a Gamma prior for the component par- - * ameters and a Dirchlet prior for the weights. - * For updating the prior of the component parameters - * it is made use of the inheritance scheme and the - * corresponding update member function of the + * ameters and a Dirchlet prior for the weights. + * For updating the prior of the component parameters + * it is made use of the inheritance scheme and the + * corresponding update member function of the * ParPoissonFix class is called. - * @see PriorPoissonFix::update, ParPoissonInd, + * @see PriorPoissonFix::update, ParPoissonInd, * posterior_multinomial * @author Lars Simon Zehnder * ------------------------------------------------------------ **/ -void PriorPoissonInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, const ParPoissonInd& par) +void PriorPoissonInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, const ParPoissonInd& par) { - PriorPoissonFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); + PriorPoissonFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); } diff --git a/src/PriorPoissonInd.h b/src/PriorPoissonInd.h index 8b1cfea..e4df5a4 100644 --- a/src/PriorPoissonInd.h +++ b/src/PriorPoissonInd.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIORPOISSONIND_H__ #define __FINMIX_PRIORPOISSONIND_H__ @@ -28,14 +28,16 @@ class ParPoissonInd; class PriorPoissonInd : virtual public PriorPoissonFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; - - PriorPoissonInd (const FinmixPrior&); - virtual ~PriorPoissonInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, const ParPoissonInd&); +public: +arma::rowvec weightStart; +arma::rowvec weightPost; + +PriorPoissonInd (const FinmixPrior&); +virtual ~PriorPoissonInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, const ParPoissonInd&); }; #endif /* __FINMIX_PRIORPOISSONIND_H__ */ diff --git a/src/PriorStudentFix.cpp b/src/PriorStudentFix.cpp index a66ddf9..4df448a 100644 --- a/src/PriorStudentFix.cpp +++ b/src/PriorStudentFix.cpp @@ -6,159 +6,189 @@ #include "prior_likelihood.h" PriorStudentFix::PriorStudentFix () : HIER(false), - INDEPENDENT(false) {} + INDEPENDENT(false) +{ +} PriorStudentFix::PriorStudentFix (const FinmixPrior& prior) : - HIER(prior.hier), - INDEPENDENT(prior.type == "condconjugate" ? false : true) + HIER(prior.hier), + INDEPENDENT(prior.type == "condconjugate" ? false : true) { - Rcpp::List tmpMu((SEXP) prior.par["mu"]); - Rcpp::List tmpSigma((SEXP) prior.par["sigma"]); - Rcpp::List tmpDf((SEXP) prior.par["df"]); - Rcpp::NumericMatrix tmpb((SEXP) tmpMu["b"]); - const unsigned int M = tmpb.nrow(); - const unsigned int K = tmpb.ncol(); - if (INDEPENDENT) { - Rcpp::NumericMatrix tmpBinv((SEXP) tmpMu["Binv"]); - BStart = arma::mat(tmpBinv.begin(),M, K, true, true); - BPost = BStart; - } else { - Rcpp::NumericMatrix tmpN((SEXP) tmpMu["N0"]); - BStart = arma::mat(tmpN.begin(), M, K, true, true); - BPost = BStart; - } - bStart = arma::mat(tmpb.begin(), M, K, true, true); - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - Rcpp::NumericMatrix tmpC((SEXP) tmpSigma["C"]); - cStart = arma::mat(tmpc.begin(), M, K, true, true); - cPost = cStart; - CStart = arma::mat(tmpC.begin(), M, K, true, true); - CPost = CStart; - if (HIER) { - g = tmpSigma["g"]; - G = tmpSigma["G"]; - } - dftype = Rcpp::as(tmpDf["type"]); - trans = Rcpp::as(tmpDf["trans"]); - a0 = Rcpp::as(tmpDf["a0"]); - b0 = Rcpp::as(tmpDf["b0"]); - d = Rcpp::as(tmpDf["d"]); - Rcpp::NumericVector tmpMhTune((SEXP) tmpDf["mhtune"]); - mhTune = arma::rowvec(tmpMhTune.begin(), K, true, true); + Rcpp::List tmpMu((SEXP)prior.par["mu"]); + Rcpp::List tmpSigma((SEXP)prior.par["sigma"]); + Rcpp::List tmpDf((SEXP)prior.par["df"]); + Rcpp::NumericMatrix tmpb((SEXP)tmpMu["b"]); + const unsigned int M = tmpb.nrow(); + const unsigned int K = tmpb.ncol(); + + if (INDEPENDENT) + { + Rcpp::NumericMatrix tmpBinv((SEXP)tmpMu["Binv"]); + BStart = arma::mat(tmpBinv.begin(), M, K, true, true); + BPost = BStart; + } + else + { + Rcpp::NumericMatrix tmpN((SEXP)tmpMu["N0"]); + BStart = arma::mat(tmpN.begin(), M, K, true, true); + BPost = BStart; + } + bStart = arma::mat(tmpb.begin(), M, K, true, true); + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + Rcpp::NumericMatrix tmpC((SEXP)tmpSigma["C"]); + + cStart = arma::mat(tmpc.begin(), M, K, true, true); + cPost = cStart; + CStart = arma::mat(tmpC.begin(), M, K, true, true); + CPost = CStart; + if (HIER) + { + g = tmpSigma["g"]; + G = tmpSigma["G"]; + } + dftype = Rcpp::as(tmpDf["type"]); + trans = Rcpp::as(tmpDf["trans"]); + a0 = Rcpp::as(tmpDf["a0"]); + b0 = Rcpp::as(tmpDf["b0"]); + d = Rcpp::as(tmpDf["d"]); + Rcpp::NumericVector tmpMhTune((SEXP)tmpDf["mhtune"]); + + mhTune = arma::rowvec(tmpMhTune.begin(), K, true, true); } inline -void PriorStudentFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParStudentFix& par) +void PriorStudentFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParStudentFix& par) { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(indDouble, 0); - // OMEGAIND !!! - if (INDEPENDENT) { - if (!par.INDEPENDENT) { - par.INDEPENDENT = true; - } - cPost = cStart + 0.5 * sind; - for (unsigned int k = 0; k < K; ++k) { - CPost(k) = CStart(k); + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + + repY %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(indDouble, 0); + + // OMEGAIND !!! + if (INDEPENDENT) + { + if (!par.INDEPENDENT) + { + par.INDEPENDENT = true; + } + cPost = cStart + 0.5 * sind; + for (unsigned int k = 0; k < K; ++k) + { + CPost(k) = CStart(k); + arma::uvec yind = find(repY.col(k) != 0.0); + arma::mat y = repY.rows(yind); + arma::vec b = y.col(k) - par.mu(k); + CPost(k) += 0.5 * arma::as_scalar(arma::trans(b) * b); + } + par.sigma = 1.0 / rgammaprod(cPost, CPost); + arma::rowvec BinvPost = BStart + sind % (1.0 / par.sigma); + BPost = 1.0 / BinvPost; + bPost = BStart % bStart; + bPost += 1.0 / par.sigma % sprod; + bPost %= BPost; + } + else /* conditionally conjugate prior */ + + { + arma::rowvec N0Post = BStart + sind; + BPost = 1.0 / N0Post; + bPost = (bStart % BStart + sprod) / N0Post; + cPost = cStart + 0.5 * sind; + arma::rowvec ck = BStart % sind / N0Post; + for (unsigned int k = 0; k < K; ++k) + { + if (sind(k) > 0) + { + double yk = sprod(k) / sind(k); + CPost(k) = CStart(k); arma::uvec yind = find(repY.col(k) != 0.0); - arma::mat y = repY.rows(yind); - arma::vec b = y.col(k) - par.mu(k); - CPost(k) += 0.5 * arma::as_scalar(arma::trans(b) * b); - } - par.sigma = 1.0 / rgammaprod(cPost, CPost); - arma::rowvec BinvPost = BStart + sind % (1.0 / par.sigma); - BPost = 1.0 / BinvPost; - bPost = BStart % bStart; - bPost += 1.0 / par.sigma % sprod; - bPost %= BPost; - } else { /* conditionally conjugate prior */ - - arma::rowvec N0Post = BStart + sind; - BPost = 1.0 / N0Post; - bPost = (bStart % BStart + sprod) / N0Post; - cPost = cStart + 0.5 * sind; - arma::rowvec ck = BStart % sind / N0Post; - for (unsigned int k = 0; k < K; ++k) { - if (sind(k) > 0) { - double yk = sprod(k) / sind(k); - CPost(k) = CStart(k); - arma::uvec yind = find(repY.col(k) != 0.0); - arma::mat y = repY.rows(yind); - arma::vec sk = y.col(k) - yk; - CPost(k) += 0.5 * arma::as_scalar(arma::trans(sk) * sk); - CPost(k) += 0.5 * (yk - bStart(k)) * (yk - bStart(k)) * ck(k); - } else { - CPost(k) = CStart(k); - CPost(k) += 0.5 * (sprod(k) - bStart(k)) * (sprod(k) - bStart(k)) * ck(k); - } - } - } - - /* The parameter update is done here, as we need data 'y' - * and classifications 'S' for the Metropolis-Hastings - * algorithm for the degrees of freedoms update */ - if (par.INDEPENDENT) { - par.mu = rnormal(bPost, BPost); - } else { /* conditionally conjugate prior */ - par.sigma = 1.0 / rgammaprod(cPost, CPost); - par.mu = rnormal(bPost, BPost); - } - updateDf(K, y, S, par); + arma::mat y = repY.rows(yind); + arma::vec sk = y.col(k) - yk; + CPost(k) += 0.5 * arma::as_scalar(arma::trans(sk) * sk); + CPost(k) += 0.5 * (yk - bStart(k)) * (yk - bStart(k)) * ck(k); + } + else + { + CPost(k) = CStart(k); + CPost(k) += 0.5 * (sprod(k) - bStart(k)) * (sprod(k) - bStart(k)) * ck(k); + } + } + } + + /* The parameter update is done here, as we need data 'y' + * and classifications 'S' for the Metropolis-Hastings + * algorithm for the degrees of freedoms update */ + if (par.INDEPENDENT) + { + par.mu = rnormal(bPost, BPost); + } + else /* conditionally conjugate prior */ + { + par.sigma = 1.0 / rgammaprod(cPost, CPost); + par.mu = rnormal(bPost, BPost); + } + updateDf(K, y, S, par); } -inline -void PriorStudentFix::updateDf (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, ParStudentFix& par) +inline +void PriorStudentFix::updateDf(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, ParStudentFix& par) { - arma::rowvec dfnew = par.df; - liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); - DataClass dataC; - double loglik = 0.0; - double priorlik = priormixlik_student(INDEPENDENT, HIER, bStart, - BStart, cStart, CStart, par.mu, par.sigma, g, G, - par.df, trans, a0, b0, d); - dataC = classification_fix(K, S, lik); - loglik = arma::sum(dataC.logLikCd); - double urnd = 0.0; - double logliknew = 0.0; - double priorliknew = 0.0; - double acc = 0.0; - Rcpp::RNGScope scope; - for(unsigned int k = 0; k < K; ++k) { - urnd = mhTune(k) * (2.0 * R::runif(0.0, 1.0) - 1.0); - dfnew(k) = trans + (par.df(k) - trans) * std::exp(urnd); - liklist lik2 = likelihood_student(y, par.mu, par.sigma, dfnew); - dataC = classification_fix(K, S, lik2); - logliknew = arma::sum(dataC.logLikCd); - priorliknew = priormixlik_student(INDEPENDENT, HIER, bStart, - BStart, cStart, CStart, par.mu, par.sigma, g, G, - dfnew, trans, a0, b0, d); - acc = logliknew + priorliknew - (loglik + priorlik) + urnd; - if (std::log(R::runif(0.0, 1.0)) < acc) { - par.df(k) = dfnew(k); - loglik = logliknew; - priorlik = priorliknew; - par.acc(k) = 1.0; - } - } + arma::rowvec dfnew = par.df; + liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); + DataClass dataC; + double loglik = 0.0; + double priorlik = priormixlik_student(INDEPENDENT, HIER, bStart, + BStart, cStart, CStart, par.mu, par.sigma, g, G, + par.df, trans, a0, b0, d); + + dataC = classification_fix(K, S, lik); + loglik = arma::sum(dataC.logLikCd); + double urnd = 0.0; + double logliknew = 0.0; + double priorliknew = 0.0; + double acc = 0.0; + Rcpp::RNGScope scope; + + for (unsigned int k = 0; k < K; ++k) + { + urnd = mhTune(k) * (2.0 * R::runif(0.0, 1.0) - 1.0); + dfnew(k) = trans + (par.df(k) - trans) * std::exp(urnd); + liklist lik2 = likelihood_student(y, par.mu, par.sigma, dfnew); + dataC = classification_fix(K, S, lik2); + logliknew = arma::sum(dataC.logLikCd); + priorliknew = priormixlik_student(INDEPENDENT, HIER, bStart, + BStart, cStart, CStart, par.mu, par.sigma, g, G, + dfnew, trans, a0, b0, d); + acc = logliknew + priorliknew - (loglik + priorlik) + urnd; + if (std::log(R::runif(0.0, 1.0)) < acc) + { + par.df(k) = dfnew(k); + loglik = logliknew; + priorlik = priorliknew; + par.acc(k) = 1.0; + } + } } inline -void PriorStudentFix::updateHier (const ParStudentFix& par) +void PriorStudentFix::updateHier(const ParStudentFix& par) { - double gN = arma::sum(cStart) + g; - double GN = arma::sum(1.0 / par.sigma) + G; - CStart.fill(R::rgamma(gN, 1.0)); - CStart /= GN; -} + double gN = arma::sum(cStart) + g; + double GN = arma::sum(1.0 / par.sigma) + G; + + CStart.fill(R::rgamma(gN, 1.0)); + CStart /= GN; +} diff --git a/src/PriorStudentFix.h b/src/PriorStudentFix.h index 30a9206..263c090 100644 --- a/src/PriorStudentFix.h +++ b/src/PriorStudentFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORSTUDENTFIX_H__ #define __FINMIX_PRIORSTUDENTFIX_H__ @@ -20,35 +20,37 @@ /* Forward declaration */ class ParStudentFix; class PriorStudentFix { - public: - arma::rowvec bStart; - arma::rowvec BStart; - arma::rowvec cStart; - arma::rowvec CStart; - arma::rowvec bPost; - arma::rowvec BPost; - arma::rowvec cPost; - arma::rowvec CPost; - arma::rowvec mhTune; - const bool HIER; - const bool INDEPENDENT; - std::string dftype; - double g; - double G; - double trans; - double a0; - double b0; - double d; +public: +arma::rowvec bStart; +arma::rowvec BStart; +arma::rowvec cStart; +arma::rowvec CStart; +arma::rowvec bPost; +arma::rowvec BPost; +arma::rowvec cPost; +arma::rowvec CPost; +arma::rowvec mhTune; +const bool HIER; +const bool INDEPENDENT; +std::string dftype; +double g; +double G; +double trans; +double a0; +double b0; +double d; - PriorStudentFix (); - PriorStudentFix (const FinmixPrior&); - virtual ~PriorStudentFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParStudentFix&); - virtual void updateDf (const unsigned int&, const arma::mat&, - const arma::ivec&, ParStudentFix&); - virtual void updateHier (const ParStudentFix&); +PriorStudentFix (); +PriorStudentFix (const FinmixPrior&); +virtual ~PriorStudentFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParStudentFix&); +virtual void updateDf(const unsigned int&, const arma::mat&, + const arma::ivec&, ParStudentFix&); +virtual void updateHier(const ParStudentFix&); }; #endif /* __FINMIX_PRIORSTUDENTFIX_H__ */ diff --git a/src/PriorStudentInd.cpp b/src/PriorStudentInd.cpp index 84d7069..06ae002 100644 --- a/src/PriorStudentInd.cpp +++ b/src/PriorStudentInd.cpp @@ -7,120 +7,143 @@ #include "posterior.h" PriorStudentInd::PriorStudentInd (const FinmixPrior& prior) : - PriorStudentFix(prior), - weightStart(prior.weight), - weightPost(prior.weight) {} + PriorStudentFix(prior), + weightStart(prior.weight), + weightPost(prior.weight) +{ +} inline -void PriorStudentInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParStudentInd& par) +void PriorStudentInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParStudentInd& par) { - if (K == 1) { - - } else { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - repY %= indDouble; - arma::rowvec sprod = sum(repY, 0); - arma::rowvec sind = sum(indDouble, 0); - // OMEGAIND !!! - if (INDEPENDENT) { - if (!par.INDEPENDENT) { - par.INDEPENDENT = true; + if (K == 1) + { + } + else + { + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + repY %= indDouble; + arma::rowvec sprod = sum(repY, 0); + arma::rowvec sind = sum(indDouble, 0); + // OMEGAIND !!! + if (INDEPENDENT) + { + if (!par.INDEPENDENT) + { + par.INDEPENDENT = true; + } + cPost = cStart + 0.5 * sind; + for (unsigned int k = 0; k < K; ++k) + { + CPost(k) = CStart(k); + arma::uvec yind = find(repY.col(k) != 0.0); + arma::mat y = repY.rows(yind); + arma::vec b = y.col(k) - par.mu(k); + CPost(k) += 0.5 * arma::as_scalar(arma::trans(b) * b); + } + par.sigma = 1.0 / rgammaprod(cPost, CPost); + /* HERE OMEGA!! */ + arma::rowvec BinvPost = BStart + sind % (1.0 / par.sigma); + BPost = 1.0 / BinvPost; + bPost = BStart % bStart; + bPost += 1.0 / par.sigma % sprod; + bPost %= BPost; + } + else /* conditionally conjugate prior */ + { + arma::rowvec N0Post = BStart + sind; + BPost = 1.0 / N0Post; + bPost = (bStart % BStart + sprod) / N0Post; + cPost = cStart + 0.5 * sind; + arma::rowvec ck = BStart % sind / N0Post; + for (unsigned int k = 0; k < K; ++k) + { + if (sind(k) > 0) + { + double yk = sprod(k) / sind(k); + CPost(k) = CStart(k); + arma::uvec yind = find(repY.col(k) != 0.0); + arma::mat y = repY.rows(yind); + arma::vec sk = y.col(k) - yk; + CPost(k) += 0.5 * arma::as_scalar(arma::trans(sk) * sk); + CPost(k) += 0.5 * (yk - bStart(k)) * (yk - bStart(k)) * ck(k); } - cPost = cStart + 0.5 * sind; - for (unsigned int k = 0; k < K; ++k) { - CPost(k) = CStart(k); - arma::uvec yind = find(repY.col(k) != 0.0); - arma::mat y = repY.rows(yind); - arma::vec b = y.col(k) - par.mu(k); - CPost(k) += 0.5 * arma::as_scalar(arma::trans(b) * b); + else + { + CPost(k) = CStart(k); + CPost(k) += 0.5 * (sprod(k) - bStart(k)) * (sprod(k) - bStart(k)) * ck(k); } - par.sigma = 1.0 / rgammaprod(cPost, CPost); - /* HERE OMEGA!! */ - arma::rowvec BinvPost = BStart + sind % (1.0 / par.sigma); - BPost = 1.0 / BinvPost; - bPost = BStart % bStart; - bPost += 1.0 / par.sigma % sprod; - bPost %= BPost; - } else { /* conditionally conjugate prior */ - arma::rowvec N0Post = BStart + sind; - BPost = 1.0 / N0Post; - bPost = (bStart % BStart + sprod) / N0Post; - cPost = cStart + 0.5 * sind; - arma::rowvec ck = BStart % sind / N0Post; - for (unsigned int k = 0; k < K; ++k) { - if (sind(k) > 0) { - double yk = sprod(k) / sind(k); - CPost(k) = CStart(k); - arma::uvec yind = find(repY.col(k) != 0.0); - arma::mat y = repY.rows(yind); - arma::vec sk = y.col(k) - yk; - CPost(k) += 0.5 * arma::as_scalar(arma::trans(sk) * sk); - CPost(k) += 0.5 * (yk - bStart(k)) * (yk - bStart(k)) * ck(k); - } else { - CPost(k) = CStart(k); - CPost(k) += 0.5 * (sprod(k) - bStart(k)) * (sprod(k) - bStart(k)) * ck(k); - } - } - } - } - /* The parameter update is done here, as we need data 'y' - * and classifications 'S' for the Metropolis-Hastings - * algorithm for the degrees of freedoms update */ - if (par.INDEPENDENT) { - par.mu = rnormal(bPost, BPost); - } else { /* conditionally conjugate prior */ - par.sigma = 1.0 / rgammaprod(cPost, CPost); - par.mu = rnormal(bPost, BPost); - } - updateDf(K, y, S, par); - weightPost = posterior_multinomial(K, S, weightStart); + } + } + } + /* The parameter update is done here, as we need data 'y' + * and classifications 'S' for the Metropolis-Hastings + * algorithm for the degrees of freedoms update */ + if (par.INDEPENDENT) + { + par.mu = rnormal(bPost, BPost); + } + else /* conditionally conjugate prior */ + { + par.sigma = 1.0 / rgammaprod(cPost, CPost); + par.mu = rnormal(bPost, BPost); + } + updateDf(K, y, S, par); + weightPost = posterior_multinomial(K, S, weightStart); } -inline -void PriorStudentInd::updateDf (const unsigned int& K, const arma::mat& y, - const arma::ivec& S, ParStudentInd& par) +inline +void PriorStudentInd::updateDf(const unsigned int& K, const arma::mat& y, + const arma::ivec& S, ParStudentInd& par) { - par.acc.fill(0.0); - arma::rowvec dfnew = par.df; - liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); - DataClass dataC; - double loglik = 0.0; - double priorlik = priormixlik_student(INDEPENDENT, HIER, bStart, - BStart, cStart, CStart, par.mu, par.sigma, g, G, - par.df, trans, a0, b0, d); - dataC = classification(S, lik, par.weight); - loglik = dataC.mixLik; - double urnd = 0.0; - double logliknew = 0.0; - double priorliknew = 0.0; - double acc = 0.0; - for(unsigned int k = 0; k < K; ++k) { - urnd = mhTune(k) * (2 * R::runif(0.0, 1.0) - 1.0); - dfnew(k) = trans + (par.df(k) - trans) * std::exp(urnd); - liklist lik2 = likelihood_student(y, par.mu, par.sigma, dfnew); - dataC = classification(S, lik2, par.weight); - logliknew = dataC.mixLik; - priorliknew = priormixlik_student(INDEPENDENT, HIER, bStart, - BStart, cStart, CStart, par.mu, par.sigma, g, G, - dfnew, trans, a0, b0, d); - acc = logliknew + priorliknew - (loglik + priorlik) + urnd; - if (std::log(R::runif(0.0, 1.0)) < acc) { - par.df(k) = dfnew(k); - loglik = logliknew; - priorlik = priorliknew; - par.acc(k) = 1.0; - } else { - dfnew(k) = par.df(k); - } - } + par.acc.fill(0.0); + arma::rowvec dfnew = par.df; + liklist lik = likelihood_student(y, par.mu, par.sigma, par.df); + DataClass dataC; + double loglik = 0.0; + double priorlik = priormixlik_student(INDEPENDENT, HIER, bStart, + BStart, cStart, CStart, par.mu, par.sigma, g, G, + par.df, trans, a0, b0, d); + + dataC = classification(S, lik, par.weight); + loglik = dataC.mixLik; + double urnd = 0.0; + double logliknew = 0.0; + double priorliknew = 0.0; + double acc = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + urnd = mhTune(k) * (2 * R::runif(0.0, 1.0) - 1.0); + dfnew(k) = trans + (par.df(k) - trans) * std::exp(urnd); + liklist lik2 = likelihood_student(y, par.mu, par.sigma, dfnew); + dataC = classification(S, lik2, par.weight); + logliknew = dataC.mixLik; + priorliknew = priormixlik_student(INDEPENDENT, HIER, bStart, + BStart, cStart, CStart, par.mu, par.sigma, g, G, + dfnew, trans, a0, b0, d); + acc = logliknew + priorliknew - (loglik + priorlik) + urnd; + if (std::log(R::runif(0.0, 1.0)) < acc) + { + par.df(k) = dfnew(k); + loglik = logliknew; + priorlik = priorliknew; + par.acc(k) = 1.0; + } + else + { + dfnew(k) = par.df(k); + } + } } diff --git a/src/PriorStudentInd.h b/src/PriorStudentInd.h index 05b1461..e9547b3 100644 --- a/src/PriorStudentInd.h +++ b/src/PriorStudentInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORSTUDENTIND_H__ #define __FINMIX_PRIORSTUDENTIND_H__ @@ -20,17 +20,19 @@ /* Forward declaration */ class ParStudentInd; class PriorStudentInd : virtual public PriorStudentFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; +public: +arma::rowvec weightStart; +arma::rowvec weightPost; - PriorStudentInd (const FinmixPrior&); - virtual ~PriorStudentInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParStudentInd&); - virtual void updateDf (const unsigned int&, const arma::mat&, - const arma::ivec&, ParStudentInd&); +PriorStudentInd (const FinmixPrior&); +virtual ~PriorStudentInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParStudentInd&); +virtual void updateDf(const unsigned int&, const arma::mat&, + const arma::ivec&, ParStudentInd&); }; #endif /* __FINMIX_PRIORSTUDENTIND_H__ */ diff --git a/src/PriorStudmultFix.cpp b/src/PriorStudmultFix.cpp index 18fae49..58cb4d4 100644 --- a/src/PriorStudmultFix.cpp +++ b/src/PriorStudmultFix.cpp @@ -5,213 +5,251 @@ #include "likelihood.h" #include "prior_likelihood.h" -PriorStudmultFix::PriorStudmultFix () : HIER( false ), - INDEPENDENT( false ) {} +PriorStudmultFix::PriorStudmultFix () : HIER(false), + INDEPENDENT(false) +{ +} PriorStudmultFix::PriorStudmultFix (const FinmixPrior& prior) : - HIER(prior.hier), - INDEPENDENT(prior.type == "condconjugate" ? false : true ) + HIER(prior.hier), + INDEPENDENT(prior.type == "condconjugate" ? false : true) { - Rcpp::List tmpMu((SEXP) prior.par["mu"]); - Rcpp::List tmpSigma((SEXP) prior.par["sigma"]); - Rcpp::NumericMatrix tmpb((SEXP) tmpMu["b"]); - const unsigned int r = tmpb.nrow(); - const unsigned int K = tmpb.ncol(); - if (INDEPENDENT) { - Rcpp::NumericVector tmpBinv((SEXP) tmpMu["Binv"]); - Rcpp::IntegerVector tmpDims = tmpBinv.attr("dim"); - BInvStart = arma::cube(tmpBinv.begin(), tmpDims[0], tmpDims[1], - tmpDims[2], true, true); - BStart = arma::cube(tmpDims[0], tmpDims[1], tmpDims[2]); - for (unsigned int k = 0; k < K; ++k) { - BStart.slice(k) = arma::inv(BInvStart.slice(k)); - } - BPost = BStart; - BInvPost = BInvStart; - /* Initialize N0Start and N0Post (not used if INDEPENDENT) */ - N0Start = arma::rowvec(r); - N0Post = N0Start; - } else { /* conditionally conjugate prior */ - Rcpp::NumericVector tmpN((SEXP) tmpMu["N0"]); - N0Start = arma::rowvec(tmpN.begin(), K, true, true); - N0Post = N0Start; - BStart = arma::cube(r, r, K); - BInvStart = BStart; - BPost = BStart; - BInvPost = BInvStart; - } - bStart = arma::mat(tmpb.begin(), r, K, true, true); - bPost = bStart; - Rcpp::NumericMatrix tmpc((SEXP) tmpSigma["c"]); - Rcpp::NumericVector tmpC((SEXP) tmpSigma["C"]); - Rcpp::IntegerVector tmpDims2 = tmpC.attr("dim"); - cStart = arma::rowvec(tmpc.begin(), K, true, true); - cPost = cStart; - CStart = arma::cube(tmpC.begin(), tmpDims2[0], - tmpDims2[1], tmpDims2[2], true, true); - CPost = CStart; - Rcpp::NumericVector tmpLogdetC((SEXP) tmpSigma["logdetC"]); - logdetC = arma::rowvec(tmpLogdetC.begin(), K, true, true); - if (HIER) { - g = tmpSigma["g"]; - Rcpp::NumericMatrix tmpG((SEXP) tmpSigma["G"]); - G = arma::mat(tmpG.begin(), r, r, true, true); - } - Rcpp::List tmpDf((SEXP) prior.par["df"]); - dftype = Rcpp::as(tmpDf["type"]); - trans = Rcpp::as(tmpDf["trans"]); - a0 = Rcpp::as(tmpDf["a0"]); - b0 = Rcpp::as(tmpDf["b0"]); - d = Rcpp::as(tmpDf["d"]); - Rcpp::NumericVector tmpMhTune((SEXP) tmpDf["mhtune"]); - mhTune = arma::rowvec(tmpMhTune.begin(), K, true, true); + Rcpp::List tmpMu((SEXP)prior.par["mu"]); + Rcpp::List tmpSigma((SEXP)prior.par["sigma"]); + Rcpp::NumericMatrix tmpb((SEXP)tmpMu["b"]); + const unsigned int r = tmpb.nrow(); + const unsigned int K = tmpb.ncol(); + + if (INDEPENDENT) + { + Rcpp::NumericVector tmpBinv((SEXP)tmpMu["Binv"]); + Rcpp::IntegerVector tmpDims = tmpBinv.attr("dim"); + BInvStart = arma::cube(tmpBinv.begin(), tmpDims[0], tmpDims[1], + tmpDims[2], true, true); + BStart = arma::cube(tmpDims[0], tmpDims[1], tmpDims[2]); + for (unsigned int k = 0; k < K; ++k) + { + BStart.slice(k) = arma::inv(BInvStart.slice(k)); + } + BPost = BStart; + BInvPost = BInvStart; + /* Initialize N0Start and N0Post (not used if INDEPENDENT) */ + N0Start = arma::rowvec(r); + N0Post = N0Start; + } + else /* conditionally conjugate prior */ + { + Rcpp::NumericVector tmpN((SEXP)tmpMu["N0"]); + N0Start = arma::rowvec(tmpN.begin(), K, true, true); + N0Post = N0Start; + BStart = arma::cube(r, r, K); + BInvStart = BStart; + BPost = BStart; + BInvPost = BInvStart; + } + bStart = arma::mat(tmpb.begin(), r, K, true, true); + bPost = bStart; + Rcpp::NumericMatrix tmpc((SEXP)tmpSigma["c"]); + Rcpp::NumericVector tmpC((SEXP)tmpSigma["C"]); + Rcpp::IntegerVector tmpDims2 = tmpC.attr("dim"); + + cStart = arma::rowvec(tmpc.begin(), K, true, true); + cPost = cStart; + CStart = arma::cube(tmpC.begin(), tmpDims2[0], + tmpDims2[1], tmpDims2[2], true, true); + CPost = CStart; + Rcpp::NumericVector tmpLogdetC((SEXP)tmpSigma["logdetC"]); + + logdetC = arma::rowvec(tmpLogdetC.begin(), K, true, true); + if (HIER) + { + g = tmpSigma["g"]; + Rcpp::NumericMatrix tmpG((SEXP)tmpSigma["G"]); + G = arma::mat(tmpG.begin(), r, r, true, true); + } + Rcpp::List tmpDf((SEXP)prior.par["df"]); + + dftype = Rcpp::as(tmpDf["type"]); + trans = Rcpp::as(tmpDf["trans"]); + a0 = Rcpp::as(tmpDf["a0"]); + b0 = Rcpp::as(tmpDf["b0"]); + d = Rcpp::as(tmpDf["d"]); + Rcpp::NumericVector tmpMhTune((SEXP)tmpDf["mhtune"]); + + mhTune = arma::rowvec(tmpMhTune.begin(), K, true, true); } inline -void PriorStudmultFix::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParStudmultFix& par) +void PriorStudmultFix::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParStudmultFix& par) { - arma::mat repY = arma::repmat(y, 1, K); - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_elem, K); - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - arma::rowvec sind = sum(indDouble, 0); - if (INDEPENDENT) { - if (!par.INDEPENDENT) { - par.INDEPENDENT = true; - } - cPost = cStart + 0.5 * sind; - double sign = 0.0; - for (unsigned int k = 0; k < K; ++k) { - CPost.slice(k) = CStart.slice(k); - arma::uvec yind = find(ind.col(k) != 0.0); - arma::mat y2 = y.rows(yind); - arma::mat b = y2; - b.each_row() -= arma::trans(par.mu.col(k)); - CPost.slice(k) += 0.5 * arma::trans(b) * b; - arma::log_det(logdetC(k), sign, CPost.slice(k)); - logdetC(k) = logdetC(k) * sign; - par.sigma.slice(k) = rinvwishart(cPost(k), CPost.slice(k)); - par.sigma.slice(k); - par.sigmainv.slice(k) = arma::inv(par.sigma.slice(k)); - BInvPost.slice(k) = BInvStart.slice(k) + sind(k) * arma::inv(par.sigma.slice(k)); - BPost.slice(k) = arma::inv(BInvPost.slice(k)); - bPost.col(k) = BInvStart.slice(k) * bStart.col(k) - + arma::inv(par.sigma.slice(k)) * arma::trans(arma::sum(y2, 0)); - bPost.col(k) = BPost.slice(k) * bPost.col(k); - } - } else { /* conditionally conjugate prior */ - if (par.INDEPENDENT) { - par.INDEPENDENT = false; - } - /* BStart is actually N0Start */ - N0Post = N0Start + sind; - for (unsigned int k = 0; k < K; ++k) { - arma::uvec yind = find(ind.col(k) != 0.0); - arma::mat y2 = y.rows(yind); - bPost.col(k) = bStart.col(k) * N0Start(k); - bPost.col(k) += arma::trans(arma::sum(y2, 0)); - bPost.col(k) /= N0Post(k); - } - double sign = 0.0; - cPost = cStart + 0.5 * sind; - arma::rowvec ck = N0Start % sind / N0Post; - for (unsigned int k = 0; k < K; ++k) { - CPost.slice(k) = CStart.slice(k); - arma::uvec yind = find(ind.col(k) != 0.0); - arma::mat y2 = y.rows(yind); - arma::rowvec sk = arma::sum(y2, 0); - if (sind(k) > 0) { - arma::rowvec yk = sk / sind(k); - arma::mat dk = y2; - dk.each_row() -= yk; - CPost.slice(k) += 0.5 * arma::trans(dk) * dk; - CPost.slice(k) += 0.5 * arma::trans(yk - arma::trans(bStart.col(k))) - * (yk - arma::trans(bStart.col(k))) * ck(k); - } else { - CPost.slice(k) += 0.5 * (arma::trans(sk) - bStart.col(k)) - * (arma::trans(sk) - bStart.col(k)) * ck(k); - } - arma::log_det(logdetC(k), sign, CPost.slice(k)); - logdetC(k) = logdetC(k) * sign; - } - } - - /* The parameter update is done here, as we need data 'y' - * and classifications 'S' for the Metropolis-Hastings - * algorithm for the degrees of freedoms update */ - if (par.INDEPENDENT) { - par.mu = rnormult(bPost, BPost); - } else { /* conditionally conjugate prior */ - for (unsigned int k = 0; k < par.sigma.n_slices; ++k) { - par.sigma.slice(k) = rinvwishart(cPost(k),CPost.slice(k)); - par.sigmainv.slice(k) = arma::inv(par.sigma.slice(k)); - BPost.slice(k) = par.sigma.slice(k) / N0Post(k); - BInvPost.slice(k) = arma::inv(BPost.slice(k)); - } - par.mu = rnormult(bPost, BPost); - } - updateDf(K, y, S, par); + arma::mat repY = arma::repmat(y, 1, K); + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_elem, K); + + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + arma::rowvec sind = sum(indDouble, 0); + + if (INDEPENDENT) + { + if (!par.INDEPENDENT) + { + par.INDEPENDENT = true; + } + cPost = cStart + 0.5 * sind; + double sign = 0.0; + for (unsigned int k = 0; k < K; ++k) + { + CPost.slice(k) = CStart.slice(k); + arma::uvec yind = find(ind.col(k) != 0.0); + arma::mat y2 = y.rows(yind); + arma::mat b = y2; + b.each_row() -= arma::trans(par.mu.col(k)); + CPost.slice(k) += 0.5 * arma::trans(b) * b; + arma::log_det(logdetC(k), sign, CPost.slice(k)); + logdetC(k) = logdetC(k) * sign; + par.sigma.slice(k) = rinvwishart(cPost(k), CPost.slice(k)); + par.sigma.slice(k); + par.sigmainv.slice(k) = arma::inv(par.sigma.slice(k)); + BInvPost.slice(k) = BInvStart.slice(k) + sind(k) * arma::inv(par.sigma.slice(k)); + BPost.slice(k) = arma::inv(BInvPost.slice(k)); + bPost.col(k) = BInvStart.slice(k) * bStart.col(k) + + arma::inv(par.sigma.slice(k)) * arma::trans(arma::sum(y2, 0)); + bPost.col(k) = BPost.slice(k) * bPost.col(k); + } + } + else /* conditionally conjugate prior */ + { + if (par.INDEPENDENT) + { + par.INDEPENDENT = false; + } + /* BStart is actually N0Start */ + N0Post = N0Start + sind; + for (unsigned int k = 0; k < K; ++k) + { + arma::uvec yind = find(ind.col(k) != 0.0); + arma::mat y2 = y.rows(yind); + bPost.col(k) = bStart.col(k) * N0Start(k); + bPost.col(k) += arma::trans(arma::sum(y2, 0)); + bPost.col(k) /= N0Post(k); + } + double sign = 0.0; + cPost = cStart + 0.5 * sind; + arma::rowvec ck = N0Start % sind / N0Post; + for (unsigned int k = 0; k < K; ++k) + { + CPost.slice(k) = CStart.slice(k); + arma::uvec yind = find(ind.col(k) != 0.0); + arma::mat y2 = y.rows(yind); + arma::rowvec sk = arma::sum(y2, 0); + if (sind(k) > 0) + { + arma::rowvec yk = sk / sind(k); + arma::mat dk = y2; + dk.each_row() -= yk; + CPost.slice(k) += 0.5 * arma::trans(dk) * dk; + CPost.slice(k) += 0.5 * arma::trans(yk - arma::trans(bStart.col(k))) + * (yk - arma::trans(bStart.col(k))) * ck(k); + } + else + { + CPost.slice(k) += 0.5 * (arma::trans(sk) - bStart.col(k)) + * (arma::trans(sk) - bStart.col(k)) * ck(k); + } + arma::log_det(logdetC(k), sign, CPost.slice(k)); + logdetC(k) = logdetC(k) * sign; + } + } + + /* The parameter update is done here, as we need data 'y' + * and classifications 'S' for the Metropolis-Hastings + * algorithm for the degrees of freedoms update */ + if (par.INDEPENDENT) + { + par.mu = rnormult(bPost, BPost); + } + else /* conditionally conjugate prior */ + { + for (unsigned int k = 0; k < par.sigma.n_slices; ++k) + { + par.sigma.slice(k) = rinvwishart(cPost(k), CPost.slice(k)); + par.sigmainv.slice(k) = arma::inv(par.sigma.slice(k)); + BPost.slice(k) = par.sigma.slice(k) / N0Post(k); + BInvPost.slice(k) = arma::inv(BPost.slice(k)); + } + par.mu = rnormult(bPost, BPost); + } + updateDf(K, y, S, par); } -inline -void PriorStudmultFix::updateDf (const unsigned int& K, - const arma::mat& y, const arma::ivec& S, - ParStudmultFix& par) -{ - arma::rowvec dfnew = par.df; - liklist lik = likelihood_studmult(y, par.mu, par.sigmainv, - par.df); - DataClass dataC; - double loglik = 0.0; - double priorlik = priormixlik_studmult(INDEPENDENT, HIER, - bStart, BInvStart, BStart, cStart, CStart, logdetC, g, G, - par.mu, par.sigma, par.df, trans, a0, b0, d); - dataC = classification_fix(K, S, lik); - loglik = arma::sum(dataC.logLikCd); - double urnd = 0.0; - double logliknew = 0.0; - double priorliknew = 0.0; - double acc = 0.0; - Rcpp::RNGScope scope; - for (unsigned int k = 0; k < K; ++k) { - urnd = mhTune(k) * (2.0 * R::runif(0.0, 1.0) - 1.0); - dfnew(k) = trans + (par.df(k) - trans) * std::exp(urnd); - liklist lik2 = likelihood_studmult(y, par.mu, par.sigmainv, dfnew); - dataC = classification_fix(K, S, lik2); - logliknew = arma::sum(dataC.logLikCd); - priorliknew = priormixlik_studmult(INDEPENDENT, HIER, - bStart, BInvStart, BStart, cStart, CStart, logdetC, g, G, - par.mu, par.sigma, dfnew, trans, a0, b0, d); - acc = logliknew + priorliknew - (loglik + priorlik) + urnd; - if (std::log(R::runif(0.0, 1.0)) < acc) { - par.df(k) = dfnew(k); - loglik = logliknew; - priorlik = priorliknew; - par.acc(k) = 1.0; - } - } +inline +void PriorStudmultFix::updateDf(const unsigned int& K, + const arma::mat& y, const arma::ivec& S, + ParStudmultFix& par) +{ + arma::rowvec dfnew = par.df; + liklist lik = likelihood_studmult(y, par.mu, par.sigmainv, + par.df); + DataClass dataC; + double loglik = 0.0; + double priorlik = priormixlik_studmult(INDEPENDENT, HIER, + bStart, BInvStart, BStart, cStart, CStart, logdetC, g, G, + par.mu, par.sigma, par.df, trans, a0, b0, d); + + dataC = classification_fix(K, S, lik); + loglik = arma::sum(dataC.logLikCd); + double urnd = 0.0; + double logliknew = 0.0; + double priorliknew = 0.0; + double acc = 0.0; + Rcpp::RNGScope scope; + + for (unsigned int k = 0; k < K; ++k) + { + urnd = mhTune(k) * (2.0 * R::runif(0.0, 1.0) - 1.0); + dfnew(k) = trans + (par.df(k) - trans) * std::exp(urnd); + liklist lik2 = likelihood_studmult(y, par.mu, par.sigmainv, dfnew); + dataC = classification_fix(K, S, lik2); + logliknew = arma::sum(dataC.logLikCd); + priorliknew = priormixlik_studmult(INDEPENDENT, HIER, + bStart, BInvStart, BStart, cStart, CStart, logdetC, g, G, + par.mu, par.sigma, dfnew, trans, a0, b0, d); + acc = logliknew + priorliknew - (loglik + priorlik) + urnd; + if (std::log(R::runif(0.0, 1.0)) < acc) + { + par.df(k) = dfnew(k); + loglik = logliknew; + priorlik = priorliknew; + par.acc(k) = 1.0; + } + } } inline -void PriorStudmultFix::updateHier (const ParStudmultFix& par) +void PriorStudmultFix::updateHier(const ParStudmultFix& par) { - if (HIER) { - const unsigned int K = cPost.n_elem; - double gN = arma::sum(cStart) + g; - arma::mat GN = G; - for (unsigned int k = 0; k < K; ++k) { - GN += par.sigma.slice(k); - } - CStart.slice(0) = arma::inv(rinvwishart(gN, GN)); - if (K > 1) { - for (unsigned int k = 1; k < K; ++k) { - CStart.slice(k) = CStart.slice(0); - } - } - } + if (HIER) + { + const unsigned int K = cPost.n_elem; + double gN = arma::sum(cStart) + g; + arma::mat GN = G; + for (unsigned int k = 0; k < K; ++k) + { + GN += par.sigma.slice(k); + } + CStart.slice(0) = arma::inv(rinvwishart(gN, GN)); + if (K > 1) + { + for (unsigned int k = 1; k < K; ++k) + { + CStart.slice(k) = CStart.slice(0); + } + } + } } diff --git a/src/PriorStudmultFix.h b/src/PriorStudmultFix.h index 8259e24..63f505a 100644 --- a/src/PriorStudmultFix.h +++ b/src/PriorStudmultFix.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORSTUDMULTFIX_H__ #define __FINMIX_PRIORSTUDMULTFIX_H__ @@ -21,43 +21,45 @@ class ParStudmultFix; class PriorStudmultFix { - public: - arma::mat bStart; - arma::cube BStart; - arma::cube BInvStart; - arma::rowvec N0Start; - arma::rowvec cStart; - arma::cube CStart; +public: +arma::mat bStart; +arma::cube BStart; +arma::cube BInvStart; +arma::rowvec N0Start; +arma::rowvec cStart; +arma::cube CStart; - arma::mat bPost; - arma::cube BPost; - arma::cube BInvPost; - arma::rowvec N0Post; - arma::rowvec cPost; - arma::cube CPost; - arma::rowvec logdetC; +arma::mat bPost; +arma::cube BPost; +arma::cube BInvPost; +arma::rowvec N0Post; +arma::rowvec cPost; +arma::cube CPost; +arma::rowvec logdetC; - arma::rowvec mhTune; - const bool HIER; - bool INDEPENDENT; - std::string dftype; - double g; - arma::mat G; - double trans; - double a0; - double b0; - double d; +arma::rowvec mhTune; +const bool HIER; +bool INDEPENDENT; +std::string dftype; +double g; +arma::mat G; +double trans; +double a0; +double b0; +double d; - PriorStudmultFix (); - PriorStudmultFix (const FinmixPrior&); - virtual ~PriorStudmultFix () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParStudmultFix&); - void updateDf (const unsigned int& K, - const arma::mat& y, const arma::ivec& S, - ParStudmultFix& par); - virtual void updateHier (const ParStudmultFix&); +PriorStudmultFix (); +PriorStudmultFix (const FinmixPrior&); +virtual ~PriorStudmultFix () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParStudmultFix&); +void updateDf(const unsigned int& K, + const arma::mat& y, const arma::ivec& S, + ParStudmultFix& par); +virtual void updateHier(const ParStudmultFix&); }; #endif /* __FINMIX_PRIORSTUDMULTFIX_H__ */ diff --git a/src/PriorStudmultInd.cpp b/src/PriorStudmultInd.cpp index 75d0490..dc61357 100644 --- a/src/PriorStudmultInd.cpp +++ b/src/PriorStudmultInd.cpp @@ -3,13 +3,15 @@ #include "posterior.h" PriorStudmultInd::PriorStudmultInd (const FinmixPrior& prior) : - PriorStudmultFix(prior), weightStart(prior.weight), - weightPost(prior.weight) {} + PriorStudmultFix(prior), weightStart(prior.weight), + weightPost(prior.weight) +{ +} inline -void PriorStudmultInd::update (const unsigned int& K, const arma::mat& y, - arma::ivec& S, const arma::vec& T, ParStudmultInd& par) +void PriorStudmultInd::update(const unsigned int& K, const arma::mat& y, + arma::ivec& S, const arma::vec& T, ParStudmultInd& par) { - PriorStudmultFix::update(K, y, S, T, par); - weightPost = posterior_multinomial(K, S, weightStart); + PriorStudmultFix::update(K, y, S, T, par); + weightPost = posterior_multinomial(K, S, weightStart); } diff --git a/src/PriorStudmultInd.h b/src/PriorStudmultInd.h index 4b30bf3..27eb1bc 100644 --- a/src/PriorStudmultInd.h +++ b/src/PriorStudmultInd.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_PRIORSTUDMULTIND_H__ #define __FINMIX_PRIORSTUDMULTIND_H__ @@ -21,15 +21,17 @@ class ParStudmultInd; class PriorStudmultInd : virtual public PriorStudmultFix { - public: - arma::rowvec weightStart; - arma::rowvec weightPost; - - PriorStudmultInd (const FinmixPrior&); - virtual ~PriorStudmultInd () {} - virtual void update (const unsigned int&, - const arma::mat&, arma::ivec&, - const arma::vec&, ParStudmultInd&); +public: +arma::rowvec weightStart; +arma::rowvec weightPost; + +PriorStudmultInd (const FinmixPrior&); +virtual ~PriorStudmultInd () +{ +} +virtual void update(const unsigned int&, + const arma::mat&, arma::ivec&, + const arma::vec&, ParStudmultInd&); }; #endif /* __FINMIX_PRIORSTUDMULTIND_H__ */ diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index f61a439..6a6f611 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -13,256 +13,308 @@ Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); // swap_cc Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swap_cc(SEXP valuesSEXP, SEXP indexSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - rcpp_result_gen = Rcpp::wrap(swap_cc(values, index)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_swap_cc(SEXP valuesSEXP, SEXP indexSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + + rcpp_result_gen = Rcpp::wrap(swap_cc(values, index)); + return rcpp_result_gen; + + END_RCPP } // swap_3d_cc Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swap_3d_cc(SEXP valuesSEXP, SEXP indexSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - rcpp_result_gen = Rcpp::wrap(swap_3d_cc(values, index)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_swap_3d_cc(SEXP valuesSEXP, SEXP indexSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + + rcpp_result_gen = Rcpp::wrap(swap_3d_cc(values, index)); + return rcpp_result_gen; + + END_RCPP } // swapInteger_cc Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swapInteger_cc(SEXP valuesSEXP, SEXP indexSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - rcpp_result_gen = Rcpp::wrap(swapInteger_cc(values, index)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_swapInteger_cc(SEXP valuesSEXP, SEXP indexSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + + rcpp_result_gen = Rcpp::wrap(swapInteger_cc(values, index)); + return rcpp_result_gen; + + END_RCPP } // swapInd_cc Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swapInd_cc(SEXP valuesSEXP, SEXP indexSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - rcpp_result_gen = Rcpp::wrap(swapInd_cc(values, index)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_swapInd_cc(SEXP valuesSEXP, SEXP indexSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + + rcpp_result_gen = Rcpp::wrap(swapInd_cc(values, index)); + return rcpp_result_gen; + + END_RCPP } // swapST_cc Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swapST_cc(SEXP valuesSEXP, SEXP indexSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - rcpp_result_gen = Rcpp::wrap(swapST_cc(values, index)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_swapST_cc(SEXP valuesSEXP, SEXP indexSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + + rcpp_result_gen = Rcpp::wrap(swapST_cc(values, index)); + return rcpp_result_gen; + + END_RCPP } // ldgamma_cc Rcpp::NumericMatrix ldgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, Rcpp::NumericVector rate); -RcppExport SEXP _finmix_ldgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); - rcpp_result_gen = Rcpp::wrap(ldgamma_cc(values, shape, rate)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_ldgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); + + rcpp_result_gen = Rcpp::wrap(ldgamma_cc(values, shape, rate)); + return rcpp_result_gen; + + END_RCPP } // dgamma_cc arma::mat dgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, Rcpp::NumericVector rate); -RcppExport SEXP _finmix_dgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); - rcpp_result_gen = Rcpp::wrap(dgamma_cc(values, shape, rate)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_dgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); + + rcpp_result_gen = Rcpp::wrap(dgamma_cc(values, shape, rate)); + return rcpp_result_gen; + + END_RCPP } // lddirichlet_cc Rcpp::NumericVector lddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par); -RcppExport SEXP _finmix_lddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); - rcpp_result_gen = Rcpp::wrap(lddirichlet_cc(values, par)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_lddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); + + rcpp_result_gen = Rcpp::wrap(lddirichlet_cc(values, par)); + return rcpp_result_gen; + + END_RCPP } // ddirichlet_cc arma::vec ddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par); -RcppExport SEXP _finmix_ddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); - rcpp_result_gen = Rcpp::wrap(ddirichlet_cc(values, par)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_ddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); + + rcpp_result_gen = Rcpp::wrap(ddirichlet_cc(values, par)); + return rcpp_result_gen; + + END_RCPP } // hungarian_cc arma::imat hungarian_cc(const arma::mat cost); -RcppExport SEXP _finmix_hungarian_cc(SEXP costSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::mat >::type cost(costSEXP); - rcpp_result_gen = Rcpp::wrap(hungarian_cc(cost)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_hungarian_cc(SEXP costSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const arma::mat >::type cost(costSEXP); + + rcpp_result_gen = Rcpp::wrap(hungarian_cc(cost)); + return rcpp_result_gen; + + END_RCPP } // moments_cc Rcpp::List moments_cc(Rcpp::S4 classS4); -RcppExport SEXP _finmix_moments_cc(SEXP classS4SEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); - rcpp_result_gen = Rcpp::wrap(moments_cc(classS4)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_moments_cc(SEXP classS4SEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); + + rcpp_result_gen = Rcpp::wrap(moments_cc(classS4)); + return rcpp_result_gen; + + END_RCPP } // permmoments_cc Rcpp::List permmoments_cc(Rcpp::S4 classS4); -RcppExport SEXP _finmix_permmoments_cc(SEXP classS4SEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); - rcpp_result_gen = Rcpp::wrap(permmoments_cc(classS4)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_permmoments_cc(SEXP classS4SEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); + + rcpp_result_gen = Rcpp::wrap(permmoments_cc(classS4)); + return rcpp_result_gen; + + END_RCPP } // stephens1997a_poisson_cc arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm); -RcppExport SEXP _finmix_stephens1997a_poisson_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values1(values1SEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); - Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); - Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); - rcpp_result_gen = Rcpp::wrap(stephens1997a_poisson_cc(values1, values2, pars, perm)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_stephens1997a_poisson_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values1(values1SEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); + Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); + Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); + + rcpp_result_gen = Rcpp::wrap(stephens1997a_poisson_cc(values1, values2, pars, perm)); + return rcpp_result_gen; + + END_RCPP } // stephens1997a_binomial_cc arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm); -RcppExport SEXP _finmix_stephens1997a_binomial_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix& >::type values1(values1SEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); - Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); - Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); - rcpp_result_gen = Rcpp::wrap(stephens1997a_binomial_cc(values1, values2, pars, perm)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_stephens1997a_binomial_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix& >::type values1(values1SEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); + Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); + Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); + + rcpp_result_gen = Rcpp::wrap(stephens1997a_binomial_cc(values1, values2, pars, perm)); + return rcpp_result_gen; + + END_RCPP } // stephens1997b_poisson_cc arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par, signed int max_iter); -RcppExport SEXP _finmix_stephens1997b_poisson_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP, SEXP max_iterSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - Rcpp::traits::input_parameter< signed int >::type max_iter(max_iterSEXP); - rcpp_result_gen = Rcpp::wrap(stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_stephens1997b_poisson_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP, SEXP max_iterSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); + Rcpp::traits::input_parameter< signed int >::type max_iter(max_iterSEXP); + + rcpp_result_gen = Rcpp::wrap(stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter)); + return rcpp_result_gen; + + END_RCPP } // stephens1997b_binomial_cc arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, Rcpp::NumericVector reps, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par); -RcppExport SEXP _finmix_stephens1997b_binomial_cc(SEXP valuesSEXP, SEXP repsSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type reps(repsSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - rcpp_result_gen = Rcpp::wrap(stephens1997b_binomial_cc(values, reps, comp_par, weight_par)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_stephens1997b_binomial_cc(SEXP valuesSEXP, SEXP repsSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type reps(repsSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); + + rcpp_result_gen = Rcpp::wrap(stephens1997b_binomial_cc(values, reps, comp_par, weight_par)); + return rcpp_result_gen; + + END_RCPP } // stephens1997b_exponential_cc arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par); -RcppExport SEXP _finmix_stephens1997b_exponential_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - rcpp_result_gen = Rcpp::wrap(stephens1997b_exponential_cc(values, comp_par, weight_par)); - return rcpp_result_gen; -END_RCPP +RcppExport SEXP _finmix_stephens1997b_exponential_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) +{ + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); + + rcpp_result_gen = Rcpp::wrap(stephens1997b_exponential_cc(values, comp_par, weight_par)); + return rcpp_result_gen; + + END_RCPP } -RcppExport SEXP mcmc_binomial_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_condpoisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_exponential_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_normal_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_normult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_poisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_student_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_studmult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_binomial_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_condpoisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_exponential_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_normal_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_normult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_poisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_student_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_studmult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { - {"_finmix_swap_cc", (DL_FUNC) &_finmix_swap_cc, 2}, - {"_finmix_swap_3d_cc", (DL_FUNC) &_finmix_swap_3d_cc, 2}, - {"_finmix_swapInteger_cc", (DL_FUNC) &_finmix_swapInteger_cc, 2}, - {"_finmix_swapInd_cc", (DL_FUNC) &_finmix_swapInd_cc, 2}, - {"_finmix_swapST_cc", (DL_FUNC) &_finmix_swapST_cc, 2}, - {"_finmix_ldgamma_cc", (DL_FUNC) &_finmix_ldgamma_cc, 3}, - {"_finmix_dgamma_cc", (DL_FUNC) &_finmix_dgamma_cc, 3}, - {"_finmix_lddirichlet_cc", (DL_FUNC) &_finmix_lddirichlet_cc, 2}, - {"_finmix_ddirichlet_cc", (DL_FUNC) &_finmix_ddirichlet_cc, 2}, - {"_finmix_hungarian_cc", (DL_FUNC) &_finmix_hungarian_cc, 1}, - {"_finmix_moments_cc", (DL_FUNC) &_finmix_moments_cc, 1}, - {"_finmix_permmoments_cc", (DL_FUNC) &_finmix_permmoments_cc, 1}, - {"_finmix_stephens1997a_poisson_cc", (DL_FUNC) &_finmix_stephens1997a_poisson_cc, 4}, - {"_finmix_stephens1997a_binomial_cc", (DL_FUNC) &_finmix_stephens1997a_binomial_cc, 4}, - {"_finmix_stephens1997b_poisson_cc", (DL_FUNC) &_finmix_stephens1997b_poisson_cc, 4}, - {"_finmix_stephens1997b_binomial_cc", (DL_FUNC) &_finmix_stephens1997b_binomial_cc, 4}, - {"_finmix_stephens1997b_exponential_cc", (DL_FUNC) &_finmix_stephens1997b_exponential_cc, 3}, - {"mcmc_binomial_cc", (DL_FUNC) &mcmc_binomial_cc, 5}, - {"mcmc_condpoisson_cc", (DL_FUNC) &mcmc_condpoisson_cc, 5}, - {"mcmc_exponential_cc", (DL_FUNC) &mcmc_exponential_cc, 5}, - {"mcmc_normal_cc", (DL_FUNC) &mcmc_normal_cc, 5}, - {"mcmc_normult_cc", (DL_FUNC) &mcmc_normult_cc, 5}, - {"mcmc_poisson_cc", (DL_FUNC) &mcmc_poisson_cc, 5}, - {"mcmc_student_cc", (DL_FUNC) &mcmc_student_cc, 5}, - {"mcmc_studmult_cc", (DL_FUNC) &mcmc_studmult_cc, 5}, - {NULL, NULL, 0} + { "_finmix_swap_cc", (DL_FUNC)&_finmix_swap_cc, 2 }, + { "_finmix_swap_3d_cc", (DL_FUNC)&_finmix_swap_3d_cc, 2 }, + { "_finmix_swapInteger_cc", (DL_FUNC)&_finmix_swapInteger_cc, 2 }, + { "_finmix_swapInd_cc", (DL_FUNC)&_finmix_swapInd_cc, 2 }, + { "_finmix_swapST_cc", (DL_FUNC)&_finmix_swapST_cc, 2 }, + { "_finmix_ldgamma_cc", (DL_FUNC)&_finmix_ldgamma_cc, 3 }, + { "_finmix_dgamma_cc", (DL_FUNC)&_finmix_dgamma_cc, 3 }, + { "_finmix_lddirichlet_cc", (DL_FUNC)&_finmix_lddirichlet_cc, 2 }, + { "_finmix_ddirichlet_cc", (DL_FUNC)&_finmix_ddirichlet_cc, 2 }, + { "_finmix_hungarian_cc", (DL_FUNC)&_finmix_hungarian_cc, 1 }, + { "_finmix_moments_cc", (DL_FUNC)&_finmix_moments_cc, 1 }, + { "_finmix_permmoments_cc", (DL_FUNC)&_finmix_permmoments_cc, 1 }, + { "_finmix_stephens1997a_poisson_cc", (DL_FUNC)&_finmix_stephens1997a_poisson_cc, 4 }, + { "_finmix_stephens1997a_binomial_cc", (DL_FUNC)&_finmix_stephens1997a_binomial_cc, 4 }, + { "_finmix_stephens1997b_poisson_cc", (DL_FUNC)&_finmix_stephens1997b_poisson_cc, 4 }, + { "_finmix_stephens1997b_binomial_cc", (DL_FUNC)&_finmix_stephens1997b_binomial_cc, 4 }, + { "_finmix_stephens1997b_exponential_cc", (DL_FUNC)&_finmix_stephens1997b_exponential_cc, 3 }, + { "mcmc_binomial_cc", (DL_FUNC)&mcmc_binomial_cc, 5 }, + { "mcmc_condpoisson_cc", (DL_FUNC)&mcmc_condpoisson_cc, 5 }, + { "mcmc_exponential_cc", (DL_FUNC)&mcmc_exponential_cc, 5 }, + { "mcmc_normal_cc", (DL_FUNC)&mcmc_normal_cc, 5 }, + { "mcmc_normult_cc", (DL_FUNC)&mcmc_normult_cc, 5 }, + { "mcmc_poisson_cc", (DL_FUNC)&mcmc_poisson_cc, 5 }, + { "mcmc_student_cc", (DL_FUNC)&mcmc_student_cc, 5 }, + { "mcmc_studmult_cc", (DL_FUNC)&mcmc_studmult_cc, 5 }, + { NULL, NULL, 0 } }; -RcppExport void R_init_finmix(DllInfo *dll) { - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); +RcppExport void R_init_finmix(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); } diff --git a/src/algorithms.h b/src/algorithms.h index 7539270..cefc59d 100644 --- a/src/algorithms.h +++ b/src/algorithms.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2012-2013 Lars Simon Zehnder. All Rights Reserved. - * Web: - - * - * Author: Lars Simon Zehnder - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2012-2013 Lars Simon Zehnder. All Rights Reserved. +* Web: - +* +* Author: Lars Simon Zehnder +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_ALGORITHMS_H__ #define __FINMIX_ALGORITHMS_H__ @@ -20,45 +20,55 @@ inline double kulback_leibler(const arma::vec &values, const arma::vec &base) { - const unsigned int N = values.n_elem; - //const unsigned int K = values.n_elem; - double rvalue; - if (arma::any(values == 0.0) || arma::any(base == 0.0)) { - arma::vec values_smoothed = (values * N + 1.0) / (N + 1.0); - arma::vec base_smoothed = (base * N + 1.0) / (N + 1.0); - rvalue = arma::sum(values_smoothed % arma::log(values_smoothed/base_smoothed)); - } else { - rvalue = arma::sum(values % arma::log(values/base)); - } - - //Rcpp::Rcout << "kullback: " << rvalue << std::endl; - return rvalue; + const unsigned int N = values.n_elem; + //const unsigned int K = values.n_elem; + double rvalue; + + if (arma::any(values == 0.0) || arma::any(base == 0.0)) + { + arma::vec values_smoothed = (values * N + 1.0) / (N + 1.0); + arma::vec base_smoothed = (base * N + 1.0) / (N + 1.0); + rvalue = arma::sum(values_smoothed % arma::log(values_smoothed / base_smoothed)); + } + else + { + rvalue = arma::sum(values % arma::log(values / base)); + } + + //Rcpp::Rcout << "kullback: " << rvalue << std::endl; + return rvalue; } inline -void swapmat_by_index(arma::mat &values, arma::umat index) { - const unsigned int K = values.n_cols; - const unsigned int M = values.n_rows; - arma::uvec row_index(1); - arma::urowvec swap_index(K); - for(unsigned int i = 0; i < M; ++i) { - row_index.at(0) = i; - swap_index = index.row(i); - values.row(i) = values.submat(row_index, swap_index); - } +void swapmat_by_index(arma::mat &values, arma::umat index) +{ + const unsigned int K = values.n_cols; + const unsigned int M = values.n_rows; + arma::uvec row_index(1); + arma::urowvec swap_index(K); + + for (unsigned int i = 0; i < M; ++i) + { + row_index.at(0) = i; + swap_index = index.row(i); + values.row(i) = values.submat(row_index, swap_index); + } } inline -void swapumat_by_index(arma::umat &values, const arma::umat &index) { - const unsigned int K = values.n_cols; - const unsigned int M = values.n_rows; - arma::uvec row_index(1); - arma::urowvec swap_index(K); - for(unsigned int i = 0; i < M; ++i) { - row_index.at(0) = i; - swap_index = index.row(i); - values.row(i) = values.submat(row_index, swap_index); - } +void swapumat_by_index(arma::umat &values, const arma::umat &index) +{ + const unsigned int K = values.n_cols; + const unsigned int M = values.n_rows; + arma::uvec row_index(1); + arma::urowvec swap_index(K); + + for (unsigned int i = 0; i < M; ++i) + { + row_index.at(0) = i; + swap_index = index.row(i); + values.row(i) = values.submat(row_index, swap_index); + } } #endif /* __FINMIX_ALGORITHMS_H__ */ diff --git a/src/attributes.cpp b/src/attributes.cpp index 05c069f..0c5b711 100644 --- a/src/attributes.cpp +++ b/src/attributes.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ // [[Rcpp::depends(RcppArmadillo)]] #include "algorithms.h" @@ -30,231 +30,268 @@ // [[Rcpp::export]] -Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index) { - /* If dimensions of both arguments do not agree throw an exception */ - if(values.nrow() != index.nrow() || values.ncol() != index.ncol()) { - throw Rcpp::exception("Matrix dimensions disagree."); - } - /* Do not reuse memory from R as otherwise existing objects - * get manipulated */ - const unsigned int K = values.ncol(); - const unsigned int M = values.nrow(); - arma::mat values_arma(values.begin(), M, K, true, true); - arma::imat index_arma(index.begin(), M, K, true, true); - arma::mat values_copy(M, K); - arma::umat index_umat = arma::conv_to::from(index_arma) - 1; - arma::uvec row_index(1); - arma::urowvec swap_index(K); - for(unsigned int i = 0; i < M; ++i) { - row_index.at(0) = i; - swap_index = index_umat.row(i); - values_copy.row(i) = - values_arma.submat(row_index, swap_index); - } - return Rcpp::wrap(values_copy); +Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index) +{ + /* If dimensions of both arguments do not agree throw an exception */ + if (values.nrow() != index.nrow() || values.ncol() != index.ncol()) + { + throw Rcpp::exception("Matrix dimensions disagree."); + } + /* Do not reuse memory from R as otherwise existing objects + * get manipulated */ + const unsigned int K = values.ncol(); + const unsigned int M = values.nrow(); + arma::mat values_arma(values.begin(), M, K, true, true); + arma::imat index_arma(index.begin(), M, K, true, true); + arma::mat values_copy(M, K); + arma::umat index_umat = arma::conv_to::from(index_arma) - 1; + arma::uvec row_index(1); + arma::urowvec swap_index(K); + + for (unsigned int i = 0; i < M; ++i) + { + row_index.at(0) = i; + swap_index = index_umat.row(i); + values_copy.row(i) = + values_arma.submat(row_index, swap_index); + } + return Rcpp::wrap(values_copy); } // [[Rcpp::export]] Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix index) { - Rcpp::IntegerVector valDim = values.attr("dim"); - const unsigned int M = valDim[0]; - const unsigned int r = valDim[1]; - const unsigned int K = valDim[2]; - /* If dimensions of both arguments do not agree thrw an exception */ - if ( M != (unsigned)index.nrow() || K != (unsigned)index.ncol()) { - throw Rcpp::exception("Matrix dimensions disagree."); - } - arma::cube values_arma(values.begin(), M, r, K, false, true); - arma::imat index_arma(index.begin(), M, K, false, true); - arma::cube output(M, r, K); - output.fill(0.0); - arma::umat index_umat = arma::conv_to::from(index_arma) - 1; - arma::umat ik(M, K); - arma::ucube ikr(M, 1, K); - arma::ucube ikr2(M, r, K); - arma::cube ikr3(M, r, K); - for (unsigned int k = 0; k < K; ++k) { - ik = (index_arma - 1) == k; - ikr.slices(0, K - 1) = ik; - ikr2 = arma::resize(ikr, M, r, K); - for (unsigned int rr = 1; rr < r; ++rr) { - ikr2.tube(0, rr, M - 1, rr) = ikr2.tube(0, 0, M - 1, 0); - } - ikr3 = arma::conv_to::from(ikr2); - ikr3 %= values_arma; - for (unsigned int l = 0; l < K; ++l) { - output.slice(k) += ikr3.slice(l); - } - ik.fill(0); - ikr.fill(0); - ikr2.fill(0); - ikr3.fill(0); - } - return Rcpp::wrap(output); + Rcpp::IntegerVector valDim = values.attr("dim"); + const unsigned int M = valDim[0]; + const unsigned int r = valDim[1]; + const unsigned int K = valDim[2]; + + /* If dimensions of both arguments do not agree thrw an exception */ + if (M != (unsigned)index.nrow() || K != (unsigned)index.ncol()) + { + throw Rcpp::exception("Matrix dimensions disagree."); + } + arma::cube values_arma(values.begin(), M, r, K, false, true); + arma::imat index_arma(index.begin(), M, K, false, true); + arma::cube output(M, r, K); + + output.fill(0.0); + arma::umat index_umat = arma::conv_to::from(index_arma) - 1; + arma::umat ik(M, K); + arma::ucube ikr(M, 1, K); + arma::ucube ikr2(M, r, K); + arma::cube ikr3(M, r, K); + + for (unsigned int k = 0; k < K; ++k) + { + ik = (index_arma - 1) == k; + ikr.slices(0, K - 1) = ik; + ikr2 = arma::resize(ikr, M, r, K); + for (unsigned int rr = 1; rr < r; ++rr) + { + ikr2.tube(0, rr, M - 1, rr) = ikr2.tube(0, 0, M - 1, 0); + } + ikr3 = arma::conv_to::from(ikr2); + ikr3 %= values_arma; + for (unsigned int l = 0; l < K; ++l) + { + output.slice(k) += ikr3.slice(l); + } + ik.fill(0); + ikr.fill(0); + ikr2.fill(0); + ikr3.fill(0); + } + return Rcpp::wrap(output); } // [[Rcpp::export]] -Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index) { - /* If dimensions of both arguments do not agree throw an exception */ - if(values.nrow() != index.nrow() || values.ncol() != index.ncol()) { - throw Rcpp::exception("Matrix dimensions disagree."); - } - /* Do not reuse memory from R as otherwise existing objects - * get manipulated */ - const unsigned int K = values.ncol(); - const unsigned int M = values.nrow(); - arma::imat values_arma(values.begin(), M, K, true, true); - arma::imat index_arma(index.begin(), M, K, true, true); - arma::imat values_copy(M, K); - arma::umat index_umat = arma::conv_to::from(index_arma) - 1; - arma::uvec row_index(1); - arma::urowvec swap_index(K); - for(unsigned int i = 0; i < M; ++i) { - row_index.at(0) = i; - swap_index = index_umat.row(i); - values_copy.row(i) = - values_arma.submat(row_index, swap_index); - } - return Rcpp::wrap(values_copy); +Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index) +{ + /* If dimensions of both arguments do not agree throw an exception */ + if (values.nrow() != index.nrow() || values.ncol() != index.ncol()) + { + throw Rcpp::exception("Matrix dimensions disagree."); + } + /* Do not reuse memory from R as otherwise existing objects + * get manipulated */ + const unsigned int K = values.ncol(); + const unsigned int M = values.nrow(); + arma::imat values_arma(values.begin(), M, K, true, true); + arma::imat index_arma(index.begin(), M, K, true, true); + arma::imat values_copy(M, K); + arma::umat index_umat = arma::conv_to::from(index_arma) - 1; + arma::uvec row_index(1); + arma::urowvec swap_index(K); + + for (unsigned int i = 0; i < M; ++i) + { + row_index.at(0) = i; + swap_index = index_umat.row(i); + values_copy.row(i) = + values_arma.submat(row_index, swap_index); + } + return Rcpp::wrap(values_copy); } // [[Rcpp::export]] -Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index) { - /* If dimensions of both arguments do not agree throw an exception */ - if (values.ncol() != index.nrow()) { - throw Rcpp::exception("Matrix dimensions disagree."); - } - /* Reuse memory from R */ - const unsigned int N = values.nrow(); - const unsigned int STORES = values.ncol(); - const unsigned int M = index.nrow(); - const unsigned int K = index.ncol(); - arma::imat values_arma(values.begin(), N, STORES, true, true); - arma::imat index_arma(index.begin(), M, K, true, true); - arma::imat values_copy(N, STORES); - for (unsigned int s = 0; s < STORES; ++s) { - for (unsigned int i = 0; i < N; ++i) { - values_copy(i, s) = (int) index_arma(s, (unsigned int) - values_arma(i, s) - 1); - } - } - return Rcpp::wrap(values_copy); +Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index) +{ + /* If dimensions of both arguments do not agree throw an exception */ + if (values.ncol() != index.nrow()) + { + throw Rcpp::exception("Matrix dimensions disagree."); + } + /* Reuse memory from R */ + const unsigned int N = values.nrow(); + const unsigned int STORES = values.ncol(); + const unsigned int M = index.nrow(); + const unsigned int K = index.ncol(); + arma::imat values_arma(values.begin(), N, STORES, true, true); + arma::imat index_arma(index.begin(), M, K, true, true); + arma::imat values_copy(N, STORES); + + for (unsigned int s = 0; s < STORES; ++s) + { + for (unsigned int i = 0; i < N; ++i) + { + values_copy(i, s) = (int)index_arma(s, (unsigned int) + values_arma(i, s) - 1); + } + } + return Rcpp::wrap(values_copy); } // [[Rcpp::export]] -Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix index) { - /* If dimensions of both arguments do not agree throw an exception */ - if (values.size() != index.nrow()) { - throw Rcpp::exception("Matrix dimensions disagree."); - } - /* Reuse memory from R */ - const unsigned int M = values.size(); - const unsigned int K = index.ncol(); - arma::ivec values_arma(values.begin(), M, false, true); - arma::imat index_arma(index.begin(), M, K, false, true); - arma::ivec values_copy(M); - for(unsigned int i = 0; i < M; ++i) { - values_copy(i) = index_arma(i, (unsigned int) - values_arma(i) - 1); - } - return Rcpp::wrap(values_copy); +Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix index) +{ + /* If dimensions of both arguments do not agree throw an exception */ + if (values.size() != index.nrow()) + { + throw Rcpp::exception("Matrix dimensions disagree."); + } + /* Reuse memory from R */ + const unsigned int M = values.size(); + const unsigned int K = index.ncol(); + arma::ivec values_arma(values.begin(), M, false, true); + arma::imat index_arma(index.begin(), M, K, false, true); + arma::ivec values_copy(M); + + for (unsigned int i = 0; i < M; ++i) + { + values_copy(i) = index_arma(i, (unsigned int) + values_arma(i) - 1); + } + return Rcpp::wrap(values_copy); } // [[Rcpp::export]] Rcpp::NumericMatrix ldgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, - Rcpp::NumericVector rate) + Rcpp::NumericVector rate) { - /* Reuse memory from R */ - const unsigned int M = values.nrow(); - const unsigned int K = values.ncol(); - arma::mat arma_values(values.begin(), M, K, false, true); - arma::vec arma_shape(shape.begin(), K, false, true); - arma::vec arma_rate(rate.begin(), K, false, true); - arma::mat arma_return(M, K); - arma_return = ldgamma(arma_values, arma_shape, arma_rate); - return Rcpp::wrap(arma_return); + /* Reuse memory from R */ + const unsigned int M = values.nrow(); + const unsigned int K = values.ncol(); + arma::mat arma_values(values.begin(), M, K, false, true); + arma::vec arma_shape(shape.begin(), K, false, true); + arma::vec arma_rate(rate.begin(), K, false, true); + arma::mat arma_return(M, K); + + arma_return = ldgamma(arma_values, arma_shape, arma_rate); + return Rcpp::wrap(arma_return); } // [[Rcpp::export]] arma::mat dgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, - Rcpp::NumericVector rate) + Rcpp::NumericVector rate) { - /* Reuse memory from R */ - const unsigned int M = values.nrow(); - const unsigned int K = values.ncol(); - arma::mat arma_values(values.begin(), M, K, false, true); - arma::vec arma_shape(shape.begin(), K, false, true); - arma::vec arma_rate(rate.begin(), K, false, true); - arma::mat arma_return(M, K); - arma_return = exp(ldgamma(arma_values, arma_shape, arma_rate)); - return arma_return; + /* Reuse memory from R */ + const unsigned int M = values.nrow(); + const unsigned int K = values.ncol(); + arma::mat arma_values(values.begin(), M, K, false, true); + arma::vec arma_shape(shape.begin(), K, false, true); + arma::vec arma_rate(rate.begin(), K, false, true); + arma::mat arma_return(M, K); + + arma_return = exp(ldgamma(arma_values, arma_shape, arma_rate)); + return arma_return; } // [[Rcpp::export]] Rcpp::NumericVector lddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par) { - /* Reuse memory from R */ - const unsigned int M = values.nrow(); - const unsigned int K = values.ncol(); - arma::mat arma_values(values.begin(), M, K, false, true); - arma::vec arma_par(par.begin(), K, false, true); - arma::vec arma_return(M); - arma_return = lddirichlet(arma_values, arma_par); - return Rcpp::wrap(arma_return); + /* Reuse memory from R */ + const unsigned int M = values.nrow(); + const unsigned int K = values.ncol(); + arma::mat arma_values(values.begin(), M, K, false, true); + arma::vec arma_par(par.begin(), K, false, true); + arma::vec arma_return(M); + + arma_return = lddirichlet(arma_values, arma_par); + return Rcpp::wrap(arma_return); } // [[Rcpp::export]] arma::vec ddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par) { - /* Reuse memory from R */ - const unsigned int M = values.nrow(); - const unsigned int K = values.ncol(); - arma::mat arma_values(values.begin(), M, K, false, true); - arma::vec arma_par(par.begin(), K, false, true); - arma::vec arma_return(M); - arma_return = arma::exp(lddirichlet(arma_values, arma_par)); - return arma_return; + /* Reuse memory from R */ + const unsigned int M = values.nrow(); + const unsigned int K = values.ncol(); + arma::mat arma_values(values.begin(), M, K, false, true); + arma::vec arma_par(par.begin(), K, false, true); + arma::vec arma_return(M); + + arma_return = arma::exp(lddirichlet(arma_values, arma_par)); + return arma_return; } -// [[Rcpp::export]] +// [[Rcpp::export]] -arma::imat hungarian_cc(const arma::mat cost) +arma::imat hungarian_cc(const arma::mat cost) { - arma::umat indM = hungarian(cost); - return arma::conv_to::from(indM); + arma::umat indM = hungarian(cost); + + return arma::conv_to::from(indM); } // [[Rcpp::export]] -Rcpp::List moments_cc(Rcpp::S4 classS4) +Rcpp::List moments_cc(Rcpp::S4 classS4) { - Rcpp::S4 model = Rcpp::as((SEXP) classS4.slot("model")); - const bool indicfix = Rcpp::as((SEXP) model.slot("indicfix")); - if (indicfix) { - return Rcpp::wrap(moments_fix_cc(classS4)); - } else { - return Rcpp::wrap(moments_ind_cc(classS4)); - } + Rcpp::S4 model = Rcpp::as((SEXP)classS4.slot("model")); + const bool indicfix = Rcpp::as((SEXP)model.slot("indicfix")); + + if (indicfix) + { + return Rcpp::wrap(moments_fix_cc(classS4)); + } + else + { + return Rcpp::wrap(moments_ind_cc(classS4)); + } } // [[Rcpp::export]] -Rcpp::List permmoments_cc(Rcpp::S4 classS4) +Rcpp::List permmoments_cc(Rcpp::S4 classS4) { - Rcpp::S4 model = Rcpp::as((SEXP) classS4.slot("model")); - const bool indicfix = Rcpp::as((SEXP) model.slot("indicfix")); - if (indicfix) { - return Rcpp::wrap(permmoments_fix_cc(classS4)); - } else { - return Rcpp::wrap(permmoments_ind_cc(classS4)); - } + Rcpp::S4 model = Rcpp::as((SEXP)classS4.slot("model")); + const bool indicfix = Rcpp::as((SEXP)model.slot("indicfix")); + + if (indicfix) + { + return Rcpp::wrap(permmoments_fix_cc(classS4)); + } + else + { + return Rcpp::wrap(permmoments_ind_cc(classS4)); + } } diff --git a/src/distributions.h b/src/distributions.h index 22a8fd7..7b78562 100644 --- a/src/distributions.h +++ b/src/distributions.h @@ -1,30 +1,30 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_DISTRIBUTIONS_H__ #define __FINMIX_DISTRIBUTIONS_H__ #include -#include // for use of C++ Standard Library math functions +#include // for use of C++ Standard Library math functions #include #include // for use of R internal C functions @@ -37,60 +37,64 @@ * @brief Samples a vector from a Dirichlet distribution. * @par dpar Dirichlet parameters, 1 x K * @detail Sampling of the Dirichlet is implemented through - * the function 'Rf_rgamma()' from Rmath.h. + * the function 'Rf_rgamma()' from Rmath.h. * @see R::rgamma * @author Lars Simon Zehnder * --------------------------------------------------------------- **/ inline -arma::rowvec rdirichlet (const arma::rowvec& dpar) +arma::rowvec rdirichlet(const arma::rowvec& dpar) { - const unsigned int K = dpar.n_elem; - arma::rowvec par_out(K); - double sum = 0.0; - GetRNGstate(); + const unsigned int K = dpar.n_elem; + arma::rowvec par_out(K); + double sum = 0.0; - for(unsigned int k = 0; k < K; ++k) { - par_out(k) = R::rgamma(dpar(k), 1); - sum += par_out(k); - } + GetRNGstate(); - PutRNGstate(); - par_out = par_out/sum; + for (unsigned int k = 0; k < K; ++k) + { + par_out(k) = R::rgamma(dpar(k), 1); + sum += par_out(k); + } - return par_out; + PutRNGstate(); + par_out = par_out / sum; + + return par_out; } /** * ------------------------------------------------------------------ * lddirichlet - * @brief Computes the log density of the Dirichlet distribution + * @brief Computes the log density of the Dirichlet distribution * for a vector of values. - * @param values values for which the log density should be + * @param values values for which the log density should be * calculated * @param par parameters of the Dirichlet distribution - * @detail The function does use the fast access function 'at()' + * @detail The function does use the fast access function 'at()' * for Armadillo objects and therefore no boundaries for - * indices get checked. Inside the Rcpp sugar wrapper - * 'lgammafn()' from the 'R' namespace is used. + * indices get checked. Inside the Rcpp sugar wrapper + * 'lgammafn()' from the 'R' namespace is used. * @see R::lgammfn, arma::mat<>.at() * @author Lars Simon Zehnder * ----------------------------------------------------------------- */ -inline -arma::vec lddirichlet (const arma::mat &values, const arma::vec &par) +inline +arma::vec lddirichlet(const arma::mat &values, const arma::vec &par) { - const unsigned int M = values.n_rows; - const unsigned int K = values.n_cols; - arma::vec rvalues = arma::zeros(M); - double std_const = 0.0; - for (unsigned int k = 0; k < K; ++k) { - rvalues += arma::log(values.unsafe_col(k)) * (par.at(k) - 1); - std_const += R::lgammafn(par.at(k)); - } - std_const -= R::lgammafn(arma::as_scalar(arma::sum(par))); - rvalues -= std_const; - return(rvalues); + const unsigned int M = values.n_rows; + const unsigned int K = values.n_cols; + arma::vec rvalues = arma::zeros(M); + double std_const = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + rvalues += arma::log(values.unsafe_col(k)) * (par.at(k) - 1); + std_const += R::lgammafn(par.at(k)); + } + std_const -= R::lgammafn(arma::as_scalar(arma::sum(par))); + rvalues -= std_const; + return(rvalues); } // ================================================================= @@ -104,7 +108,7 @@ arma::vec lddirichlet (const arma::mat &values, const arma::vec &par) * Armadillo parameter vector. * @param value the density is calculated for * @param par parameter vector; 1 x K - * @return vector with density values for the corresponding + * @return vector with density values for the corresponding * parameters in 'par' * @detail Uses inside the 'dpois()' function from Rcpp's 'R' * namespace. @@ -112,15 +116,17 @@ arma::vec lddirichlet (const arma::mat &values, const arma::vec &par) * @author Lars Simon Zehnder * ------------------------------------------------------------------ **/ -inline +inline arma::rowvec dpoisson(const double &value, const arma::rowvec &par) { - const unsigned int K = par.n_elem; - arma::rowvec rvec(K); - for (unsigned int k = 0; k < K; ++k) { - rvec(k) = R::dpois(value, par(k), 0); - } - return rvec; + const unsigned int K = par.n_elem; + arma::rowvec rvec(K); + + for (unsigned int k = 0; k < K; ++k) + { + rvec(k) = R::dpois(value, par(k), 0); + } + return rvec; } // ============================================================== @@ -128,16 +134,17 @@ arma::rowvec dpoisson(const double &value, const arma::rowvec &par) // -------------------------------------------------------------- inline -double rgamma (const double& a, const double& b) +double rgamma(const double& a, const double& b) { - Rcpp::RNGScope scope; - double output = R::rgamma(a, 1.0); - output = std::max(output, 1e-10); - output = output / b; - return output; + Rcpp::RNGScope scope; + double output = R::rgamma(a, 1.0); + + output = std::max(output, 1e-10); + output = output / b; + return output; } -/** +/** * -------------------------------------------------------------- * @brief Draws vector random sample for Gamma distribution. * @par par_a arma::vec with shape parameters @@ -150,23 +157,24 @@ double rgamma (const double& a, const double& b) * -------------------------------------------------------------- **/ inline -arma::rowvec rgammaprod (const arma::rowvec& par_a, - const arma::rowvec& par_b) -{ - const unsigned int K = par_a.n_elem; - arma::rowvec par_out(K); - - GetRNGstate(); - - for(unsigned int k = 0; k < K; ++k) { - par_out(k) = R::rgamma(par_a(k), 1.0); - par_out(k) = std::max(par_out(k), 1e-10); - par_out(k) = par_out(k)/par_b(k); - } - - PutRNGstate(); - - return par_out; +arma::rowvec rgammaprod(const arma::rowvec& par_a, + const arma::rowvec& par_b) +{ + const unsigned int K = par_a.n_elem; + arma::rowvec par_out(K); + + GetRNGstate(); + + for (unsigned int k = 0; k < K; ++k) + { + par_out(k) = R::rgamma(par_a(k), 1.0); + par_out(k) = std::max(par_out(k), 1e-10); + par_out(k) = par_out(k) / par_b(k); + } + + PutRNGstate(); + + return par_out; } /** @@ -181,7 +189,7 @@ arma::rowvec rgammaprod (const arma::rowvec& par_a, * @return Armadillo matrix with the log densities for each value * in a row and for each pair of parameters in a column; * M x K - * @detail For each shape and rate parameter pair the log gamma + * @detail For each shape and rate parameter pair the log gamma * density is computed. Inside the function the unsafe * access functions of Armadillo 'at()' and 'unsafe_col()' * are used, so now boundary check is performed. In each @@ -191,45 +199,48 @@ arma::rowvec rgammaprod (const arma::rowvec& par_a, * @author Lars Simon Zehnder * ---------------------------------------------------------------- **/ -inline -arma::mat ldgamma (const arma::mat &values, const arma::vec &shape, - const arma::vec &rate) +inline +arma::mat ldgamma(const arma::mat &values, const arma::vec &shape, + const arma::vec &rate) { - const unsigned int M = values.n_rows; - const unsigned int K = values.n_cols; - arma::mat rvalues(M, K); - for (unsigned int k = 0; k < K; ++k) { - rvalues.unsafe_col(k) = arma::log(values.unsafe_col(k)) * (shape.at(k) - 1); - rvalues.unsafe_col(k) -= values.unsafe_col(k) * rate.at(k); - rvalues.unsafe_col(k) += shape.at(k) * std::log(rate.at(k)); - rvalues.unsafe_col(k) -= R::lgammafn(shape.at(k)); - } - return rvalues; + const unsigned int M = values.n_rows; + const unsigned int K = values.n_cols; + arma::mat rvalues(M, K); + + for (unsigned int k = 0; k < K; ++k) + { + rvalues.unsafe_col(k) = arma::log(values.unsafe_col(k)) * (shape.at(k) - 1); + rvalues.unsafe_col(k) -= values.unsafe_col(k) * rate.at(k); + rvalues.unsafe_col(k) += shape.at(k) * std::log(rate.at(k)); + rvalues.unsafe_col(k) -= R::lgammafn(shape.at(k)); + } + return rvalues; } -inline -double rggamma (const double& shape, const double& rate, - const double& loc) +inline +double rggamma(const double& shape, const double& rate, + const double& loc) { - double par_out = 0.0; - GetRNGstate(); - par_out = R::rgamma(shape, 1); - PutRNGstate(); - par_out = std::max(par_out, 1e-10); - par_out = par_out/rate; - par_out += loc; - - return par_out; + double par_out = 0.0; + + GetRNGstate(); + par_out = R::rgamma(shape, 1); + PutRNGstate(); + par_out = std::max(par_out, 1e-10); + par_out = par_out / rate; + par_out += loc; + + return par_out; } -/** +/** * -------------------------------------------------------------- * @brief Computes a proprotion of the conditional Gamma prior - * in the conditional Poisson model. + * in the conditional Poisson model. * @param x value * @param a shape parameter * @param b rate parameter - * @param m location parameter + * @param m location parameter * @param N number of observations in first component * @param Q mean over observations in first component * @return value @@ -238,12 +249,13 @@ double rggamma (const double& shape, const double& rate, * -------------------------------------------------------------- **/ inline -double cgamm (const double& x, const double& a, const double& b, - const double& m, const double& N, const double& Q) +double cgamm(const double& x, const double& a, const double& b, + const double& m, const double& N, const double& Q) { - double output = std::pow(x, Q*N) * std::pow(x - m, a - 1) - * std::exp(-b * (x - m) - N * x); - return output; + double output = std::pow(x, Q * N) * std::pow(x - m, a - 1) + * std::exp(-b * (x - m) - N * x); + + return output; } // ======================================================= @@ -253,7 +265,7 @@ double cgamm (const double& x, const double& a, const double& b, /** * ------------------------------------------------------- * rbetaprod - * @brief Draws a random vector sample from the Beta + * @brief Draws a random vector sample from the Beta * distribution. * @par par_a shape parameters * @par par_b shape parameters @@ -265,17 +277,19 @@ double cgamm (const double& x, const double& a, const double& b, * ------------------------------------------------------- **/ inline -arma::rowvec rbetaprod (const arma::rowvec& par_a, - const arma::rowvec& par_b) +arma::rowvec rbetaprod(const arma::rowvec& par_a, + const arma::rowvec& par_b) { - const unsigned int K = par_a.n_elem; - arma::rowvec par_out(K); - Rcpp::RNGScope scope; - for (unsigned int k = 0; k < K; ++k) { - par_out(k) = R::rbeta(par_a(k), par_b(k)); - par_out(k) = std::max(par_out(k), 1e-10); - } - return par_out; + const unsigned int K = par_a.n_elem; + arma::rowvec par_out(K); + Rcpp::RNGScope scope; + + for (unsigned int k = 0; k < K; ++k) + { + par_out(k) = R::rbeta(par_a(k), par_b(k)); + par_out(k) = std::max(par_out(k), 1e-10); + } + return par_out; } /** @@ -290,7 +304,7 @@ arma::rowvec rbetaprod (const arma::rowvec& par_a, * @return Armadillo matrix with the log densities for each value * in a row and for each pair of parameters in a column; * M x K - * @detail For each shape1 and shape2 parameter pair the log Beta + * @detail For each shape1 and shape2 parameter pair the log Beta * density is computed. Inside the function the unsafe * access functions of Armadillo 'at()' and 'unsafe_col()' * are used, so now boundary check is performed. In each @@ -301,19 +315,21 @@ arma::rowvec rbetaprod (const arma::rowvec& par_a, * ---------------------------------------------------------------- **/ -inline -arma::mat ldbeta (const arma::mat &values, const arma::vec &shape1, - const arma::vec &shape2) +inline +arma::mat ldbeta(const arma::mat &values, const arma::vec &shape1, + const arma::vec &shape2) { - const unsigned int M = values.n_rows; - const unsigned int K = values.n_cols; - arma::mat rvalues(M, K); - for (unsigned int k = 0; k < K; ++k) { - rvalues.unsafe_col(k) = arma::log(values.unsafe_col(k)) * (shape1.at(k) - 1); - rvalues.unsafe_col(k) += arma::log(values.unsafe_col(k)) * (shape2.at(k) - 1); - rvalues.unsafe_col(k) -= R::lbeta(shape1.at(k), shape2.at(k)); - } - return rvalues; + const unsigned int M = values.n_rows; + const unsigned int K = values.n_cols; + arma::mat rvalues(M, K); + + for (unsigned int k = 0; k < K; ++k) + { + rvalues.unsafe_col(k) = arma::log(values.unsafe_col(k)) * (shape1.at(k) - 1); + rvalues.unsafe_col(k) += arma::log(values.unsafe_col(k)) * (shape2.at(k) - 1); + rvalues.unsafe_col(k) -= R::lbeta(shape1.at(k), shape2.at(k)); + } + return rvalues; } // ================================================================= @@ -328,7 +344,7 @@ arma::mat ldbeta (const arma::mat &values, const arma::vec &shape1, * @param value the density is calculated for * @param T repetitions for the Binomial distribution * @param par parameter vector; 1 x K - * @return vector with density values for the corresponding + * @return vector with density values for the corresponding * parameters in 'par' * @detail Uses inside the 'dpois()' function from Rcpp's 'R' * namespace. @@ -336,16 +352,18 @@ arma::mat ldbeta (const arma::mat &values, const arma::vec &shape1, * @author Lars Simon Zehnder * ------------------------------------------------------------------ **/ -inline -arma::rowvec dbinomial(const double& value, const double& T, - const arma::rowvec& par) +inline +arma::rowvec dbinomial(const double& value, const double& T, + const arma::rowvec& par) { - const unsigned int K = par.n_elem; - arma::rowvec rvec(K); - for (unsigned int k = 0; k < K; ++k) { - rvec(k) = R::dbinom(value, T, par(k), 0); - } - return rvec; + const unsigned int K = par.n_elem; + arma::rowvec rvec(K); + + for (unsigned int k = 0; k < K; ++k) + { + rvec(k) = R::dbinom(value, T, par(k), 0); + } + return rvec; } // ================================================================= @@ -359,7 +377,7 @@ arma::rowvec dbinomial(const double& value, const double& T, * Armadillo parameter vector. * @param value the density is calculated for * @param par parameter vector; 1 x K - * @return vector with density values for the corresponding + * @return vector with density values for the corresponding * parameters in 'par' * @detail Uses inside the 'dexp()' function from Rcpp's 'R' * namespace. @@ -367,126 +385,145 @@ arma::rowvec dbinomial(const double& value, const double& T, * @author Lars Simon Zehnder * ------------------------------------------------------------------ **/ -inline +inline arma::rowvec dexponential(const double& value, const arma::rowvec& par) { - const unsigned int K = par.n_elem; - arma::rowvec rvec(K); - for (unsigned int k = 0; k < K; ++k) { - rvec(k) = R::dexp(value, par(k), 0); - } - return rvec; + const unsigned int K = par.n_elem; + arma::rowvec rvec(K); + + for (unsigned int k = 0; k < K; ++k) + { + rvec(k) = R::dexp(value, par(k), 0); + } + return rvec; } inline -arma::rowvec rnormal (const arma::rowvec& mu, - const arma::rowvec& sigma) +arma::rowvec rnormal(const arma::rowvec& mu, + const arma::rowvec& sigma) { - const unsigned int K = mu.n_elem; - arma::rowvec output(K); - for (unsigned int k = 0; k < K; ++k) { - output(k) = mu(k) + std::sqrt(sigma(k)) * R::rnorm(0.0, 1.0); - } - return output; + const unsigned int K = mu.n_elem; + arma::rowvec output(K); + + for (unsigned int k = 0; k < K; ++k) + { + output(k) = mu(k) + std::sqrt(sigma(k)) * R::rnorm(0.0, 1.0); + } + return output; } -inline -arma::mat rnormult (const arma::mat& mu, - const arma::cube& sigma) +inline +arma::mat rnormult(const arma::mat& mu, + const arma::cube& sigma) { - const unsigned int r = mu.n_rows; - const unsigned int K = mu.n_cols; - arma::mat output(r, K); - for (unsigned int k = 0; k < K; ++k) { - for (unsigned int i = 0; i < r; ++i) { - output(i, k) = R::rnorm(0.0, 1.0); - } - output.col(k) = arma::chol(sigma.slice(k)) * output.col(k); - output.col(k) += mu.col(k); - } - return output; + const unsigned int r = mu.n_rows; + const unsigned int K = mu.n_cols; + arma::mat output(r, K); + + for (unsigned int k = 0; k < K; ++k) + { + for (unsigned int i = 0; i < r; ++i) + { + output(i, k) = R::rnorm(0.0, 1.0); + } + output.col(k) = arma::chol(sigma.slice(k)) * output.col(k); + output.col(k) += mu.col(k); + } + return output; } inline -arma::mat rinvwishart (const double& df, - const arma::mat scale) +arma::mat rinvwishart(const double& df, + const arma::mat scale) { - const unsigned int r = scale.n_rows; - const unsigned int Nu = 2 * df + 1; - arma::mat unityS(r, r); - arma::mat schurS(r, r); - arma::auxlib::schur(unityS, schurS, scale); - arma::colvec diagschurS = arma::diagvec(arma::max(schurS, arma::zeros(r, r))); - arma::mat thSchur = arma::diagmat(arma::pow(diagschurS, 0.5)); - arma::mat unity = unityS * thSchur; - arma::mat Z(Nu, r); - /* Z is filled by rows */ - Rcpp::RNGScope scope; - for (unsigned int nu = 0; nu < Nu; ++nu) { - for (unsigned int rr = 0; rr < r; ++rr) { - Z(nu, rr) = R::rnorm(0.0, 1.0); - } - } - unityS = df * arma::cov(Z); - return unity * arma::inv(unityS) * arma::trans(unity); + const unsigned int r = scale.n_rows; + const unsigned int Nu = 2 * df + 1; + arma::mat unityS(r, r); + arma::mat schurS(r, r); + + arma::auxlib::schur(unityS, schurS, scale); + arma::colvec diagschurS = arma::diagvec(arma::max(schurS, arma::zeros(r, r))); + arma::mat thSchur = arma::diagmat(arma::pow(diagschurS, 0.5)); + arma::mat unity = unityS * thSchur; + arma::mat Z(Nu, r); + /* Z is filled by rows */ + Rcpp::RNGScope scope; + + for (unsigned int nu = 0; nu < Nu; ++nu) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + Z(nu, rr) = R::rnorm(0.0, 1.0); + } + } + unityS = df * arma::cov(Z); + return unity * arma::inv(unityS) * arma::trans(unity); } inline -double logdnormult (const arma::mat& Y, - const arma::mat& mu, const arma::cube& sigma, - const arma::cube& sigmainv) +double logdnormult(const arma::mat& Y, + const arma::mat& mu, const arma::cube& sigma, + const arma::cube& sigmainv) { - const unsigned int r = Y.n_rows; - const unsigned int K = Y.n_cols; - double output = 0.0; - for (unsigned int k = 0; k < K; ++k) { - arma::vec err = Y.col(k) - mu.col(k); - output += 0.5 * arma::as_scalar(arma::trans(err) * sigmainv.slice(k) * err); - output -= 0.5 * std::log(arma::det(sigma.slice(k))); - output -= 0.5 * r * std::log(2 * M_PI); - } - return output; + const unsigned int r = Y.n_rows; + const unsigned int K = Y.n_cols; + double output = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + arma::vec err = Y.col(k) - mu.col(k); + output += 0.5 * arma::as_scalar(arma::trans(err) * sigmainv.slice(k) * err); + output -= 0.5 * std::log(arma::det(sigma.slice(k))); + output -= 0.5 * r * std::log(2 * M_PI); + } + return output; } inline -double logdwishart (const arma::cube& Y, - const arma::rowvec& a, const arma::cube& S, - const arma::rowvec& logdetS) +double logdwishart(const arma::cube& Y, + const arma::rowvec& a, const arma::cube& S, + const arma::rowvec& logdetS) { - const unsigned int r = Y.n_rows; - const unsigned int K = Y.n_slices; - double output = 0.0; - double trQS = 0.0; - for (unsigned int k = 0; k < K; ++k) { - trQS = arma::trace(Y.slice(k) * S.slice(k)); - output += a(k) * logdetS(k) + (a(k) - (r + 1) / 2.0) - * std::log(arma::det(Y.slice(k))) - trQS - - r * (r + 1) / 4.0 * std::log(M_PI); - for (unsigned int rr = 0; rr < r; ++rr) { - output -= R::lgammafn( a(k) + 0.5 - 0.5 * rr); - } - } - return output; + const unsigned int r = Y.n_rows; + const unsigned int K = Y.n_slices; + double output = 0.0; + double trQS = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + trQS = arma::trace(Y.slice(k) * S.slice(k)); + output += a(k) * logdetS(k) + (a(k) - (r + 1) / 2.0) + * std::log(arma::det(Y.slice(k))) - trQS + - r * (r + 1) / 4.0 * std::log(M_PI); + for (unsigned int rr = 0; rr < r; ++rr) + { + output -= R::lgammafn(a(k) + 0.5 - 0.5 * rr); + } + } + return output; } inline -double logdwishart (const arma::cube& Y, - const arma::rowvec& a, const arma::mat& S, - const double logdetS) +double logdwishart(const arma::cube& Y, + const arma::rowvec& a, const arma::mat& S, + const double logdetS) { - const unsigned int r = Y.n_rows; - const unsigned int K = Y.n_slices; - double output = 0.0; - double trQS = 0.0; - for (unsigned int k = 0; k < K; ++k) { - trQS = arma::trace(Y.slice(k) * S); - output += a(k) * logdetS + (a(k) - (r+1) / 2.0) - * std::log(arma::det(Y.slice(k))) - trQS - - r * (r + 1) / 4.0 * std::log(M_PI); - for (unsigned int rr = 0; rr < r; ++rr) { - output -= R::lgammafn( a(k) + 0.5 - 0.5 * rr); - } - } - return output; + const unsigned int r = Y.n_rows; + const unsigned int K = Y.n_slices; + double output = 0.0; + double trQS = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + trQS = arma::trace(Y.slice(k) * S); + output += a(k) * logdetS + (a(k) - (r + 1) / 2.0) + * std::log(arma::det(Y.slice(k))) - trQS + - r * (r + 1) / 4.0 * std::log(M_PI); + for (unsigned int rr = 0; rr < r; ++rr) + { + output -= R::lgammafn(a(k) + 0.5 - 0.5 * rr); + } + } + return output; } #endif // __FINMIX_DISTRIBUTIONS_H__ diff --git a/src/hungarian.h b/src/hungarian.h index cb6db49..f4ac876 100644 --- a/src/hungarian.h +++ b/src/hungarian.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder (Bob Pilgrim). All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder (Bob Pilgrim). All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundation, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_HUNGARIAN_H__ #define __FINMIX_HUNGARIAN_H__ @@ -27,63 +27,63 @@ #include /* FORWARD DECLARATION */ -void step_one (unsigned int &step, arma::mat &cost, - const unsigned int &N); +void step_one(unsigned int &step, arma::mat &cost, + const unsigned int &N); -void step_two (unsigned int &step, const arma::mat &cost, - arma::umat &indM, arma::ivec &rcov, - arma::ivec &ccov, const unsigned int &N); +void step_two(unsigned int &step, const arma::mat &cost, + arma::umat &indM, arma::ivec &rcov, + arma::ivec &ccov, const unsigned int &N); -void step_three (unsigned int &step, const arma::umat &indM, - arma::ivec &ccov, const unsigned int &N); +void step_three(unsigned int &step, const arma::umat &indM, + arma::ivec &ccov, const unsigned int &N); -void step_four (unsigned int &step, const arma::mat &cost, - arma::umat &indM, arma::ivec &rcov, - arma::ivec &ccov, int &rpath_0, int &cpath_0, - const unsigned int &N); +void step_four(unsigned int &step, const arma::mat &cost, + arma::umat &indM, arma::ivec &rcov, + arma::ivec &ccov, int &rpath_0, int &cpath_0, + const unsigned int &N); -void step_five (unsigned int &step, arma::umat &indM, - arma::ivec &rcov, arma::ivec &ccov, - arma::imat &path, int &rpath_0, int &cpath_0, - const unsigned int &N); +void step_five(unsigned int &step, arma::umat &indM, + arma::ivec &rcov, arma::ivec &ccov, + arma::imat &path, int &rpath_0, int &cpath_0, + const unsigned int &N); -void step_six (unsigned int &step, arma::mat &cost, - const arma::ivec &rcov, const arma::ivec &ccov, - const unsigned int &N); +void step_six(unsigned int &step, arma::mat &cost, + const arma::ivec &rcov, const arma::ivec &ccov, + const unsigned int &N); -void find_noncovered_zero (int &row, int &col, - const arma::mat &cost, const arma::ivec &rcov, - const arma::ivec &ccov, const unsigned int &N); +void find_noncovered_zero(int &row, int &col, + const arma::mat &cost, const arma::ivec &rcov, + const arma::ivec &ccov, const unsigned int &N); -bool star_in_row (int &row, const arma::umat &indM, - const unsigned int &N); +bool star_in_row(int &row, const arma::umat &indM, + const unsigned int &N); -void find_star_in_col (const int &col, int &row, - const arma::umat &indM, const unsigned int &N); +void find_star_in_col(const int &col, int &row, + const arma::umat &indM, const unsigned int &N); -void find_star_in_row (const int &row, int &col, - const arma::umat &indM, const unsigned int &N); +void find_star_in_row(const int &row, int &col, + const arma::umat &indM, const unsigned int &N); -void find_prime_in_row (const int &row, int &col, - const arma::umat &indM, const unsigned int &N); +void find_prime_in_row(const int &row, int &col, + const arma::umat &indM, const unsigned int &N); -void augment_path (const unsigned int &path_count, arma::umat &indM, - const arma::imat &path); +void augment_path(const unsigned int &path_count, arma::umat &indM, + const arma::imat &path); -void clear_covers (arma::ivec &rcov, arma::ivec &ccov); +void clear_covers(arma::ivec &rcov, arma::ivec &ccov); -void erase_primes (arma::umat &indM, const unsigned int &N); +void erase_primes(arma::umat &indM, const unsigned int &N); -void find_smallest (double &minval, const arma::mat &cost, - const arma::ivec &rcov, const arma::ivec &ccov, - const unsigned int &N); +void find_smallest(double &minval, const arma::mat &cost, + const arma::ivec &rcov, const arma::ivec &ccov, + const unsigned int &N); /* ALGORITHM */ /** - * Searches for the assignment of rows to columns + * Searches for the assignment of rows to columns * with the minimum cost regarding the cost matrix 'cost'. - * To find a maximal assignment the cost matrix can be + * To find a maximal assignment the cost matrix can be * transformed via DBL_MAX - cost. * @param input_cost constant Armadillo matrix reference. * @see step_one(), step_two(), step_three(), step_four(), @@ -93,46 +93,55 @@ void find_smallest (double &minval, const arma::mat &cost, inline arma::umat hungarian(const arma::mat &input_cost) { - const unsigned int N = input_cost.n_rows; - unsigned int step = 1; - int cpath_0 = 0; - int rpath_0 = 0; - arma::mat cost(input_cost); - arma::umat indM(N, N); - arma::ivec rcov(N); - arma::ivec ccov(N); - arma::imat path(2 * N, 2); - - indM = arma::zeros(N, N); - bool done = false; - while (!done) { - switch (step) { - case 1: - step_one(step, cost, N); - break; - case 2: - step_two(step, cost, indM, rcov, ccov, N); - break; - case 3: - step_three(step, indM, ccov, N); - break; - case 4: - step_four(step, cost, indM, rcov, ccov, - rpath_0, cpath_0, N); - break; - case 5: - step_five(step, indM, rcov, ccov, - path, rpath_0, cpath_0, N); - break; - case 6: - step_six(step, cost, rcov, ccov, N); - break; - case 7: - done = true; - break; - } - } - return indM; + const unsigned int N = input_cost.n_rows; + unsigned int step = 1; + int cpath_0 = 0; + int rpath_0 = 0; + arma::mat cost(input_cost); + arma::umat indM(N, N); + arma::ivec rcov(N); + arma::ivec ccov(N); + arma::imat path(2 * N, 2); + + indM = arma::zeros(N, N); + bool done = false; + + while (!done) + { + switch (step) + { + case 1: + step_one(step, cost, N); + break; + + case 2: + step_two(step, cost, indM, rcov, ccov, N); + break; + + case 3: + step_three(step, indM, ccov, N); + break; + + case 4: + step_four(step, cost, indM, rcov, ccov, + rpath_0, cpath_0, N); + break; + + case 5: + step_five(step, indM, rcov, ccov, + path, rpath_0, cpath_0, N); + break; + + case 6: + step_six(step, cost, rcov, ccov, N); + break; + + case 7: + done = true; + break; + } + } + return indM; } /** @@ -144,17 +153,18 @@ arma::umat hungarian(const arma::mat &input_cost) * @return void * */ inline -void step_one(unsigned int &step, arma::mat &cost, - const unsigned int &N) -{ - for (unsigned int r = 0; r < N; ++r) { - cost.row(r) -= arma::min(cost.row(r)); - } - step = 2; +void step_one(unsigned int &step, arma::mat &cost, + const unsigned int &N) +{ + for (unsigned int r = 0; r < N; ++r) + { + cost.row(r) -= arma::min(cost.row(r)); + } + step = 2; } /** - * Find a zero in the resulting cost matrix of step one. + * Find a zero in the resulting cost matrix of step one. * @param step unsigned integer reference. * @param cost constant Armadillo matrix reference. * @param indM uword Armadillo matrix reference. @@ -165,32 +175,35 @@ void step_one(unsigned int &step, arma::mat &cost, * @return void * */ inline -void step_two (unsigned int &step, const arma::mat &cost, - arma::umat &indM, arma::ivec &rcov, - arma::ivec &ccov, const unsigned int &N) -{ - for (unsigned int r = 0; r < N; ++r) { - for (unsigned int c = 0; c < N; ++c) { - if (cost.at(r, c) == 0.0 && rcov.at(r) == 0 && ccov.at(c) == 0) { - indM.at(r, c) = 1; - rcov.at(r) = 1; - ccov.at(c) = 1; - break; // Only take the first +void step_two(unsigned int &step, const arma::mat &cost, + arma::umat &indM, arma::ivec &rcov, + arma::ivec &ccov, const unsigned int &N) +{ + for (unsigned int r = 0; r < N; ++r) + { + for (unsigned int c = 0; c < N; ++c) + { + if (cost.at(r, c) == 0.0 && rcov.at(r) == 0 && ccov.at(c) == 0) + { + indM.at(r, c) = 1; + rcov.at(r) = 1; + ccov.at(c) = 1; + break; // Only take the first // zero in a row and column - } - } - } - /* for later reuse */ - rcov.fill(0); - ccov.fill(0); - step = 3; + } + } + } + /* for later reuse */ + rcov.fill(0); + ccov.fill(0); + step = 3; } /** * Cover each column containing a starred zero. If N - * columns are covered the starred zeros describe a + * columns are covered the starred zeros describe a * complete set of unqiue assignments. In this case - * go to the last STEP 7 (hungarian()) otherwise go + * go to the last STEP 7 (hungarian()) otherwise go * to STEP 4 (step_four()). * @param step unsigned integer reference. * @param indM constant uword Armadillo matrix reference. @@ -202,35 +215,44 @@ void step_two (unsigned int &step, const arma::mat &cost, * */ inline void step_three(unsigned int &step, const arma::umat &indM, - arma::ivec &ccov, const unsigned int &N) + arma::ivec &ccov, const unsigned int &N) { - unsigned int colcount = 0; - for (unsigned int r = 0; r < N; ++r) { - for (unsigned int c = 0; c < N; ++c) { - if (indM.at(r, c) == 1) { - ccov.at(c) = 1; - } - } - } - for (unsigned int c = 0; c < N; ++c) { - if (ccov.at(c) == 1) { - ++colcount; - } - } - if (colcount == N) { - step = 7; - } else { - step = 4; - } + unsigned int colcount = 0; + + for (unsigned int r = 0; r < N; ++r) + { + for (unsigned int c = 0; c < N; ++c) + { + if (indM.at(r, c) == 1) + { + ccov.at(c) = 1; + } + } + } + for (unsigned int c = 0; c < N; ++c) + { + if (ccov.at(c) == 1) + { + ++colcount; + } + } + if (colcount == N) + { + step = 7; + } + else + { + step = 4; + } } /** * Find a noncovered zero and prime it. If there - * is no starred zero in the row containing this - * primed zero. Go to STEP 5 (step_five()). Otherwise, + * is no starred zero in the row containing this + * primed zero. Go to STEP 5 (step_five()). Otherwise, * cover this row and uncover the column containing the * starred zero. Continue this way until there are - * no uncovered zeros left. Save the smallest + * no uncovered zeros left. Save the smallest * uncovered VALUE (not necessary a zero) and go * to STEP 6 (step_six()). * @param step unsigned integer reference. @@ -241,59 +263,67 @@ void step_three(unsigned int &step, const arma::umat &indM, * @param rpath_0 integer reference. * @param cpath_0 integer reference. * @param N constant unsigned integer reference. - * @see step_five(), step_six(), star_in_row(), + * @see step_five(), step_six(), star_in_row(), * find_star_in_row() * @return void **/ inline -void step_four (unsigned int &step, const arma::mat &cost, - arma::umat &indM, arma::ivec &rcov, arma::ivec &ccov, - int &rpath_0, int &cpath_0, const unsigned int &N) +void step_four(unsigned int &step, const arma::mat &cost, + arma::umat &indM, arma::ivec &rcov, arma::ivec &ccov, + int &rpath_0, int &cpath_0, const unsigned int &N) { - int row = -1; - int col = -1; - bool done = false; - while(!done) { - find_noncovered_zero(row, col, cost, rcov, - ccov, N); - - if (row == -1) { - done = true; - step = 6; - } else { - /* uncovered zero */ - indM(row, col) = 2; - if (star_in_row(row, indM, N)) { - find_star_in_row(row, col, indM, N); - /* Cover the row with the starred zero - * and uncover the column with the starred - * zero. - */ - rcov.at(row) = 1; - ccov.at(col) = 0; - } else { - /* No starred zero in row with - * uncovered zero - */ - done = true; - step = 5; - rpath_0 = row; - cpath_0 = col; - } - } - } + int row = -1; + int col = -1; + bool done = false; + + while (!done) + { + find_noncovered_zero(row, col, cost, rcov, + ccov, N); + + if (row == -1) + { + done = true; + step = 6; + } + else + { + /* uncovered zero */ + indM(row, col) = 2; + if (star_in_row(row, indM, N)) + { + find_star_in_row(row, col, indM, N); + /* Cover the row with the starred zero + * and uncover the column with the starred + * zero. + */ + rcov.at(row) = 1; + ccov.at(col) = 0; + } + else + { + /* No starred zero in row with + * uncovered zero + */ + done = true; + step = 5; + rpath_0 = row; + cpath_0 = col; + } + } + } } /** - * Construct a series of alternating primed and starred - * zeros as follows. Let Z0 represent the uncovered primed + * Construct a series of alternating primed and starred + * zeros as follows. Let Z0 represent the uncovered primed * zero found in Step 4. Let Z1 denote the starred zero in * the column of Z0 (if any). Let Z2 denote the primed zero - * in the row of Z1 (there will always be one, given that - * there is a Z1). Continue until the series terminates - * at a primed zero that has no starred zero in its - * column. Unstar each starred zero of the series, star - * each primed zero of the series, erase all primes and + * in the row of Z1 (there will always be one, given that + * there is a Z1). Continue until the series terminates + * at a primed zero that has no starred zero in its + * column. Unstar each starred zero of the series, star + * each primed zero of the series, erase all primes and * uncover every line in the matrix. Return to STEP 3 * (step_three()). * @param step unsigned integer reference. @@ -308,50 +338,56 @@ void step_four (unsigned int &step, const arma::mat &cost, * @return void * */ inline -void step_five (unsigned int &step, - arma::umat &indM, arma::ivec &rcov, - arma::ivec &ccov, arma::imat &path, - int &rpath_0, int &cpath_0, - const unsigned int &N) +void step_five(unsigned int &step, + arma::umat &indM, arma::ivec &rcov, + arma::ivec &ccov, arma::imat &path, + int &rpath_0, int &cpath_0, + const unsigned int &N) { - bool done = false; - int row = -1; - int col = -1; - unsigned int path_count = 1; - path.at(path_count - 1, 0) = rpath_0; - path.at(path_count - 1, 1) = cpath_0; - while (!done) { - find_star_in_col(path.at(path_count - 1, 1), row, - indM, N); - if (row > -1) { - /* Starred zero in row 'row' */ - ++path_count; - path.at(path_count - 1, 0) = row; - path.at(path_count - 1, 1) = path.at(path_count - 2, 1); - } else { - done = true; - } - if (!done) { - /* If there is a starred zero find a primed - * zero in this row; write index to 'col' */ - find_prime_in_row(path.at(path_count - 1, 0), col, - indM, N); - ++path_count; - path.at(path_count - 1, 0) = path.at(path_count - 2, 0); - path.at(path_count - 1, 1) = col; - } - } - augment_path(path_count, indM, path); - clear_covers(rcov, ccov); - erase_primes(indM, N); - step = 3; + bool done = false; + int row = -1; + int col = -1; + unsigned int path_count = 1; + + path.at(path_count - 1, 0) = rpath_0; + path.at(path_count - 1, 1) = cpath_0; + while (!done) + { + find_star_in_col(path.at(path_count - 1, 1), row, + indM, N); + if (row > -1) + { + /* Starred zero in row 'row' */ + ++path_count; + path.at(path_count - 1, 0) = row; + path.at(path_count - 1, 1) = path.at(path_count - 2, 1); + } + else + { + done = true; + } + if (!done) + { + /* If there is a starred zero find a primed + * zero in this row; write index to 'col' */ + find_prime_in_row(path.at(path_count - 1, 0), col, + indM, N); + ++path_count; + path.at(path_count - 1, 0) = path.at(path_count - 2, 0); + path.at(path_count - 1, 1) = col; + } + } + augment_path(path_count, indM, path); + clear_covers(rcov, ccov); + erase_primes(indM, N); + step = 3; } /** * Adds the VALUE (not necessary zero) found in STEP 4 - * (step_four()) to every element of each covered row, - * and subtracts it from every element of each uncovered - * column. Returns to STEP 4 (step_four()) without + * (step_four()) to every element of each covered row, + * and subtracts it from every element of each uncovered + * column. Returns to STEP 4 (step_four()) without * altering any starred or primed zeros nor covered lines. * @param step unsigned integer reference. * @param cost Armadillo matrix reference. @@ -362,23 +398,28 @@ void step_five (unsigned int &step, * @return void * */ inline -void step_six (unsigned int &step, arma::mat &cost, - const arma::ivec &rcov, const arma::ivec &ccov, - const unsigned int &N) +void step_six(unsigned int &step, arma::mat &cost, + const arma::ivec &rcov, const arma::ivec &ccov, + const unsigned int &N) { - double minval = DBL_MAX; - find_smallest(minval, cost, rcov, ccov, N); - for (unsigned int r = 0; r < N; ++r) { - for (unsigned int c = 0; c < N; ++c) { - if (rcov.at(r) == 1) { - cost.at(r, c) += minval; - } - if (ccov.at(c) == 0) { - cost.at(r, c) -= minval; - } - } - } - step = 4; + double minval = DBL_MAX; + + find_smallest(minval, cost, rcov, ccov, N); + for (unsigned int r = 0; r < N; ++r) + { + for (unsigned int c = 0; c < N; ++c) + { + if (rcov.at(r) == 1) + { + cost.at(r, c) += minval; + } + if (ccov.at(c) == 0) + { + cost.at(r, c) -= minval; + } + } + } + step = 4; } /* Helper functions */ @@ -387,7 +428,7 @@ void step_six (unsigned int &step, arma::mat &cost, * Finds noncovered zeros in the cost matrix. * @param row integer reference. * @param col integer reference. - * @param cost constant Armadillo matrix reference. + * @param cost constant Armadillo matrix reference. * @param rcov constant iword Armadillo vector reference. * @param ccov constant iword Armadillo vector reference. * @param N constant unsigned integer reference. @@ -395,61 +436,70 @@ void step_six (unsigned int &step, arma::mat &cost, * @return void */ inline -void find_noncovered_zero (int &row, int &col, - const arma::mat &cost, const arma::ivec &rcov, - const arma::ivec &ccov, const unsigned int &N) +void find_noncovered_zero(int &row, int &col, + const arma::mat &cost, const arma::ivec &rcov, + const arma::ivec &ccov, const unsigned int &N) { - unsigned int r = 0; - unsigned int c; - bool done = false; - row = -1; - col = -1; - while (!done) { - c = 0; - while (true) { - if (cost.at(r, c) == 0.0 && rcov.at(r) == 0 && ccov.at(c) == 0) { - row = r; - col = c; - done = true; - } - ++c; - if (c == N || done) { - break; - } - } - ++r; - if (r == N) { + unsigned int r = 0; + unsigned int c; + bool done = false; + + row = -1; + col = -1; + while (!done) + { + c = 0; + while (true) + { + if (cost.at(r, c) == 0.0 && rcov.at(r) == 0 && ccov.at(c) == 0) + { + row = r; + col = c; done = true; - } - } + } + ++c; + if (c == N || done) + { + break; + } + } + ++r; + if (r == N) + { + done = true; + } + } } /** - * Indicates if a starred zero is contained in a certain + * Indicates if a starred zero is contained in a certain * row of the cost matrix searching the indicator matrix. * @param row integer reference. * @param indM constant uword Armadillo matrix reference. * @param N constant unsigned integer reference. * @see step_four() - * @return A bool indicating if there is. + * @return A bool indicating if there is. * */ inline bool star_in_row(int &row, const arma::umat &indM, - const unsigned int &N) + const unsigned int &N) { - bool tmp = false; - for (unsigned int c = 0; c < N; ++c) { - if (indM.at(row, c) == 1) { - tmp = true; - break; - } - } - return tmp; + bool tmp = false; + + for (unsigned int c = 0; c < N; ++c) + { + if (indM.at(row, c) == 1) + { + tmp = true; + break; + } + } + return tmp; } /** - * Finds a starred zero in a certain column of the cost - * matrix by searching the indicator matrix and writing + * Finds a starred zero in a certain column of the cost + * matrix by searching the indicator matrix and writing * to the references 'row'. * @param col constant integer reference. * @param row integer reference. @@ -459,20 +509,22 @@ bool star_in_row(int &row, const arma::umat &indM, * @return void * */ inline -void find_star_in_col (const int &col, int &row, - const arma::umat &indM, const unsigned int &N) +void find_star_in_col(const int &col, int &row, + const arma::umat &indM, const unsigned int &N) { - row = -1; - for (unsigned int r = 0; r < N; ++r) { - if (indM.at(r, col) == 1) { - row = r; - } - } + row = -1; + for (unsigned int r = 0; r < N; ++r) + { + if (indM.at(r, col) == 1) + { + row = r; + } + } } /** - * Finds a starred zero in a certain row of the cost - * matrix by searching the indicator matrix and writing + * Finds a starred zero in a certain row of the cost + * matrix by searching the indicator matrix and writing * to the references 'col'. * @param row constant integer reference. * @param col integer reference. @@ -482,19 +534,21 @@ void find_star_in_col (const int &col, int &row, * @return void * */ inline -void find_star_in_row (const int &row, int &col, - const arma::umat &indM, const unsigned int &N) +void find_star_in_row(const int &row, int &col, + const arma::umat &indM, const unsigned int &N) { - col = -1; - for (unsigned int c = 0; c < N; ++c) { - if (indM.at(row, c) == 1) { - col = c; - } - } + col = -1; + for (unsigned int c = 0; c < N; ++c) + { + if (indM.at(row, c) == 1) + { + col = c; + } + } } /** - * Finds a primed zero in a certain row of the cost + * Finds a primed zero in a certain row of the cost * matrix by searching the indicator matrix. Writes * result to the argument 'col'. * @param row constant integer reference. @@ -505,18 +559,20 @@ void find_star_in_row (const int &row, int &col, * @return void * */ inline -void find_prime_in_row (const int &row, int &col, - const arma::umat &indM, const unsigned int &N) +void find_prime_in_row(const int &row, int &col, + const arma::umat &indM, const unsigned int &N) { - for (unsigned int c = 0; c < N; ++c) { - if (indM.at(row, c) == 2) { - col = c; - } - } + for (unsigned int c = 0; c < N; ++c) + { + if (indM.at(row, c) == 2) + { + col = c; + } + } } /** - * Augments the path through the cost matrix starting at + * Augments the path through the cost matrix starting at * a primed zero (found in step_four()) and ends at a * primed zero (see bipartite graph theory). * @param path_count constant integer reference. @@ -526,16 +582,20 @@ void find_prime_in_row (const int &row, int &col, * @return void * */ inline -void augment_path (const unsigned int &path_count, arma::umat &indM, - const arma::imat &path) +void augment_path(const unsigned int &path_count, arma::umat &indM, + const arma::imat &path) { - for (unsigned int p = 0; p < path_count; ++p) { - if (indM.at(path(p, 0), path(p, 1)) == 1) { - indM.at(path(p, 0), path(p, 1)) = 0; - } else { - indM.at(path(p, 0), path(p, 1)) = 1; - } - } + for (unsigned int p = 0; p < path_count; ++p) + { + if (indM.at(path(p, 0), path(p, 1)) == 1) + { + indM.at(path(p, 0), path(p, 1)) = 0; + } + else + { + indM.at(path(p, 0), path(p, 1)) = 1; + } + } } /** @@ -546,10 +606,10 @@ void augment_path (const unsigned int &path_count, arma::umat &indM, * @return void * */ inline -void clear_covers (arma::ivec &rcov, arma::ivec &ccov) +void clear_covers(arma::ivec &rcov, arma::ivec &ccov) { - rcov.fill(0); - ccov.fill(0); + rcov.fill(0); + ccov.fill(0); } /** @@ -563,18 +623,21 @@ void clear_covers (arma::ivec &rcov, arma::ivec &ccov) inline void erase_primes(arma::umat &indM, const unsigned int &N) { - for (unsigned int r = 0; r < N; ++r) { - for (unsigned int c = 0; c < N; ++c) { - if (indM.at(r, c) == 2) { - indM.at(r, c) = 0; - } - } - } + for (unsigned int r = 0; r < N; ++r) + { + for (unsigned int c = 0; c < N; ++c) + { + if (indM.at(r, c) == 2) + { + indM.at(r, c) = 0; + } + } + } } /** - * Finds smallest value in the cost matrix over all - * uncovered columns and rows and writes it to + * Finds smallest value in the cost matrix over all + * uncovered columns and rows and writes it to * 'minval' * @param minval double reference. * @param cost constant Armadillo matrix reference. @@ -585,19 +648,23 @@ void erase_primes(arma::umat &indM, const unsigned int &N) * @return void * */ inline -void find_smallest (double &minval, const arma::mat &cost, - const arma::ivec &rcov, const arma::ivec &ccov, - const unsigned int &N) +void find_smallest(double &minval, const arma::mat &cost, + const arma::ivec &rcov, const arma::ivec &ccov, + const unsigned int &N) { - for (unsigned int r = 0; r < N; ++r) { - for (unsigned int c = 0; c < N; ++c) { - if (rcov.at(r) == 0 && ccov.at(c) == 0) { - if (minval > cost.at(r, c)) { - minval = cost.at(r, c); - } + for (unsigned int r = 0; r < N; ++r) + { + for (unsigned int c = 0; c < N; ++c) + { + if (rcov.at(r) == 0 && ccov.at(c) == 0) + { + if (minval > cost.at(r, c)) + { + minval = cost.at(r, c); } - } - } + } + } + } } #endif /* __FINMIX_HUNGARIAN_H__ */ diff --git a/src/likelihood.h b/src/likelihood.h index ccf8418..eb267e8 100644 --- a/src/likelihood.h +++ b/src/likelihood.h @@ -1,52 +1,54 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef LIKELIHOOD_H #define LIKELIHOOD_H #define _USE_MATH_DEFINES #include -#include -#include // C++ Standard Library algorithms (math functions) -#include // to interface with R -#include // for using internal R C-functions +#include +#include // C++ Standard Library algorithms (math functions) +#include // to interface with R +#include // for using internal R C-functions /** * ----------------------------------------------------------- * liklist - * @brief Structure to hold the return values from the - * likelihood computations. + * @brief Structure to hold the return values from the + * likelihood computations. * @author Lars Simon Zehnder * ----------------------------------------------------------- **/ -struct liklist { - - const arma::mat lh; - const arma::vec maxl; - const arma::mat llh; - /* ctor */ - liklist(const arma::mat &lh, const arma::vec &maxl, - const arma::mat &llh) : lh(lh), maxl(maxl), llh(llh) {} +struct liklist +{ + const arma::mat lh; + const arma::vec maxl; + const arma::mat llh; + /* ctor */ + liklist(const arma::mat &lh, const arma::vec &maxl, + const arma::mat &llh) : lh(lh), maxl(maxl), llh(llh) + { + } }; // =========================================================== @@ -56,135 +58,153 @@ struct liklist { /** * ----------------------------------------------------------- * likelihood_poisson - * @brief Computes likelihood for a Poisson model with + * @brief Computes likelihood for a Poisson model with * exposures. * @par Y data values, N x 1 * @par lambda parameter vector, 1 x K * @return liklist struct with likelihood values * @details the likelihood is computed as well as the log- - * likelihood and the maximum of the likelihood + * likelihood and the maximum of the likelihood * over components. * @see liklist * @author Lars Simon Zehnder * ----------------------------------------------------------- **/ -inline liklist -likelihood_poisson(const arma::mat &Y, arma::rowvec lambda) { - - /* lambda is a row vector */ - const unsigned int N = Y.n_rows; - const unsigned int K = lambda.n_elem; - arma::vec lgammaY(N); - arma::mat loglik(N, K); - arma::mat lh(N, K); - - for(unsigned int k = 0; k < K; ++k) { - lambda(k) = std::max(lambda(k), 1e-4); - } - for(unsigned int i = 0; i < N; ++i) { - lgammaY(i) = R::lgammafn(Y(i, 0) + 1.0); - } - arma::mat lgY = arma::repmat(lgammaY, 1, K); - arma::mat repY = arma::repmat(Y, 1, K); - arma::rowvec llambda = arma::log(lambda); - for(unsigned int i = 0; i < N; ++i) { - loglik.row(i) = repY.row(i) % llambda; - } - loglik.each_row() -= lambda; - loglik.each_col() -= lgammaY; - - arma::vec maxl = arma::max(loglik, 1); - for(unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - - liklist l_list(lh, maxl, loglik); - - return l_list; +inline liklist +likelihood_poisson(const arma::mat &Y, arma::rowvec lambda) +{ + /* lambda is a row vector */ + const unsigned int N = Y.n_rows; + const unsigned int K = lambda.n_elem; + arma::vec lgammaY(N); + arma::mat loglik(N, K); + arma::mat lh(N, K); + + for (unsigned int k = 0; k < K; ++k) + { + lambda(k) = std::max(lambda(k), 1e-4); + } + for (unsigned int i = 0; i < N; ++i) + { + lgammaY(i) = R::lgammafn(Y(i, 0) + 1.0); + } + arma::mat lgY = arma::repmat(lgammaY, 1, K); + arma::mat repY = arma::repmat(Y, 1, K); + arma::rowvec llambda = arma::log(lambda); + + for (unsigned int i = 0; i < N; ++i) + { + loglik.row(i) = repY.row(i) % llambda; + } + loglik.each_row() -= lambda; + loglik.each_col() -= lgammaY; + + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + + liklist l_list(lh, maxl, loglik); + + return l_list; } /** * ----------------------------------------------------------- * likelihood_poisson - * @brief Computes likelihood for a Poisson model with + * @brief Computes likelihood for a Poisson model with * exposures. - * @note this is the default function called + * @note this is the default function called * @par Y data values, N x 1 * @par lambda parameter matrix, N x K * @return liklist struct with likelihood values * @details the likelihood is computed as well as the log- - * likelihood and the maximum of the likelihood + * likelihood and the maximum of the likelihood * over components. * @see liklist * @author Lars Simon Zehnder * ----------------------------------------------------------- **/ -inline liklist -likelihood_poisson (const arma::mat &Y, arma::mat lambda) +inline liklist +likelihood_poisson(const arma::mat &Y, arma::mat lambda) { - /* lambda is a matrix (exposures in data object) */ - const unsigned int N = Y.n_rows; - const unsigned int K = lambda.n_cols; - arma::vec lgammaY(N); - arma::mat loglik(N, K); - arma::mat lh(N, K); - //TODO: Check if using umat with lambda < 1e-04 is faster - for(unsigned int i = 0; i < N; ++i) { - for(unsigned int k = 0; k < K; ++k) { - lambda(i, k) = std::max(lambda(i, k), 1e-4); - } - lgammaY(i) = R::lgammafn(Y(i, 0) + 1.0); - } - arma::mat lgY = arma::repmat(lgammaY, 1, K); - arma::mat repY = arma::repmat(Y, 1, K); - arma::mat llambda = arma::log(lambda); - loglik = repY % llambda; - loglik -= lambda; - loglik.each_col() -= lgammaY; - arma::vec maxl = arma::max(loglik, 1); - for(unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - liklist l_list(lh, maxl, loglik); - return l_list; + /* lambda is a matrix (exposures in data object) */ + const unsigned int N = Y.n_rows; + const unsigned int K = lambda.n_cols; + arma::vec lgammaY(N); + arma::mat loglik(N, K); + arma::mat lh(N, K); + + //TODO: Check if using umat with lambda < 1e-04 is faster + for (unsigned int i = 0; i < N; ++i) + { + for (unsigned int k = 0; k < K; ++k) + { + lambda(i, k) = std::max(lambda(i, k), 1e-4); + } + lgammaY(i) = R::lgammafn(Y(i, 0) + 1.0); + } + arma::mat lgY = arma::repmat(lgammaY, 1, K); + arma::mat repY = arma::repmat(Y, 1, K); + arma::mat llambda = arma::log(lambda); + + loglik = repY % llambda; + loglik -= lambda; + loglik.each_col() -= lgammaY; + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + liklist l_list(lh, maxl, loglik); + + return l_list; } -inline double -likelihood_gamma (const arma::rowvec& Y, const double& shape, - const double& rate) +inline double +likelihood_gamma(const arma::rowvec& Y, const double& shape, + const double& rate) { - const unsigned int N = Y.n_elem; - double lik = 0.0; - for(unsigned int i = 0; i < N; ++i) { - lik += shape * std::log(rate) - R::lgammafn(shape) - - rate * Y(i) + (shape - 1) * std::log(Y(i)); - } - return lik; + const unsigned int N = Y.n_elem; + double lik = 0.0; + + for (unsigned int i = 0; i < N; ++i) + { + lik += shape * std::log(rate) - R::lgammafn(shape) + - rate * Y(i) + (shape - 1) * std::log(Y(i)); + } + return lik; } -inline double -likelihood_ggamma(const arma::rowvec& lambda, - const arma::rowvec& shape, const double& rate, - const arma::rowvec& loc) +inline double +likelihood_ggamma(const arma::rowvec& lambda, + const arma::rowvec& shape, const double& rate, + const arma::rowvec& loc) { - const unsigned int K = lambda.n_elem; - double lik = 0.0; - for(unsigned int k = 0; k < K; ++k) { - lik += shape(k) * std::log(rate) - R::lgammafn(shape(k)) - - rate * (lambda(k) - loc(k)) - + (shape(k) - 1) * std::log(lambda(k) - loc(k)); - } - return lik; + const unsigned int K = lambda.n_elem; + double lik = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + lik += shape(k) * std::log(rate) - R::lgammafn(shape(k)) + - rate * (lambda(k) - loc(k)) + + (shape(k) - 1) * std::log(lambda(k) - loc(k)); + } + return lik; } -inline double -likelihood_cgamma (const double lambda, const double& a, - const double& b, const double& m) +inline double +likelihood_cgamma(const double lambda, const double& a, + const double& b, const double& m) { - double output = a * std::log(b) + (a - 1) - * std::log(lambda - m) - b * (lambda - m) - - R::lgammafn(a); - return output; + double output = a * std::log(b) + (a - 1) + * std::log(lambda - m) - b * (lambda - m) + - R::lgammafn(a); + + return output; } // =========================================================== @@ -194,15 +214,15 @@ likelihood_cgamma (const double lambda, const double& a, /** * ----------------------------------------------------------- * likelihood_binomial - * @brief Computes likelihood for a Binomial model with + * @brief Computes likelihood for a Binomial model with * exposures. - * @note this is the default function called + * @note this is the default function called * @par Y data values, N x 1 * @par lambda parameter matrix, N x K * @par T repetitions, N x 1 * @return liklist struct with likelihood values * @details the likelihood is computed as well as the log- - * likelihood and the maximum of the likelihood + * likelihood and the maximum of the likelihood * over components. * @see liklist * @author Lars Simon Zehnder @@ -210,38 +230,45 @@ likelihood_cgamma (const double lambda, const double& a, **/ inline -liklist likelihood_binomial (const arma::mat& Y, - const arma::rowvec p, - const arma::vec& T) +liklist likelihood_binomial(const arma::mat& Y, + const arma::rowvec p, + const arma::vec& T) { - const unsigned int N = Y.n_rows; + const unsigned int N = Y.n_rows; const unsigned int K = p.n_elem; - arma::vec lgammaY(N); - arma::vec lgammaT(N); - arma::vec lgammaTY(N); - arma::mat loglik(N, K); - arma::mat lh(N, K); - for (unsigned int i = 0; i < N; ++i) { - lgammaY(i) = R::lgammafn(Y(i, 0) + 1.0); - lgammaT(i) = R::lgammafn(T(i) + 1.0); - lgammaTY(i) = R::lgammafn(T(i) - Y(i, 0) + 1.0); - } - arma::mat repY = arma::repmat(Y, 1, K); - arma::mat repTY = arma::repmat(T - Y, 1, K); - arma::mat lgY = arma::repmat(lgammaY, 1, K); - arma::mat lgT = arma::repmat(lgammaT, 1, K); - arma::mat lgTY = arma::repmat(lgammaTY, 1, K); - for (unsigned int i = 0; i < N; ++i) { - loglik.row(i) = repY.row(i) % p + repTY.row(i) % arma::log(1.0 - p); + arma::vec lgammaY(N); + arma::vec lgammaT(N); + arma::vec lgammaTY(N); + arma::mat loglik(N, K); + arma::mat lh(N, K); + + for (unsigned int i = 0; i < N; ++i) + { + lgammaY(i) = R::lgammafn(Y(i, 0) + 1.0); + lgammaT(i) = R::lgammafn(T(i) + 1.0); + lgammaTY(i) = R::lgammafn(T(i) - Y(i, 0) + 1.0); + } + arma::mat repY = arma::repmat(Y, 1, K); + arma::mat repTY = arma::repmat(T - Y, 1, K); + arma::mat lgY = arma::repmat(lgammaY, 1, K); + arma::mat lgT = arma::repmat(lgammaT, 1, K); + arma::mat lgTY = arma::repmat(lgammaTY, 1, K); + + for (unsigned int i = 0; i < N; ++i) + { + loglik.row(i) = repY.row(i) % p + repTY.row(i) % arma::log(1.0 - p); } loglik.each_col() += lgammaT; loglik.each_col() -= lgammaTY; loglik.each_col() -= lgammaY; arma::vec maxl = arma::max(loglik, 1); - for (unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); } liklist l_list(lh, maxl, loglik); + return l_list; } @@ -252,143 +279,167 @@ liklist likelihood_binomial (const arma::mat& Y, /** * ----------------------------------------------------------- * likelihood_exponential - * @brief Computes likelihood for a Exponential model with + * @brief Computes likelihood for a Exponential model with * exposures. - * @note this is the default function called + * @note this is the default function called * @par Y data values, N x 1 * @par lambda parameter matrix, N x K * @par T repetitions, N x 1 * @return liklist struct with likelihood values * @details the likelihood is computed as well as the log- - * likelihood and the maximum of the likelihood + * likelihood and the maximum of the likelihood * over components. * @see liklist * @author Lars Simon Zehnder * ----------------------------------------------------------- **/ inline -liklist likelihood_exponential (const arma::mat& Y, - arma::rowvec lambda) +liklist likelihood_exponential(const arma::mat& Y, + arma::rowvec lambda) { - const unsigned int N = Y.n_rows; - const unsigned int K = lambda.n_elem; - arma::mat loglik = arma::ones(N, K); - arma::mat repY = arma::repmat(Y, 1, K); - arma::mat lh(N, K); - - for (unsigned int k = 0; k < K; ++k) { - lambda(k) = std::max(lambda(k), 1e-4); - } - loglik.each_row() %= arma::log(lambda); - for (unsigned int i = 0; i < N; ++i) { - loglik.row(i) -= repY.row(i) % lambda; - } - arma::vec maxl = arma::max(loglik, 1); - for (unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - liklist l_list(lh, maxl, loglik); - return l_list; + const unsigned int N = Y.n_rows; + const unsigned int K = lambda.n_elem; + arma::mat loglik = arma::ones(N, K); + arma::mat repY = arma::repmat(Y, 1, K); + arma::mat lh(N, K); + + for (unsigned int k = 0; k < K; ++k) + { + lambda(k) = std::max(lambda(k), 1e-4); + } + loglik.each_row() %= arma::log(lambda); + for (unsigned int i = 0; i < N; ++i) + { + loglik.row(i) -= repY.row(i) % lambda; + } + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + liklist l_list(lh, maxl, loglik); + + return l_list; } inline -liklist likelihood_normal (const arma::mat& y, - const arma::rowvec mu, const arma::rowvec& sigma) +liklist likelihood_normal(const arma::mat& y, + const arma::rowvec mu, const arma::rowvec& sigma) { - const unsigned int N = y.n_rows; - const unsigned int K = mu.n_elem; - arma::mat loglik(N, K); - arma::mat lh(N, K); - for (unsigned int k = 0; k < K; ++k) { - loglik.col(k) = arma::pow(y - mu(k), 2.0) / sigma(k); - loglik.col(k) += std::log(sigma(k)); - loglik.col(k) += std::log(2.0 * M_PI); - loglik.col(k) *= -0.5; - } - arma::vec maxl = arma::max(loglik, 1); - for (unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - liklist l_list(lh, maxl, loglik); - return l_list; + const unsigned int N = y.n_rows; + const unsigned int K = mu.n_elem; + arma::mat loglik(N, K); + arma::mat lh(N, K); + + for (unsigned int k = 0; k < K; ++k) + { + loglik.col(k) = arma::pow(y - mu(k), 2.0) / sigma(k); + loglik.col(k) += std::log(sigma(k)); + loglik.col(k) += std::log(2.0 * M_PI); + loglik.col(k) *= -0.5; + } + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + liklist l_list(lh, maxl, loglik); + + return l_list; } inline -liklist likelihood_normult (const arma::mat& y, - const arma::mat& mu, const arma::cube& sigma) +liklist likelihood_normult(const arma::mat& y, + const arma::mat& mu, const arma::cube& sigma) { - const unsigned int K = mu.n_cols; - const unsigned int r = mu.n_rows; - const unsigned int N = y.n_rows; - arma::mat loglik(N, K); - arma::mat lh(N, K); - double llh1 = -0.5 * r * std::log(2 * M_PI); - loglik.fill(llh1); - for( unsigned int k = 0; k < K; ++k) { - arma::mat Qinv = arma::inv(sigma.slice(k)); - arma::mat eps = y; - eps.each_row() -= arma::trans(mu.col(k)); - loglik.col(k) += 0.5 * arma::det(Qinv); - loglik.col(k) -= 0.5 * arma::sum((eps * Qinv) % eps, 1); - } - arma::vec maxl = arma::max(loglik, 1); - for (unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - liklist l_list(lh, maxl, loglik); - return l_list; + const unsigned int K = mu.n_cols; + const unsigned int r = mu.n_rows; + const unsigned int N = y.n_rows; + arma::mat loglik(N, K); + arma::mat lh(N, K); + double llh1 = -0.5 * r * std::log(2 * M_PI); + + loglik.fill(llh1); + for (unsigned int k = 0; k < K; ++k) + { + arma::mat Qinv = arma::inv(sigma.slice(k)); + arma::mat eps = y; + eps.each_row() -= arma::trans(mu.col(k)); + loglik.col(k) += 0.5 * arma::det(Qinv); + loglik.col(k) -= 0.5 * arma::sum((eps * Qinv) % eps, 1); + } + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + liklist l_list(lh, maxl, loglik); + + return l_list; } inline -liklist likelihood_student (const arma::mat& y, - const arma::rowvec& mu, const arma::rowvec& sigma, - const arma::rowvec& df) +liklist likelihood_student(const arma::mat& y, + const arma::rowvec& mu, const arma::rowvec& sigma, + const arma::rowvec& df) { - const unsigned int N = y.n_rows; - const unsigned int K = mu.n_elem; - arma::mat loglik(N, K); - arma::mat lh(N, K); - arma::vec err(N); - for (unsigned int k = 0; k < K; ++k) { - err = arma::pow(y - mu(k), 2.0) / sigma(k); - loglik.col(k) = -(df(k) + 1.0) / 2.0 * arma::log(1.0 + err / df(k)); - loglik.col(k) += R::lgammafn((df(k) + 1.0) / 2.0) - - R::lgammafn(df(k) / 2.0); - loglik.col(k) -= 0.5 * (std::log(df(k) * M_PI) + std::log(sigma(k))); - } - arma::vec maxl = arma::max(loglik, 1); - for (unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - liklist l_list(lh, maxl, loglik); - return l_list; + const unsigned int N = y.n_rows; + const unsigned int K = mu.n_elem; + arma::mat loglik(N, K); + arma::mat lh(N, K); + arma::vec err(N); + + for (unsigned int k = 0; k < K; ++k) + { + err = arma::pow(y - mu(k), 2.0) / sigma(k); + loglik.col(k) = -(df(k) + 1.0) / 2.0 * arma::log(1.0 + err / df(k)); + loglik.col(k) += R::lgammafn((df(k) + 1.0) / 2.0) + - R::lgammafn(df(k) / 2.0); + loglik.col(k) -= 0.5 * (std::log(df(k) * M_PI) + std::log(sigma(k))); + } + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + liklist l_list(lh, maxl, loglik); + + return l_list; } inline -liklist likelihood_studmult (const arma::mat& y, - const arma::mat& mu, const arma::cube& sigmainv, - const arma::rowvec& df) +liklist likelihood_studmult(const arma::mat& y, + const arma::mat& mu, const arma::cube& sigmainv, + const arma::rowvec& df) { - const unsigned int K = mu.n_cols; - const unsigned int r = mu.n_rows; - const unsigned int N = y.n_rows; - arma::mat loglik(N, K); - arma::mat lh(N, K); - for (unsigned int k = 0; k < K; ++k) { - arma::mat eps = y; - eps.each_row() -= arma::trans(mu.col(k)); - arma::mat err = arma::sum((eps * sigmainv.slice(k)) % eps, 1); - arma::mat tmp = eps * sigmainv.slice(k); - loglik.col(k) = R::lgammafn((df(k) + r) / 2) - R::lgammafn(df(k) / 2) - + 0.5 * std::log(arma::det(sigmainv.slice(k))) - 0.5 * r * std::log(df(k) * M_PI) - - (df(k) + r) / 2 * arma::log(1.0 + err / df(k)); - - } - arma::vec maxl = arma::max(loglik, 1); - for (unsigned int k = 0; k < K; ++k) { - lh.col(k) = arma::exp(loglik.col(k) - maxl); - } - liklist l_list(lh, maxl, loglik); - return l_list; + const unsigned int K = mu.n_cols; + const unsigned int r = mu.n_rows; + const unsigned int N = y.n_rows; + arma::mat loglik(N, K); + arma::mat lh(N, K); + + for (unsigned int k = 0; k < K; ++k) + { + arma::mat eps = y; + eps.each_row() -= arma::trans(mu.col(k)); + arma::mat err = arma::sum((eps * sigmainv.slice(k)) % eps, 1); + arma::mat tmp = eps * sigmainv.slice(k); + loglik.col(k) = R::lgammafn((df(k) + r) / 2) - R::lgammafn(df(k) / 2) + + 0.5 * std::log(arma::det(sigmainv.slice(k))) - 0.5 * r * std::log(df(k) * M_PI) + - (df(k) + r) / 2 * arma::log(1.0 + err / df(k)); + } + arma::vec maxl = arma::max(loglik, 1); + + for (unsigned int k = 0; k < K; ++k) + { + lh.col(k) = arma::exp(loglik.col(k) - maxl); + } + liklist l_list(lh, maxl, loglik); + + return l_list; } #endif diff --git a/src/mcmc_binomial.cpp b/src/mcmc_binomial.cpp index 18fa16f..fc38e12 100644 --- a/src/mcmc_binomial.cpp +++ b/src/mcmc_binomial.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #include "FinmixData.h" #include "FinmixModel.h" #include "FinmixPrior.h" @@ -38,54 +38,65 @@ RcppExport SEXP mcmc_binomial_cc(SEXP fdata_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - /* Convert S4-classes to C++-classes */ - Rcpp::S4 fdataS4(fdata_S4); - Rcpp::S4 modelS4(model_S4); - Rcpp::S4 priorS4(prior_S4); - Rcpp::S4 mcmcS4(mcmc_S4); - Rcpp::S4 mcmcoutputS4(mcmcoutput_S4); - FinmixData finFdata = FinmixData(fdataS4); - FinmixModel finModel = FinmixModel(modelS4); - FinmixPrior finPrior = FinmixPrior(priorS4); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4); + /* Convert S4-classes to C++-classes */ + Rcpp::S4 fdataS4(fdata_S4); + Rcpp::S4 modelS4(model_S4); + Rcpp::S4 priorS4(prior_S4); + Rcpp::S4 mcmcS4(mcmc_S4); + Rcpp::S4 mcmcoutputS4(mcmcoutput_S4); + FinmixData finFdata = FinmixData(fdataS4); + FinmixModel finModel = FinmixModel(modelS4); + FinmixPrior finPrior = FinmixPrior(priorS4); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4); - const bool INDICFIX = finModel.indicFix; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; + const bool INDICFIX = finModel.indicFix; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; - BASE* ptr; - typedef FIX BINOMIALFIX; - typedef IND > BINOMIALIND; - if (INDICFIX || K == 1) { - if (POST_IND) { - ptr = new ADAPTER > - (finFdata, finModel, finPrior, finMCMC, - mcmcoutputS4); - } else { - ptr = new ADAPTER - (finFdata, finModel, finPrior, finMCMC, - mcmcoutputS4); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finFdata, finModel, finPrior, finMCMC, - mcmcoutputS4); - } else { - ptr = new ADAPTER - (finFdata, finModel, finPrior, finMCMC, - mcmcoutputS4); - } - } - for (unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - return Rcpp::wrap(mcmcoutputS4); + BASE * ptr; + + typedef FIX BINOMIALFIX; + typedef IND > BINOMIALIND; + if (INDICFIX || K == 1) + { + if (POST_IND) + { + ptr = new ADAPTER > + (finFdata, finModel, finPrior, finMCMC, + mcmcoutputS4); + } + else + { + ptr = new ADAPTER + (finFdata, finModel, finPrior, finMCMC, + mcmcoutputS4); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finFdata, finModel, finPrior, finMCMC, + mcmcoutputS4); + } + else + { + ptr = new ADAPTER + (finFdata, finModel, finPrior, finMCMC, + mcmcoutputS4); + } + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + return Rcpp::wrap(mcmcoutputS4); } diff --git a/src/mcmc_condpoisson.cpp b/src/mcmc_condpoisson.cpp index 80f3e73..33da2be 100644 --- a/src/mcmc_condpoisson.cpp +++ b/src/mcmc_condpoisson.cpp @@ -1,29 +1,29 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_MCMCCONDPOISSON_CC_ #define __FINMIX_MCMCCONDPOISSON_CC_ -#include // C++ linear algebra library +#include // C++ linear algebra library #include "FinmixData.h" #include "FinmixModel.h" #include "FinmixPrior.h" @@ -42,59 +42,66 @@ #include "PostOutCondPoissonInd.h" -RcppExport SEXP mcmc_condpoisson_cc(SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_condpoisson_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; - - BASE* ptr; - typedef FIX POISSONFIX; - typedef IND > POISSONIND; - if (INDICFIX || K == 1) - { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - for(unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - - return Rcpp::wrap(mcmcOutputS4O); + const bool INDICFIX = finModel.indicFix; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; + + BASE * ptr; + + typedef FIX POISSONFIX; + typedef IND > POISSONIND; + if (INDICFIX || K == 1) + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + + return Rcpp::wrap(mcmcOutputS4O); } #endif diff --git a/src/mcmc_exponential.cpp b/src/mcmc_exponential.cpp index bb4ce9f..a5de543 100644 --- a/src/mcmc_exponential.cpp +++ b/src/mcmc_exponential.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef _FINMIX_MCMCEXPONENTIAL_CC__ #define _FINMIX_MCMCEXPONENTIAL_CC__ @@ -41,61 +41,67 @@ #include "PostOutExponentialInd.h" -RcppExport SEXP mcmc_exponential_cc(SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_exponential_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; - - BASE* ptr; - typedef FIX EXPONENTIALFIX; - typedef IND > EXPONENTIALIND; - if (INDICFIX || K == 1) - { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - - for(unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - - return Rcpp::wrap(mcmcOutputS4O); + const bool INDICFIX = finModel.indicFix; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; + + BASE * ptr; + + typedef FIX EXPONENTIALFIX; + typedef IND > EXPONENTIALIND; + if (INDICFIX || K == 1) + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + + return Rcpp::wrap(mcmcOutputS4O); } #endif // __FINMIX_MCMCEXPONENTIAL_CC__ diff --git a/src/mcmc_normal.cpp b/src/mcmc_normal.cpp index 83a6b90..74ceacb 100644 --- a/src/mcmc_normal.cpp +++ b/src/mcmc_normal.cpp @@ -20,81 +20,104 @@ #include "LogNormalInd.h" #include "PostOutNormalInd.h" -RcppExport SEXP mcmc_normal_cc (SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_normal_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; + const bool INDICFIX = finModel.indicFix; + const bool HIER_IND = finPrior.hier; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; - BASE *ptr; - typedef FIX NORMALFIX; - typedef IND > NORMALIND; - if (INDICFIX || K == 1) { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutNormalFix> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + BASE *ptr; + + typedef FIX NORMALFIX; + typedef IND > NORMALIND; + if (INDICFIX || K == 1) + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutNormalFix> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + else + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutNormalInd> > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } else { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutNormalInd> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } - for (unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - return Rcpp::wrap(mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + return Rcpp::wrap(mcmcOutputS4O); } #endif diff --git a/src/mcmc_normult.cpp b/src/mcmc_normult.cpp index 0f43c86..7f05e32 100644 --- a/src/mcmc_normult.cpp +++ b/src/mcmc_normult.cpp @@ -20,81 +20,104 @@ #include "LogNormultInd.h" #include "PostOutNormultInd.h" -RcppExport SEXP mcmc_normult_cc (SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_normult_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; + const bool INDICFIX = finModel.indicFix; + const bool HIER_IND = finPrior.hier; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; - BASE *ptr; - typedef FIX NORMULTFIX; - typedef IND > NORMULTIND; - if (INDICFIX || K == 1) { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutNormultFix> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + BASE *ptr; + + typedef FIX NORMULTFIX; + typedef IND > NORMULTIND; + if (INDICFIX || K == 1) + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutNormultFix> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + else + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutNormultInd> > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } else { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutNormultInd> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } - for (unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - return Rcpp::wrap(mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + return Rcpp::wrap(mcmcOutputS4O); } #endif //__FINMIX_MCMC_BINOMIAL_CC__ diff --git a/src/mcmc_poisson.cpp b/src/mcmc_poisson.cpp index 183fe64..c25744f 100644 --- a/src/mcmc_poisson.cpp +++ b/src/mcmc_poisson.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ //#include // C++ linear algebra library #include "FinmixData.h" #include "FinmixModel.h" @@ -40,91 +40,104 @@ #include "PostOutPoissonInd.h" -RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; - - BASE* ptr; - typedef FIX POISSONFIX; - typedef IND > POISSONIND; - if (INDICFIX || K == 1) - { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutPoissonFix> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - - } - else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - } - else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + + const bool INDICFIX = finModel.indicFix; + const bool HIER_IND = finPrior.hier; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; + + BASE * ptr; + + typedef FIX POISSONFIX; + typedef IND > POISSONIND; + if (INDICFIX || K == 1) + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutPoissonFix> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } } - } - } - else { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutPoissonInd> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } } - else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } - } - else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); + } + else + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutPoissonInd> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } } - else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } } - } - } - for(unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - - return Rcpp::wrap(mcmcOutputS4O); + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + + return Rcpp::wrap(mcmcOutputS4O); } \ No newline at end of file diff --git a/src/mcmc_student.cpp b/src/mcmc_student.cpp index 480e4c9..a2f15cb 100644 --- a/src/mcmc_student.cpp +++ b/src/mcmc_student.cpp @@ -20,81 +20,104 @@ #include "LogStudentInd.h" #include "PostOutStudentInd.h" -RcppExport SEXP mcmc_student_cc (SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_student_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; + const bool INDICFIX = finModel.indicFix; + const bool HIER_IND = finPrior.hier; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; - BASE *ptr; - typedef FIX STUDENTFIX; - typedef IND > STUDENTIND; - if (INDICFIX || K == 1) { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutStudentFix> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + BASE *ptr; + + typedef FIX STUDENTFIX; + typedef IND > STUDENTIND; + if (INDICFIX || K == 1) + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutStudentFix> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + else + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutStudentInd> > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } else { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutStudentInd> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } - for (unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - return Rcpp::wrap(mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + return Rcpp::wrap(mcmcOutputS4O); } #endif diff --git a/src/mcmc_studmult.cpp b/src/mcmc_studmult.cpp index 57a026c..a4a0b6b 100644 --- a/src/mcmc_studmult.cpp +++ b/src/mcmc_studmult.cpp @@ -20,81 +20,104 @@ #include "LogStudmultInd.h" #include "PostOutStudmultInd.h" -RcppExport SEXP mcmc_studmult_cc (SEXP data_S4, SEXP model_S4, - SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) +RcppExport SEXP mcmc_studmult_cc(SEXP data_S4, SEXP model_S4, + SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { - /* Convert S4-classes to C++-structs */ - Rcpp::S4 dataS4O(data_S4); - Rcpp::S4 modelS4O(model_S4); - Rcpp::S4 priorS4O(prior_S4); - Rcpp::S4 mcmcS4O(mcmc_S4); - Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); - FinmixData finData = FinmixData(dataS4O); - FinmixModel finModel = FinmixModel(modelS4O); - FinmixPrior finPrior = FinmixPrior(priorS4O); - FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); + /* Convert S4-classes to C++-structs */ + Rcpp::S4 dataS4O(data_S4); + Rcpp::S4 modelS4O(model_S4); + Rcpp::S4 priorS4O(prior_S4); + Rcpp::S4 mcmcS4O(mcmc_S4); + Rcpp::S4 mcmcOutputS4O(mcmcoutput_S4); + FinmixData finData = FinmixData(dataS4O); + FinmixModel finModel = FinmixModel(modelS4O); + FinmixPrior finPrior = FinmixPrior(priorS4O); + FinmixMCMC finMCMC = FinmixMCMC(mcmcS4O); - const bool INDICFIX = finModel.indicFix; - const bool HIER_IND = finPrior.hier; - const bool POST_IND = finMCMC.storePost; - const unsigned int BURNIN = finMCMC.burnIn; - const unsigned int M = finMCMC.M; - const unsigned int K = finModel.K; + const bool INDICFIX = finModel.indicFix; + const bool HIER_IND = finPrior.hier; + const bool POST_IND = finMCMC.storePost; + const unsigned int BURNIN = finMCMC.burnIn; + const unsigned int M = finMCMC.M; + const unsigned int K = finModel.K; - BASE *ptr; - typedef FIX STUDMULTFIX; - typedef IND > STUDMULTIND; - if (INDICFIX || K == 1) { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutStudmultFix> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + BASE *ptr; + + typedef FIX STUDMULTFIX; + typedef IND > STUDMULTIND; + if (INDICFIX || K == 1) + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutStudmultFix> > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, + mcmcOutputS4O); + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + else + { + if (HIER_IND) + { + if (POST_IND) + { + ptr = new ADAPTER, PostOutStudmultInd> > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } else { - if (HIER_IND) { - if (POST_IND) { - ptr = new ADAPTER, PostOutStudmultInd> > - (finData, finModel, finPrior, finMCMC, - mcmcOutputS4O); - } else { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + else + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } - } else { - if (POST_IND) { - ptr = new ADAPTER > - (finData, finModel, finPrior, finMCMC, + } + } + else + { + if (POST_IND) + { + ptr = new ADAPTER > + (finData, finModel, finPrior, finMCMC, mcmcOutputS4O); - } else { - ptr = new ADAPTER (finData, finModel, - finPrior, finMCMC, mcmcOutputS4O); - } - } - } - for (unsigned int i = 0; i < BURNIN + M; ++i) { - ptr->update(); - ptr->store(i); - } - return Rcpp::wrap(mcmcOutputS4O); + } + else + { + ptr = new ADAPTER (finData, finModel, + finPrior, finMCMC, mcmcOutputS4O); + } + } + } + for (unsigned int i = 0; i < BURNIN + M; ++i) + { + ptr->update(); + ptr->store(i); + } + return Rcpp::wrap(mcmcOutputS4O); } #endif diff --git a/src/mincol.h b/src/mincol.h index 9210d8a..51d3298 100644 --- a/src/mincol.h +++ b/src/mincol.h @@ -1,94 +1,106 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_MINCOL_H__ #define __FINMIX_MINCOL_H__ // Matrix to column inline -arma::vec mincol (const arma::mat& m) +arma::vec mincol(const arma::mat& m) { - const unsigned int r = m.n_rows; - arma::vec output(r * (r + 1) / 2); - unsigned int index = 0; - for (unsigned int rr = 0; rr < r; ++rr) { - output.rows(index, index + rr) = m(arma::span(0, rr), rr); - index = index + rr + 1; - } - return output; + const unsigned int r = m.n_rows; + arma::vec output(r * (r + 1) / 2); + unsigned int index = 0; + + for (unsigned int rr = 0; rr < r; ++rr) + { + output.rows(index, index + rr) = m(arma::span(0, rr), rr); + index = index + rr + 1; + } + return output; } inline -arma::rowvec minrow (const arma::mat& m) +arma::rowvec minrow(const arma::mat& m) { - const unsigned int r = m.n_rows; - arma::rowvec output(r * (r + 1) / 2); - unsigned int index = 0; - for (unsigned int rr = 0; rr < r; ++rr) { - output.cols(index, index + rr) = arma::trans(m(arma::span(0, rr), rr)); - index = index + rr + 1; - } - return output; + const unsigned int r = m.n_rows; + arma::rowvec output(r * (r + 1) / 2); + unsigned int index = 0; + + for (unsigned int rr = 0; rr < r; ++rr) + { + output.cols(index, index + rr) = arma::trans(m(arma::span(0, rr), rr)); + index = index + rr + 1; + } + return output; } inline -arma::mat cincolmat (const arma::cube& c) +arma::mat cincolmat(const arma::cube& c) { - const unsigned int r = c.n_rows; - const unsigned int K = c.n_slices; - arma::mat output(r * (r + 1) / 2, K); - unsigned int index = 0; - for (unsigned int k = 0; k < K; ++k) { - for (unsigned int rr = 0; rr < r; ++rr) { - output(arma::span(index, index + rr), k) = c.slice(k)(arma::span(0, rr), rr); - index = index + rr + 1; - } - index = 0; - } - return output; + const unsigned int r = c.n_rows; + const unsigned int K = c.n_slices; + arma::mat output(r * (r + 1) / 2, K); + unsigned int index = 0; + + for (unsigned int k = 0; k < K; ++k) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + output(arma::span(index, index + rr), k) = c.slice(k)(arma::span(0, rr), rr); + index = index + rr + 1; + } + index = 0; + } + return output; } inline -arma::mat cinrowmat (const arma::cube& c) +arma::mat cinrowmat(const arma::cube& c) { - const unsigned int r = c.n_rows; - const unsigned int K = c.n_slices; - arma::mat output(K, r * (r + 1) / 2); - unsigned int index = 0; - for (unsigned int k = 0; k < K; ++k) { - for (unsigned int rr = 0; rr < r; ++rr) { - output(k, arma::span(index, index + rr)) = arma::trans(c.slice(k)(arma::span(0, rr), rr)); - index = index + rr + 1; - } - index = 0; - } - return output; + const unsigned int r = c.n_rows; + const unsigned int K = c.n_slices; + arma::mat output(K, r * (r + 1) / 2); + unsigned int index = 0; + + for (unsigned int k = 0; k < K; ++k) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + output(k, arma::span(index, index + rr)) = arma::trans(c.slice(k)(arma::span(0, rr), rr)); + index = index + rr + 1; + } + index = 0; + } + return output; } inline -arma::mat qinmatr (const arma::rowvec& v) +arma::mat qinmatr(const arma::rowvec& v) { - const unsigned int s = v.n_elem; - const unsigned int r = -0.5 + std::sqrt( 0.25 + 2 * s ); - arma::mat tmp(r, r); - unsigned int index = 0; - for ( unsigned int rr = 0; rr < r; ++rr) { - tmp(arma::span(0, rr), rr) = arma::trans(v.cols(index, index + rr)); - tmp(rr, arma::span(0, rr)) = v.cols(index, index + rr); - index = index + rr + 1; - } - return tmp; + const unsigned int s = v.n_elem; + const unsigned int r = -0.5 + std::sqrt(0.25 + 2 * s); + arma::mat tmp(r, r); + unsigned int index = 0; + + for (unsigned int rr = 0; rr < r; ++rr) + { + tmp(arma::span(0, rr), rr) = arma::trans(v.cols(index, index + rr)); + tmp(rr, arma::span(0, rr)) = v.cols(index, index + rr); + index = index + rr + 1; + } + return tmp; } #endif /* __FINMIX_MINCOL_H__ */ diff --git a/src/moments.h b/src/moments.h index 29c99ae..d764a80 100644 --- a/src/moments.h +++ b/src/moments.h @@ -1,530 +1,582 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_MOMENTS_H__ #define __FINMIX_MOMENTS_H__ -#include +#include -Rcpp::List moments_fix_cc (Rcpp::S4 classS4) +Rcpp::List moments_fix_cc(Rcpp::S4 classS4) { - Rcpp::List parList = Rcpp::as((SEXP) classS4.slot("par")); - Rcpp::NumericVector tmpMu = Rcpp::as((SEXP) parList["mu"]); - Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP) parList["sigma"]); - Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); - Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); - const unsigned int M = tmpMuDim[0]; - const unsigned int r = tmpMuDim[1]; - const unsigned int K = tmpMuDim[2]; - const unsigned int s = tmpSigmaDim[1]; - const unsigned int ij = R::choose(r, 2); - arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); - arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); - Rcpp::S4 model = Rcpp::as((SEXP) classS4.slot("model")); - arma::vec weight = Rcpp::as((SEXP) model.slot("weight")); - arma::vec means(r); - arma::vec tmp(K); - arma::mat var(r, r); - arma::mat W(r, r); - arma::mat B(r, r); - arma::mat cd(r, r); - arma::mat corr(r, r); - arma::rowvec tmp2; - arma::vec d; - double Rtr = 0.0; - double Rdet = 0.0; - arma::vec zm(4); - arma::mat higher(r, 4); - arma::vec sigmavec(K); - arma::vec cm(K); - arma::vec skewness(r); - arma::vec kurtosis(r); - - // Output containers - arma::mat meanOut(M, r); - arma::vec RtrOut(M); - arma::vec RdetOut(M); - arma::mat corrOut(M, ij); - arma::mat varOut(M, r); - arma::mat skewnessOut(M, r); - arma::mat kurtosisOut(M, r); - - // Permutation matrix - arma::umat perm(ij, 2); - unsigned int index = 0; - do { - for (unsigned int i = 0; i < r - 1; ++i) { - for (unsigned int j = i + 1; j < r; ++j) { - perm(index, 0) = i; - perm(index, 1) = j; - ++index; - } - } - } while (index < ij - 1); - - for (unsigned int i = 0; i < M; ++i) { - higher.fill(0.0); - for (unsigned int rr = 0; rr < r; ++rr) { - tmp = mu.tube(i, rr, i, rr); - means(rr) = arma::as_scalar(weight.t() * tmp); - } - var.fill(0.0); - W.fill(0.0); - B.fill(0.0); - cd.fill(0.0); - corr.fill(0.0); - - for (unsigned int k = 0; k < K; ++k) { - tmp2 = mu.slice(k)(arma::span(i), arma::span()); - var = var + tmp2.t() * tmp2 - + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) - * weight(k); - W = W + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) + Rcpp::List parList = Rcpp::as((SEXP)classS4.slot("par")); + Rcpp::NumericVector tmpMu = Rcpp::as((SEXP)parList["mu"]); + Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP)parList["sigma"]); + Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); + Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); + const unsigned int M = tmpMuDim[0]; + const unsigned int r = tmpMuDim[1]; + const unsigned int K = tmpMuDim[2]; + const unsigned int s = tmpSigmaDim[1]; + const unsigned int ij = R::choose(r, 2); + arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); + arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); + Rcpp::S4 model = Rcpp::as((SEXP)classS4.slot("model")); + arma::vec weight = Rcpp::as((SEXP)model.slot("weight")); + arma::vec means(r); + arma::vec tmp(K); + arma::mat var(r, r); + arma::mat W(r, r); + arma::mat B(r, r); + arma::mat cd(r, r); + arma::mat corr(r, r); + arma::rowvec tmp2; + arma::vec d; + double Rtr = 0.0; + double Rdet = 0.0; + arma::vec zm(4); + arma::mat higher(r, 4); + arma::vec sigmavec(K); + arma::vec cm(K); + arma::vec skewness(r); + arma::vec kurtosis(r); + + // Output containers + arma::mat meanOut(M, r); + arma::vec RtrOut(M); + arma::vec RdetOut(M); + arma::mat corrOut(M, ij); + arma::mat varOut(M, r); + arma::mat skewnessOut(M, r); + arma::mat kurtosisOut(M, r); + + // Permutation matrix + arma::umat perm(ij, 2); + unsigned int index = 0; + + do + { + for (unsigned int i = 0; i < r - 1; ++i) + { + for (unsigned int j = i + 1; j < r; ++j) + { + perm(index, 0) = i; + perm(index, 1) = j; + ++index; + } + } + } while (index < ij - 1); + + for (unsigned int i = 0; i < M; ++i) + { + higher.fill(0.0); + for (unsigned int rr = 0; rr < r; ++rr) + { + tmp = mu.tube(i, rr, i, rr); + means(rr) = arma::as_scalar(weight.t() * tmp); + } + var.fill(0.0); + W.fill(0.0); + B.fill(0.0); + cd.fill(0.0); + corr.fill(0.0); + + for (unsigned int k = 0; k < K; ++k) + { + tmp2 = mu.slice(k)(arma::span(i), arma::span()); + var = var + tmp2.t() * tmp2 + + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) * weight(k); - d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) - - means; - B = B + d * d.t() * weight(k); - } - var = var - means * means.t(); - cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); - corr = cd * var * cd; - Rtr = 1 - arma::trace(W) / arma::trace(var); - Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); - zm.fill(0.0); - zm(1) = 1.0; - zm(3) = std::exp(std::log(1.0) + std::log(3.0)); - for (unsigned int m = 0; m < 4; ++m) { - for (unsigned int rr = 0; rr < r; ++rr) { - for (unsigned int k = 0; k < K; ++k) { - sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr,rr); - } - tmp = mu.tube(i, rr, i, rr) - means(rr); - higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); - for (unsigned int n = 0; n < (m + 1); ++n) { - arma::vec ss = arma::pow(tmp, m - n); - cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) - * zm[n]; - higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) - * arma::as_scalar(weight.t() * cm); - } + W = W + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) + * weight(k); + d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) + - means; + B = B + d * d.t() * weight(k); + } + var = var - means * means.t(); + cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); + corr = cd * var * cd; + Rtr = 1 - arma::trace(W) / arma::trace(var); + Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); + zm.fill(0.0); + zm(1) = 1.0; + zm(3) = std::exp(std::log(1.0) + std::log(3.0)); + for (unsigned int m = 0; m < 4; ++m) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + for (unsigned int k = 0; k < K; ++k) + { + sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr, rr); } - } - skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); - kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); - meanOut.row(i) = arma::trans(means); - RtrOut(i) = Rtr; - RdetOut(i) = Rdet; - for (unsigned int j = 0; j < ij; ++j) { - corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); - } - for (unsigned int rr = 0; rr < r; ++rr) { - varOut(i, rr) = var(rr, rr); - } - skewnessOut.row(i) = arma::trans(skewness); - kurtosisOut.row(i) = arma::trans(kurtosis); - } - - return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), - Rcpp::Named("mean", meanOut), - Rcpp::Named("Rdet", RdetOut), - Rcpp::Named("corr", corrOut), - Rcpp::Named("var", varOut), - Rcpp::Named("skewness", skewnessOut), - Rcpp::Named("kurtosis", kurtosisOut)); + tmp = mu.tube(i, rr, i, rr) - means(rr); + higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); + for (unsigned int n = 0; n < (m + 1); ++n) + { + arma::vec ss = arma::pow(tmp, m - n); + cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) + * zm[n]; + higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) + * arma::as_scalar(weight.t() * cm); + } + } + } + skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); + kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); + meanOut.row(i) = arma::trans(means); + RtrOut(i) = Rtr; + RdetOut(i) = Rdet; + for (unsigned int j = 0; j < ij; ++j) + { + corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); + } + for (unsigned int rr = 0; rr < r; ++rr) + { + varOut(i, rr) = var(rr, rr); + } + skewnessOut.row(i) = arma::trans(skewness); + kurtosisOut.row(i) = arma::trans(kurtosis); + } + + return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), + Rcpp::Named("mean", meanOut), + Rcpp::Named("Rdet", RdetOut), + Rcpp::Named("corr", corrOut), + Rcpp::Named("var", varOut), + Rcpp::Named("skewness", skewnessOut), + Rcpp::Named("kurtosis", kurtosisOut)); } -Rcpp::List moments_ind_cc (Rcpp::S4 classS4) +Rcpp::List moments_ind_cc(Rcpp::S4 classS4) { - Rcpp::List parList = Rcpp::as((SEXP) classS4.slot("par")); - Rcpp::NumericVector tmpMu = Rcpp::as((SEXP) parList["mu"]); - Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP) parList["sigma"]); - Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); - Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); - const unsigned int M = tmpMuDim[0]; - const unsigned int r = tmpMuDim[1]; - const unsigned int K = tmpMuDim[2]; - const unsigned int s = tmpSigmaDim[1]; - const unsigned int ij = R::choose(r, 2); - arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); - arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); - arma::mat weights = Rcpp::as((SEXP) classS4.slot("weight")); - arma::vec weight(K); - arma::vec means(r); - arma::vec tmp(K); - arma::mat var(r, r); - arma::mat W(r, r); - arma::mat B(r, r); - arma::mat cd(r, r); - arma::mat corr(r, r); - arma::rowvec tmp2; - arma::vec d; - double Rtr = 0.0; - double Rdet = 0.0; - arma::vec zm(4); - arma::mat higher(r, 4); - arma::vec sigmavec(K); - arma::vec cm(K); - arma::vec skewness(r); - arma::vec kurtosis(r); - - // Output containers - arma::mat meanOut(M, r); - arma::vec RtrOut(M); - arma::vec RdetOut(M); - arma::mat corrOut(M, ij); - arma::mat varOut(M, r); - arma::mat skewnessOut(M, r); - arma::mat kurtosisOut(M, r); - - // Permutation matrix - arma::umat perm(ij, 2); - unsigned int index = 0; - do { - for (unsigned int i = 0; i < r - 1; ++i) { - for (unsigned int j = i + 1; j < r; ++j) { - perm(index, 0) = i; - perm(index, 1) = j; - ++index; - } - } - } while (index < ij - 1); - - for (unsigned int i = 0; i < M; ++i) { - higher.fill(0.0); - weight = arma::trans(weights.row(i)); - for (unsigned int rr = 0; rr < r; ++rr) { - tmp = mu.tube(i, rr, i, rr); - means(rr) = arma::as_scalar(weight.t() * tmp); - } - var.fill(0.0); - W.fill(0.0); - B.fill(0.0); - cd.fill(0.0); - corr.fill(0.0); - - for (unsigned int k = 0; k < K; ++k) { - tmp2 = mu.slice(k)(arma::span(i), arma::span()); - var = var + tmp2.t() * tmp2 - + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) - * weight(k); - W = W + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) + Rcpp::List parList = Rcpp::as((SEXP)classS4.slot("par")); + Rcpp::NumericVector tmpMu = Rcpp::as((SEXP)parList["mu"]); + Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP)parList["sigma"]); + Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); + Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); + const unsigned int M = tmpMuDim[0]; + const unsigned int r = tmpMuDim[1]; + const unsigned int K = tmpMuDim[2]; + const unsigned int s = tmpSigmaDim[1]; + const unsigned int ij = R::choose(r, 2); + arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); + arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); + arma::mat weights = Rcpp::as((SEXP)classS4.slot("weight")); + arma::vec weight(K); + arma::vec means(r); + arma::vec tmp(K); + arma::mat var(r, r); + arma::mat W(r, r); + arma::mat B(r, r); + arma::mat cd(r, r); + arma::mat corr(r, r); + arma::rowvec tmp2; + arma::vec d; + double Rtr = 0.0; + double Rdet = 0.0; + arma::vec zm(4); + arma::mat higher(r, 4); + arma::vec sigmavec(K); + arma::vec cm(K); + arma::vec skewness(r); + arma::vec kurtosis(r); + + // Output containers + arma::mat meanOut(M, r); + arma::vec RtrOut(M); + arma::vec RdetOut(M); + arma::mat corrOut(M, ij); + arma::mat varOut(M, r); + arma::mat skewnessOut(M, r); + arma::mat kurtosisOut(M, r); + + // Permutation matrix + arma::umat perm(ij, 2); + unsigned int index = 0; + + do + { + for (unsigned int i = 0; i < r - 1; ++i) + { + for (unsigned int j = i + 1; j < r; ++j) + { + perm(index, 0) = i; + perm(index, 1) = j; + ++index; + } + } + } while (index < ij - 1); + + for (unsigned int i = 0; i < M; ++i) + { + higher.fill(0.0); + weight = arma::trans(weights.row(i)); + for (unsigned int rr = 0; rr < r; ++rr) + { + tmp = mu.tube(i, rr, i, rr); + means(rr) = arma::as_scalar(weight.t() * tmp); + } + var.fill(0.0); + W.fill(0.0); + B.fill(0.0); + cd.fill(0.0); + corr.fill(0.0); + + for (unsigned int k = 0; k < K; ++k) + { + tmp2 = mu.slice(k)(arma::span(i), arma::span()); + var = var + tmp2.t() * tmp2 + + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) * weight(k); - d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) - - means; - B = B + d * d.t() * weight(k); - } - var = var - means * means.t(); - cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); - corr = cd * var * cd; - Rtr = 1 - arma::trace(W) / arma::trace(var); - Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); - zm.fill(0.0); - zm(1) = 1.0; - zm(3) = std::exp(std::log(1.0) + std::log(3.0)); - for (unsigned int m = 0; m < 4; ++m) { - for (unsigned int rr = 0; rr < r; ++rr) { - for (unsigned int k = 0; k < K; ++k) { - sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr,rr); - } - tmp = mu.tube(i, rr, i, rr) - means(rr); - higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); - for (unsigned int n = 0; n < (m + 1); ++n) { - arma::vec ss = arma::pow(tmp, m - n); - cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) - * zm[n]; - higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) - * arma::as_scalar(weight.t() * cm); - } + W = W + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) + * weight(k); + d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) + - means; + B = B + d * d.t() * weight(k); + } + var = var - means * means.t(); + cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); + corr = cd * var * cd; + Rtr = 1 - arma::trace(W) / arma::trace(var); + Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); + zm.fill(0.0); + zm(1) = 1.0; + zm(3) = std::exp(std::log(1.0) + std::log(3.0)); + for (unsigned int m = 0; m < 4; ++m) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + for (unsigned int k = 0; k < K; ++k) + { + sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr, rr); } - } - skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); - kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); - meanOut.row(i) = arma::trans(means); - RtrOut(i) = Rtr; - RdetOut(i) = Rdet; - for (unsigned int j = 0; j < ij; ++j) { - corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); - } - for (unsigned int rr = 0; rr < r; ++rr) { - varOut(i, rr) = var(rr, rr); - } - skewnessOut.row(i) = arma::trans(skewness); - kurtosisOut.row(i) = arma::trans(kurtosis); - } - - return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), - Rcpp::Named("mean", meanOut), - Rcpp::Named("Rdet", RdetOut), - Rcpp::Named("corr", corrOut), - Rcpp::Named("var", varOut), - Rcpp::Named("skewness", skewnessOut), - Rcpp::Named("kurtosis", kurtosisOut)); + tmp = mu.tube(i, rr, i, rr) - means(rr); + higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); + for (unsigned int n = 0; n < (m + 1); ++n) + { + arma::vec ss = arma::pow(tmp, m - n); + cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) + * zm[n]; + higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) + * arma::as_scalar(weight.t() * cm); + } + } + } + skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); + kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); + meanOut.row(i) = arma::trans(means); + RtrOut(i) = Rtr; + RdetOut(i) = Rdet; + for (unsigned int j = 0; j < ij; ++j) + { + corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); + } + for (unsigned int rr = 0; rr < r; ++rr) + { + varOut(i, rr) = var(rr, rr); + } + skewnessOut.row(i) = arma::trans(skewness); + kurtosisOut.row(i) = arma::trans(kurtosis); + } + + return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), + Rcpp::Named("mean", meanOut), + Rcpp::Named("Rdet", RdetOut), + Rcpp::Named("corr", corrOut), + Rcpp::Named("var", varOut), + Rcpp::Named("skewness", skewnessOut), + Rcpp::Named("kurtosis", kurtosisOut)); } -Rcpp::List permmoments_fix_cc (Rcpp::S4 classS4) +Rcpp::List permmoments_fix_cc(Rcpp::S4 classS4) { - Rcpp::List parList = Rcpp::as((SEXP) classS4.slot("parperm")); - Rcpp::NumericVector tmpMu = Rcpp::as((SEXP) parList["mu"]); - Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP) parList["sigma"]); - Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); - Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); - const unsigned int M = tmpMuDim[0]; - const unsigned int r = tmpMuDim[1]; - const unsigned int K = tmpMuDim[2]; - const unsigned int s = tmpSigmaDim[1]; - const unsigned int ij = R::choose(r, 2); - arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); - arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); - Rcpp::S4 model = Rcpp::as((SEXP) classS4.slot("model")); - arma::vec weight = Rcpp::as((SEXP) model.slot("weight")); - arma::vec means(r); - arma::vec tmp(K); - arma::mat var(r, r); - arma::mat W(r, r); - arma::mat B(r, r); - arma::mat cd(r, r); - arma::mat corr(r, r); - arma::rowvec tmp2; - arma::vec d; - double Rtr = 0.0; - double Rdet = 0.0; - arma::vec zm(4); - arma::mat higher(r, 4); - arma::vec sigmavec(K); - arma::vec cm(K); - arma::vec skewness(r); - arma::vec kurtosis(r); - - // Output containers - arma::mat meanOut(M, r); - arma::vec RtrOut(M); - arma::vec RdetOut(M); - arma::mat corrOut(M, ij); - arma::mat varOut(M, r); - arma::mat skewnessOut(M, r); - arma::mat kurtosisOut(M, r); - - // Permutation matrix - arma::umat perm(ij, 2); - unsigned int index = 0; - do { - for (unsigned int i = 0; i < r - 1; ++i) { - for (unsigned int j = i + 1; j < r; ++j) { - perm(index, 0) = i; - perm(index, 1) = j; - ++index; - } - } - } while (index < ij - 1); - - for (unsigned int i = 0; i < M; ++i) { - higher.fill(0.0); - for (unsigned int rr = 0; rr < r; ++rr) { - tmp = mu.tube(i, rr, i, rr); - means(rr) = arma::as_scalar(weight.t() * tmp); - } - var.fill(0.0); - W.fill(0.0); - B.fill(0.0); - cd.fill(0.0); - corr.fill(0.0); - - for (unsigned int k = 0; k < K; ++k) { - tmp2 = mu.slice(k)(arma::span(i), arma::span()); - var = var + tmp2.t() * tmp2 - + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) - * weight(k); - W = W + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) + Rcpp::List parList = Rcpp::as((SEXP)classS4.slot("parperm")); + Rcpp::NumericVector tmpMu = Rcpp::as((SEXP)parList["mu"]); + Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP)parList["sigma"]); + Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); + Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); + const unsigned int M = tmpMuDim[0]; + const unsigned int r = tmpMuDim[1]; + const unsigned int K = tmpMuDim[2]; + const unsigned int s = tmpSigmaDim[1]; + const unsigned int ij = R::choose(r, 2); + arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); + arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); + Rcpp::S4 model = Rcpp::as((SEXP)classS4.slot("model")); + arma::vec weight = Rcpp::as((SEXP)model.slot("weight")); + arma::vec means(r); + arma::vec tmp(K); + arma::mat var(r, r); + arma::mat W(r, r); + arma::mat B(r, r); + arma::mat cd(r, r); + arma::mat corr(r, r); + arma::rowvec tmp2; + arma::vec d; + double Rtr = 0.0; + double Rdet = 0.0; + arma::vec zm(4); + arma::mat higher(r, 4); + arma::vec sigmavec(K); + arma::vec cm(K); + arma::vec skewness(r); + arma::vec kurtosis(r); + + // Output containers + arma::mat meanOut(M, r); + arma::vec RtrOut(M); + arma::vec RdetOut(M); + arma::mat corrOut(M, ij); + arma::mat varOut(M, r); + arma::mat skewnessOut(M, r); + arma::mat kurtosisOut(M, r); + + // Permutation matrix + arma::umat perm(ij, 2); + unsigned int index = 0; + + do + { + for (unsigned int i = 0; i < r - 1; ++i) + { + for (unsigned int j = i + 1; j < r; ++j) + { + perm(index, 0) = i; + perm(index, 1) = j; + ++index; + } + } + } while (index < ij - 1); + + for (unsigned int i = 0; i < M; ++i) + { + higher.fill(0.0); + for (unsigned int rr = 0; rr < r; ++rr) + { + tmp = mu.tube(i, rr, i, rr); + means(rr) = arma::as_scalar(weight.t() * tmp); + } + var.fill(0.0); + W.fill(0.0); + B.fill(0.0); + cd.fill(0.0); + corr.fill(0.0); + + for (unsigned int k = 0; k < K; ++k) + { + tmp2 = mu.slice(k)(arma::span(i), arma::span()); + var = var + tmp2.t() * tmp2 + + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) * weight(k); - d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) - - means; - B = B + d * d.t() * weight(k); - } - var = var - means * means.t(); - cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); - corr = cd * var * cd; - Rtr = 1 - arma::trace(W) / arma::trace(var); - Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); - zm.fill(0.0); - zm(1) = 1.0; - zm(3) = std::exp(std::log(1.0) + std::log(3.0)); - for (unsigned int m = 0; m < 4; ++m) { - for (unsigned int rr = 0; rr < r; ++rr) { - for (unsigned int k = 0; k < K; ++k) { - sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr,rr); - } - tmp = mu.tube(i, rr, i, rr) - means(rr); - higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); - for (unsigned int n = 0; n < (m + 1); ++n) { - arma::vec ss = arma::pow(tmp, m - n); - cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) - * zm[n]; - higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) - * arma::as_scalar(weight.t() * cm); - } + W = W + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) + * weight(k); + d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) + - means; + B = B + d * d.t() * weight(k); + } + var = var - means * means.t(); + cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); + corr = cd * var * cd; + Rtr = 1 - arma::trace(W) / arma::trace(var); + Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); + zm.fill(0.0); + zm(1) = 1.0; + zm(3) = std::exp(std::log(1.0) + std::log(3.0)); + for (unsigned int m = 0; m < 4; ++m) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + for (unsigned int k = 0; k < K; ++k) + { + sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr, rr); } - } - skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); - kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); - meanOut.row(i) = arma::trans(means); - RtrOut(i) = Rtr; - RdetOut(i) = Rdet; - for (unsigned int j = 0; j < ij; ++j) { - corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); - } - for (unsigned int rr = 0; rr < r; ++rr) { - varOut(i, rr) = var(rr, rr); - } - skewnessOut.row(i) = arma::trans(skewness); - kurtosisOut.row(i) = arma::trans(kurtosis); - } - - return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), - Rcpp::Named("mean", meanOut), - Rcpp::Named("Rdet", RdetOut), - Rcpp::Named("corr", corrOut), - Rcpp::Named("var", varOut), - Rcpp::Named("skewness", skewnessOut), - Rcpp::Named("kurtosis", kurtosisOut)); + tmp = mu.tube(i, rr, i, rr) - means(rr); + higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); + for (unsigned int n = 0; n < (m + 1); ++n) + { + arma::vec ss = arma::pow(tmp, m - n); + cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) + * zm[n]; + higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) + * arma::as_scalar(weight.t() * cm); + } + } + } + skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); + kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); + meanOut.row(i) = arma::trans(means); + RtrOut(i) = Rtr; + RdetOut(i) = Rdet; + for (unsigned int j = 0; j < ij; ++j) + { + corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); + } + for (unsigned int rr = 0; rr < r; ++rr) + { + varOut(i, rr) = var(rr, rr); + } + skewnessOut.row(i) = arma::trans(skewness); + kurtosisOut.row(i) = arma::trans(kurtosis); + } + + return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), + Rcpp::Named("mean", meanOut), + Rcpp::Named("Rdet", RdetOut), + Rcpp::Named("corr", corrOut), + Rcpp::Named("var", varOut), + Rcpp::Named("skewness", skewnessOut), + Rcpp::Named("kurtosis", kurtosisOut)); } -Rcpp::List permmoments_ind_cc (Rcpp::S4 classS4) +Rcpp::List permmoments_ind_cc(Rcpp::S4 classS4) { - Rcpp::List parList = Rcpp::as((SEXP) classS4.slot("parperm")); - Rcpp::NumericVector tmpMu = Rcpp::as((SEXP) parList["mu"]); - Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP) parList["sigma"]); - Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); - Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); - const unsigned int M = tmpMuDim[0]; - const unsigned int r = tmpMuDim[1]; - const unsigned int K = tmpMuDim[2]; - const unsigned int s = tmpSigmaDim[1]; - const unsigned int ij = R::choose(r, 2); - arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); - arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); - arma::mat weights = Rcpp::as((SEXP) classS4.slot("weightperm")); - arma::vec weight(K); - arma::vec means(r); - arma::vec tmp(K); - arma::mat var(r, r); - arma::mat W(r, r); - arma::mat B(r, r); - arma::mat cd(r, r); - arma::mat corr(r, r); - arma::rowvec tmp2; - arma::vec d; - double Rtr = 0.0; - double Rdet = 0.0; - arma::vec zm(4); - arma::mat higher(r, 4); - arma::vec sigmavec(K); - arma::vec cm(K); - arma::vec skewness(r); - arma::vec kurtosis(r); - - // Output containers - arma::mat meanOut(M, r); - arma::vec RtrOut(M); - arma::vec RdetOut(M); - arma::mat corrOut(M, ij); - arma::mat varOut(M, r); - arma::mat skewnessOut(M, r); - arma::mat kurtosisOut(M, r); - - // Permutation matrix - arma::umat perm(ij, 2); - unsigned int index = 0; - do { - for (unsigned int i = 0; i < r - 1; ++i) { - for (unsigned int j = i + 1; j < r; ++j) { - perm(index, 0) = i; - perm(index, 1) = j; - ++index; - } - } - } while (index < ij - 1); - - for (unsigned int i = 0; i < M; ++i) { - higher.fill(0.0); - weight = arma::trans(weights.row(i)); - for (unsigned int rr = 0; rr < r; ++rr) { - tmp = mu.tube(i, rr, i, rr); - means(rr) = arma::as_scalar(weight.t() * tmp); - } - var.fill(0.0); - W.fill(0.0); - B.fill(0.0); - cd.fill(0.0); - corr.fill(0.0); - - for (unsigned int k = 0; k < K; ++k) { - tmp2 = mu.slice(k)(arma::span(i), arma::span()); - var = var + tmp2.t() * tmp2 - + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) - * weight(k); - W = W + qinmatr(sigma.slice(k)(arma::span(i),arma::span())) + Rcpp::List parList = Rcpp::as((SEXP)classS4.slot("parperm")); + Rcpp::NumericVector tmpMu = Rcpp::as((SEXP)parList["mu"]); + Rcpp::NumericVector tmpSigma = Rcpp::as((SEXP)parList["sigma"]); + Rcpp::IntegerVector tmpMuDim = tmpMu.attr("dim"); + Rcpp::IntegerVector tmpSigmaDim = tmpSigma.attr("dim"); + const unsigned int M = tmpMuDim[0]; + const unsigned int r = tmpMuDim[1]; + const unsigned int K = tmpMuDim[2]; + const unsigned int s = tmpSigmaDim[1]; + const unsigned int ij = R::choose(r, 2); + arma::cube mu = arma::cube(tmpMu.begin(), M, r, K, false, true); + arma::cube sigma = arma::cube(tmpSigma.begin(), M, s, K, false, true); + arma::mat weights = Rcpp::as((SEXP)classS4.slot("weightperm")); + arma::vec weight(K); + arma::vec means(r); + arma::vec tmp(K); + arma::mat var(r, r); + arma::mat W(r, r); + arma::mat B(r, r); + arma::mat cd(r, r); + arma::mat corr(r, r); + arma::rowvec tmp2; + arma::vec d; + double Rtr = 0.0; + double Rdet = 0.0; + arma::vec zm(4); + arma::mat higher(r, 4); + arma::vec sigmavec(K); + arma::vec cm(K); + arma::vec skewness(r); + arma::vec kurtosis(r); + + // Output containers + arma::mat meanOut(M, r); + arma::vec RtrOut(M); + arma::vec RdetOut(M); + arma::mat corrOut(M, ij); + arma::mat varOut(M, r); + arma::mat skewnessOut(M, r); + arma::mat kurtosisOut(M, r); + + // Permutation matrix + arma::umat perm(ij, 2); + unsigned int index = 0; + + do + { + for (unsigned int i = 0; i < r - 1; ++i) + { + for (unsigned int j = i + 1; j < r; ++j) + { + perm(index, 0) = i; + perm(index, 1) = j; + ++index; + } + } + } while (index < ij - 1); + + for (unsigned int i = 0; i < M; ++i) + { + higher.fill(0.0); + weight = arma::trans(weights.row(i)); + for (unsigned int rr = 0; rr < r; ++rr) + { + tmp = mu.tube(i, rr, i, rr); + means(rr) = arma::as_scalar(weight.t() * tmp); + } + var.fill(0.0); + W.fill(0.0); + B.fill(0.0); + cd.fill(0.0); + corr.fill(0.0); + + for (unsigned int k = 0; k < K; ++k) + { + tmp2 = mu.slice(k)(arma::span(i), arma::span()); + var = var + tmp2.t() * tmp2 + + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) * weight(k); - d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) - - means; - B = B + d * d.t() * weight(k); - } - var = var - means * means.t(); - cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); - corr = cd * var * cd; - Rtr = 1 - arma::trace(W) / arma::trace(var); - Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); - zm.fill(0.0); - zm(1) = 1.0; - zm(3) = std::exp(std::log(1.0) + std::log(3.0)); - for (unsigned int m = 0; m < 4; ++m) { - for (unsigned int rr = 0; rr < r; ++rr) { - for (unsigned int k = 0; k < K; ++k) { - sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr,rr); - } - tmp = mu.tube(i, rr, i, rr) - means(rr); - higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); - for (unsigned int n = 0; n < (m + 1); ++n) { - arma::vec ss = arma::pow(tmp, m - n); - cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) - * zm[n]; - higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) - * arma::as_scalar(weight.t() * cm); - } + W = W + qinmatr(sigma.slice(k)(arma::span(i), arma::span())) + * weight(k); + d = arma::trans(mu.slice(k)(arma::span(i), arma::span())) + - means; + B = B + d * d.t() * weight(k); + } + var = var - means * means.t(); + cd = arma::diagmat(1.0 / arma::sqrt(arma::diagvec(var))); + corr = cd * var * cd; + Rtr = 1 - arma::trace(W) / arma::trace(var); + Rdet = 1 - std::log(arma::det(W)) / std::log(arma::det(var)); + zm.fill(0.0); + zm(1) = 1.0; + zm(3) = std::exp(std::log(1.0) + std::log(3.0)); + for (unsigned int m = 0; m < 4; ++m) + { + for (unsigned int rr = 0; rr < r; ++rr) + { + for (unsigned int k = 0; k < K; ++k) + { + sigmavec(k) = qinmatr(sigma.slice(k)(arma::span(i), arma::span()))(rr, rr); } - } - skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); - kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); - meanOut.row(i) = arma::trans(means); - RtrOut(i) = Rtr; - RdetOut(i) = Rdet; - for (unsigned int j = 0; j < ij; ++j) { - corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); - } - for (unsigned int rr = 0; rr < r; ++rr) { - varOut(i, rr) = var(rr, rr); - } - skewnessOut.row(i) = arma::trans(skewness); - kurtosisOut.row(i) = arma::trans(kurtosis); - } - - return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), - Rcpp::Named("mean", meanOut), - Rcpp::Named("Rdet", RdetOut), - Rcpp::Named("corr", corrOut), - Rcpp::Named("var", varOut), - Rcpp::Named("skewness", skewnessOut), - Rcpp::Named("kurtosis", kurtosisOut)); + tmp = mu.tube(i, rr, i, rr) - means(rr); + higher(rr, m) = arma::as_scalar(weight.t() * arma::pow(tmp, m + 1)); + for (unsigned int n = 0; n < (m + 1); ++n) + { + arma::vec ss = arma::pow(tmp, m - n); + cm = arma::pow(tmp, m - n) % arma::pow(sigmavec, (n + 1) / 2) + * zm[n]; + higher(rr, m) = higher(rr, m) + R::choose(m + 1, n + 1) + * arma::as_scalar(weight.t() * cm); + } + } + } + skewness = higher.col(2) / arma::pow(higher.col(1), 1.5); + kurtosis = higher.col(3) / arma::pow(higher.col(1), 2); + meanOut.row(i) = arma::trans(means); + RtrOut(i) = Rtr; + RdetOut(i) = Rdet; + for (unsigned int j = 0; j < ij; ++j) + { + corrOut(i, j) = corr(perm(j, 0), perm(j, 1)); + } + for (unsigned int rr = 0; rr < r; ++rr) + { + varOut(i, rr) = var(rr, rr); + } + skewnessOut.row(i) = arma::trans(skewness); + kurtosisOut.row(i) = arma::trans(kurtosis); + } + + return Rcpp::List::create(Rcpp::Named("Rtr", RtrOut), + Rcpp::Named("mean", meanOut), + Rcpp::Named("Rdet", RdetOut), + Rcpp::Named("corr", corrOut), + Rcpp::Named("var", varOut), + Rcpp::Named("skewness", skewnessOut), + Rcpp::Named("kurtosis", kurtosisOut)); } #endif /* __FINMIX_MOMENTS_H__ */ diff --git a/src/optimize.h b/src/optimize.h index 7010551..58dffd9 100644 --- a/src/optimize.h +++ b/src/optimize.h @@ -1,16 +1,16 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2012-2013 Lars Simon Zehnder. All Rights Reserved. - * Web: - - * - * Author: Lars Simon Zehnder - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2012-2013 Lars Simon Zehnder. All Rights Reserved. +* Web: - +* +* Author: Lars Simon Zehnder +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_OPTIMIZE_H__ #define __FINMIX_OPTIMIZE_H__ @@ -32,10 +32,10 @@ * @par f_data Armadillo matrix pointer to the data * @return function value * @detail The nlopt library needs an objective function with - * that returns a double value and uses certain - * parameters. In detail, the f_data pointer points to - * a std::vector filled with Armadillo matrix pointers. - * Inside the objective function a static_cast is used + * that returns a double value and uses certain + * parameters. In detail, the f_data pointer points to + * a std::vector filled with Armadillo matrix pointers. + * Inside the objective function a static_cast is used * to access the data. * The function calculates the sum over all logarithms * of the Gamma prior added by the logarithms of the @@ -45,27 +45,31 @@ * ------------------------------------------------------------ **/ inline -double obj_stephens1997a_poisson (unsigned n, const double* x, - double* grad, void *f_data) +double obj_stephens1997a_poisson(unsigned n, const double* x, + double* grad, void *f_data) { - std::vector *arma_data = static_cast* >(f_data); - const unsigned int M = (*arma_data)[0]->n_rows; - const unsigned int K = (*arma_data)[0]->n_cols; - arma::vec rvalues(M); - arma::vec dirich(&x[0], K); - arma::vec shape(&x[0] + K, K); - arma::vec rate(&x[0] + 2 * K, K); - rvalues = lddirichlet((*(*arma_data)[1]), dirich); - rvalues += arma::sum(ldgamma((*(*arma_data)[0]), - shape, rate), 1); - if (rvalues.has_inf()) { - rvalues.elem(arma::find(rvalues == arma::datum::inf)).fill(10.0e+6); - rvalues.elem(arma::find(rvalues == -arma::datum::inf)).fill(-10.0e+6); - } else if (rvalues.has_nan()) { - rvalues.elem(arma::find(rvalues == arma::datum::nan)).zeros(); - } - - return arma::as_scalar(arma::sum(rvalues)); + std::vector *arma_data = static_cast* >(f_data); + const unsigned int M = (*arma_data)[0]->n_rows; + const unsigned int K = (*arma_data)[0]->n_cols; + arma::vec rvalues(M); + arma::vec dirich(&x[0], K); + arma::vec shape(&x[0] + K, K); + arma::vec rate(&x[0] + 2 * K, K); + + rvalues = lddirichlet((*(*arma_data)[1]), dirich); + rvalues += arma::sum(ldgamma((*(*arma_data)[0]), + shape, rate), 1); + if (rvalues.has_inf()) + { + rvalues.elem(arma::find(rvalues == arma::datum::inf)).fill(10.0e+6); + rvalues.elem(arma::find(rvalues == -arma::datum::inf)).fill(-10.0e+6); + } + else if (rvalues.has_nan()) + { + rvalues.elem(arma::find(rvalues == arma::datum::nan)).zeros(); + } + + return arma::as_scalar(arma::sum(rvalues)); } /** * ------------------------------------------------------------ @@ -77,10 +81,10 @@ double obj_stephens1997a_poisson (unsigned n, const double* x, * @par f_data Armadillo matrix pointer to the data * @return function value * @detail The nlopt library needs an objective function with - * that returns a double value and uses certain - * parameters. In detail, the f_data pointer points to - * a std::vector filled with Armadillo matrix pointers. - * Inside the objective function a static_cast is used + * that returns a double value and uses certain + * parameters. In detail, the f_data pointer points to + * a std::vector filled with Armadillo matrix pointers. + * Inside the objective function a static_cast is used * to access the data. * The function calculates the sum over all logarithms * of the Beta prior added by the logarithms of the @@ -90,21 +94,22 @@ double obj_stephens1997a_poisson (unsigned n, const double* x, * ------------------------------------------------------------ **/ inline -double obj_stephens1997a_binomial (unsigned n, const double* x, - double* grad, void *f_data) +double obj_stephens1997a_binomial(unsigned n, const double* x, + double* grad, void *f_data) { - std::vector *arma_data = static_cast* >(f_data); - const unsigned int M = (*arma_data)[0]->n_rows; - const unsigned int K = (*arma_data)[0]->n_cols; - arma::vec rvalues(M); - arma::vec arma_x(*x); - arma::vec dirich(&x[0], K); - arma::vec shape1(&x[0] + K, K); - arma::vec shape2(&x[0] + 2 * K, K); - rvalues = lddirichlet((*(*arma_data)[1]), dirich); - rvalues += arma::sum(ldbeta((*(*arma_data)[0]), - shape1, shape2), 1); - return arma::as_scalar(arma::sum(rvalues)); + std::vector *arma_data = static_cast* >(f_data); + const unsigned int M = (*arma_data)[0]->n_rows; + const unsigned int K = (*arma_data)[0]->n_cols; + arma::vec rvalues(M); + arma::vec arma_x(*x); + arma::vec dirich(&x[0], K); + arma::vec shape1(&x[0] + K, K); + arma::vec shape2(&x[0] + 2 * K, K); + + rvalues = lddirichlet((*(*arma_data)[1]), dirich); + rvalues += arma::sum(ldbeta((*(*arma_data)[0]), + shape1, shape2), 1); + return arma::as_scalar(arma::sum(rvalues)); } #endif /* __FINMIX_OPTIMIZE_H__ */ diff --git a/src/posterior.h b/src/posterior.h index 3875926..8c664c5 100644 --- a/src/posterior.h +++ b/src/posterior.h @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef POSTERIOR_H #define POSTERIOR_H @@ -28,28 +28,30 @@ /** * posterior for multinomial distribution * - * as this is used for the weights of any mixture - * no specific struct is input argument + * as this is used for the weights of any mixture + * no specific struct is input argument */ -inline arma::rowvec -posterior_multinomial(const unsigned int &K, const arma::ivec &S, - const arma::rowvec &weight) +inline arma::rowvec +posterior_multinomial(const unsigned int &K, const arma::ivec &S, + const arma::rowvec &weight) { - arma::imat repS = arma::repmat(S, 1, K); - arma::imat compM = arma::ones(S.n_rows, K); - arma::rowvec par_post(K); - - /* create sequence */ - for(unsigned int k = 0; k < K; ++k) { - compM.col(k) = compM.col(k) * (k + 1); - } - arma::umat ind = (repS == compM); - arma::mat indDouble = arma::conv_to::from(ind); - par_post = arma::sum(indDouble); - par_post = par_post + weight; - - return par_post; + arma::imat repS = arma::repmat(S, 1, K); + arma::imat compM = arma::ones(S.n_rows, K); + arma::rowvec par_post(K); + + /* create sequence */ + for (unsigned int k = 0; k < K; ++k) + { + compM.col(k) = compM.col(k) * (k + 1); + } + arma::umat ind = (repS == compM); + arma::mat indDouble = arma::conv_to::from(ind); + + par_post = arma::sum(indDouble); + par_post = par_post + weight; + + return par_post; } #endif diff --git a/src/prior_likelihood.h b/src/prior_likelihood.h index 7d3ae32..fff8cec 100644 --- a/src/prior_likelihood.h +++ b/src/prior_likelihood.h @@ -1,41 +1,41 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ #ifndef __FINMIX_PRIORLIKELIHOOD_H__ #define __FINMIX_PRIORLIKELIHOOD_H__ #include -#include // to interface with R -#include // for using internal R C-functions +#include // to interface with R +#include // for using internal R C-functions #include "likelihood.h" #include "distributions.h" #include "rtruncnorm.h" #include "PriorCondPoissonFix.h" /** - * Evaluates the prior likelihood for the + * Evaluates the prior likelihood for the * weights. This function is used in every - * Gibbs sampling. - * + * Gibbs sampling. + * */ // ============================================================= @@ -44,32 +44,34 @@ /** * ------------------------------------------------------------- - * @brief Computes the mixture log-likelihood for a - * Dirichlet distribution. + * @brief Computes the mixture log-likelihood for a + * Dirichlet distribution. * @par eta weight parameters - * @par prior_par hyper parameters of the Dirichlet + * @par prior_par hyper parameters of the Dirichlet * distribution * @return Prior mixture log-likelihood * @detail The log-lieklihood is computed via the density - * of the Dirichlet distribution evaluated at the - * weights with hyper parameters determined in + * of the Dirichlet distribution evaluated at the + * weights with hyper parameters determined in * prior_par * @author Lars Simon Zehnder * ------------------------------------------------------------- **/ -inline double -priormixlik_dirichlet(const arma::rowvec &eta, - const arma::rowvec &prior_par) +inline double +priormixlik_dirichlet(const arma::rowvec &eta, + const arma::rowvec &prior_par) { - unsigned int K = eta.n_elem; - double priormixlik = 0.0; - /* Evaluate Dirichlet loglik */ - priormixlik = R::lgammafn(arma::accu(prior_par)); - for(unsigned int k = 0; k < K; ++k) { - priormixlik += (prior_par(k) - 1) * std::log(eta(k)); - priormixlik -= R::lgammafn(prior_par(k)); - } - return priormixlik; + unsigned int K = eta.n_elem; + double priormixlik = 0.0; + + /* Evaluate Dirichlet loglik */ + priormixlik = R::lgammafn(arma::accu(prior_par)); + for (unsigned int k = 0; k < K; ++k) + { + priormixlik += (prior_par(k) - 1) * std::log(eta(k)); + priormixlik -= R::lgammafn(prior_par(k)); + } + return priormixlik; } // ============================================================= // Poisson prior @@ -77,9 +79,9 @@ priormixlik_dirichlet(const arma::rowvec &eta, /** * ------------------------------------------------------------- - * @brief Computes the prior mixture log-likelihood for a - * Poisson distribution. - * @par lambda Poisson parameters, 1 x K + * @brief Computes the prior mixture log-likelihood for a + * Poisson distribution. + * @par lambda Poisson parameters, 1 x K * @par prior_parA Gamma hyper shape parameters, 1 x K * @par prior_parB Gamma hyper rate parameters, 1 x K * @par hier boolean value indicating if a hierarchical @@ -93,55 +95,60 @@ priormixlik_dirichlet(const arma::rowvec &eta, * ------------------------------------------------------------ **/ inline double -priormixlik_poisson(const arma::rowvec& lambda, - const arma::rowvec& prior_parA, - const arma::rowvec& prior_parB, - const bool &hier, const double &g, - const double &G) { +priormixlik_poisson(const arma::rowvec& lambda, + const arma::rowvec& prior_parA, + const arma::rowvec& prior_parB, + const bool &hier, const double &g, + const double &G) +{ + unsigned int K = lambda.n_elem; + double priormixlik = 0.0; - unsigned int K = lambda.n_elem; - double priormixlik = 0.0; - if(!hier) { - priormixlik = likelihood_gamma(lambda, prior_parA(0), prior_parB(0)); - } - else { /* hierarchical prior */ - double gN = g + K * prior_parA(0); // prior_parA must be the start value. - double GN = G + arma::accu(lambda); - double b = gN/GN; - double scale = 1.0/b; - /* step 1: log likelihood of prior */ - for(unsigned int k = 0; k < K; ++k) { - priormixlik += R::dgamma(lambda(k), prior_parA(k), scale, 1); - } - /** - * step 2: log likelihood of hyperprior with start - * values of hyper parameters - */ - scale = 1.0/G; - priormixlik += R::dgamma(b, g, scale, 1); - - /** - * step 3: log likelihood of hyperprior with updated - * hyper parameters - */ - scale = 1.0/GN; - priormixlik -= R::dgamma(b, gN, scale, 1); + if (!hier) + { + priormixlik = likelihood_gamma(lambda, prior_parA(0), prior_parB(0)); + } + else /* hierarchical prior */ + { + double gN = g + K * prior_parA(0); // prior_parA must be the start value. + double GN = G + arma::accu(lambda); + double b = gN / GN; + double scale = 1.0 / b; + /* step 1: log likelihood of prior */ + for (unsigned int k = 0; k < K; ++k) + { + priormixlik += R::dgamma(lambda(k), prior_parA(k), scale, 1); + } + /** + * step 2: log likelihood of hyperprior with start + * values of hyper parameters + */ + scale = 1.0 / G; + priormixlik += R::dgamma(b, g, scale, 1); - } - return priormixlik; + /** + * step 3: log likelihood of hyperprior with updated + * hyper parameters + */ + scale = 1.0 / GN; + priormixlik -= R::dgamma(b, gN, scale, 1); + } + return priormixlik; } -inline double -priormixlik_condpoisson (const arma::rowvec& lambda, - const PriorCondPoissonFix& hyperPar) -{ - unsigned int K = lambda.n_elem; - double priormixlik = R::dunif(lambda(0), hyperPar.a, hyperPar.b, 1); - for(unsigned int k = 1; k < K; ++k) { - priormixlik += std::log(do_dtruncnorm(lambda(k), lambda(k - 1), - R_PosInf, lambda(k - 1), hyperPar.s)); - } - return priormixlik; +inline double +priormixlik_condpoisson(const arma::rowvec& lambda, + const PriorCondPoissonFix& hyperPar) +{ + unsigned int K = lambda.n_elem; + double priormixlik = R::dunif(lambda(0), hyperPar.a, hyperPar.b, 1); + + for (unsigned int k = 1; k < K; ++k) + { + priormixlik += std::log(do_dtruncnorm(lambda(k), lambda(k - 1), + R_PosInf, lambda(k - 1), hyperPar.s)); + } + return priormixlik; } // ============================================================= @@ -150,9 +157,9 @@ priormixlik_condpoisson (const arma::rowvec& lambda, /** * ------------------------------------------------------------- - * @brief Computes the prior mixture log-lieklihood for a - * Binomial distribution. - * @par lambda Poisson parameters, 1 x K + * @brief Computes the prior mixture log-lieklihood for a + * Binomial distribution. + * @par lambda Poisson parameters, 1 x K * @par prior_parA Gamma hyper shape parameters, 1 x K * @par prior_parB Gamma hyper rate parameters, 1 x K * @par hier boolean value indicating if a hierarchical @@ -166,139 +173,162 @@ priormixlik_condpoisson (const arma::rowvec& lambda, * ------------------------------------------------------------ **/ inline -double priormixlik_binomial (const arma::rowvec& p, - const arma::rowvec& prior_parA, - const arma::rowvec& prior_parB) +double priormixlik_binomial(const arma::rowvec& p, + const arma::rowvec& prior_parA, + const arma::rowvec& prior_parB) { - const unsigned int K = p.n_elem; - double priormixlik = 0.0; - for (unsigned int k = 0; k < K; ++k) { - priormixlik += (prior_parA(k) - 1.0) * std::log(p(k)) - + (prior_parB(k) - 1.0) * std::log(p(k)); - priormixlik -= R::lbeta(prior_parA(k), prior_parB(k)); - } - return priormixlik; + const unsigned int K = p.n_elem; + double priormixlik = 0.0; + + for (unsigned int k = 0; k < K; ++k) + { + priormixlik += (prior_parA(k) - 1.0) * std::log(p(k)) + + (prior_parB(k) - 1.0) * std::log(p(k)); + priormixlik -= R::lbeta(prior_parA(k), prior_parB(k)); + } + return priormixlik; } inline -double priormixlik_normal (const bool& INDEPENDENT, const bool& HIER, - const arma::rowvec& bStart, const arma::rowvec& BStart, - const arma::rowvec& cStart, const arma::rowvec& CStart, - const arma::rowvec& mu, const arma::rowvec& sigma, - const double& g, const double& G) +double priormixlik_normal(const bool& INDEPENDENT, const bool& HIER, + const arma::rowvec& bStart, const arma::rowvec& BStart, + const arma::rowvec& cStart, const arma::rowvec& CStart, + const arma::rowvec& mu, const arma::rowvec& sigma, + const double& g, const double& G) { - const unsigned int K = mu.n_elem; - double mixlik = 0.0 ; - if ( INDEPENDENT ) { - mixlik = arma::sum(arma::log(1.0 / BStart * M_PI * 2.0)); - mixlik += arma::sum(arma::pow(mu - bStart, 2.0) / (1.0 / BStart)); - mixlik *= -0.5; - } else { /* conditionally conjugate prior */ + const unsigned int K = mu.n_elem; + double mixlik = 0.0; + + if (INDEPENDENT) + { + mixlik = arma::sum(arma::log(1.0 / BStart * M_PI * 2.0)); + mixlik += arma::sum(arma::pow(mu - bStart, 2.0) / (1.0 / BStart)); + mixlik *= -0.5; + } + else /* conditionally conjugate prior */ /* here, B == N0 */ - mixlik = arma::sum(arma::log(sigma / BStart * M_PI * 2.0)); - mixlik += arma::sum(arma::pow(mu - bStart, 2.0) / (sigma / BStart)); - mixlik *= -0.5; - } - /* add likelihood for sigma */ - for (unsigned int k = 0; k < K; ++k) { - mixlik += cStart(k) * std::log(CStart(k)); - mixlik -= R::lgammafn(cStart(k)); - mixlik -= CStart(k) / sigma(k); - mixlik -= (cStart(k) + 1) * std::log(sigma(k)); - } - if (HIER) { - double gN = g + arma::sum(cStart); - double GN = G + arma::sum( 1.0 / sigma ); - double Cstar = gN / GN; - mixlik += R::dgamma(Cstar, g, 1.0 / G, 1); - mixlik -= R::dgamma(Cstar, gN, 1.0 / GN, 1); - } - return mixlik; + { + mixlik = arma::sum(arma::log(sigma / BStart * M_PI * 2.0)); + mixlik += arma::sum(arma::pow(mu - bStart, 2.0) / (sigma / BStart)); + mixlik *= -0.5; + } + /* add likelihood for sigma */ + for (unsigned int k = 0; k < K; ++k) + { + mixlik += cStart(k) * std::log(CStart(k)); + mixlik -= R::lgammafn(cStart(k)); + mixlik -= CStart(k) / sigma(k); + mixlik -= (cStart(k) + 1) * std::log(sigma(k)); + } + if (HIER) + { + double gN = g + arma::sum(cStart); + double GN = G + arma::sum(1.0 / sigma); + double Cstar = gN / GN; + mixlik += R::dgamma(Cstar, g, 1.0 / G, 1); + mixlik -= R::dgamma(Cstar, gN, 1.0 / GN, 1); + } + return mixlik; } inline -double priormixlik_normult (const bool& INDEPENDENT, const bool& HIER, - const arma::mat& bStart, const arma::cube& BInvStart,const arma::cube& BStart, - const arma::rowvec& cStart, arma::cube CStart, const arma::rowvec& logdetC, - const double& g, const arma::mat& G, const arma::mat& mu, - const arma::cube& sigma) +double priormixlik_normult(const bool& INDEPENDENT, const bool& HIER, + const arma::mat& bStart, const arma::cube& BInvStart, const arma::cube& BStart, + const arma::rowvec& cStart, arma::cube CStart, const arma::rowvec& logdetC, + const double& g, const arma::mat& G, const arma::mat& mu, + const arma::cube& sigma) { - const unsigned int K = mu.n_cols; - double mixlik = 0.0; - if (INDEPENDENT) { - mixlik += logdnormult(mu, bStart, BStart, BInvStart); - } else { /* conditionally conjugate prior */ - mixlik += logdnormult(mu, bStart, BStart, BInvStart); - } - if (HIER) { - arma::rowvec gvec(K); - gvec.fill(g); - double gN = g + arma::sum(cStart); - arma::rowvec gNvec(K); - gNvec.fill(gN); - arma::mat GN = G; - for (unsigned int k = 0; k < K; ++k) { - GN += CStart.slice(k); - } - arma::mat Cstar = gN * arma::inv(GN); - for (unsigned int k = 0; k < K; ++k) { - CStart.slice(k) = Cstar; - } - mixlik += logdwishart(CStart, gvec, G, std::log(arma::det(G))); - mixlik += logdwishart(CStart, gNvec, GN, std::log(arma::det(GN))); - } - /* Prior for sigma (Wishart for sigmainv) */ - mixlik += logdwishart(sigma, cStart, CStart, logdetC); - return mixlik; + const unsigned int K = mu.n_cols; + double mixlik = 0.0; + + if (INDEPENDENT) + { + mixlik += logdnormult(mu, bStart, BStart, BInvStart); + } + else /* conditionally conjugate prior */ + { + mixlik += logdnormult(mu, bStart, BStart, BInvStart); + } + if (HIER) + { + arma::rowvec gvec(K); + gvec.fill(g); + double gN = g + arma::sum(cStart); + arma::rowvec gNvec(K); + gNvec.fill(gN); + arma::mat GN = G; + for (unsigned int k = 0; k < K; ++k) + { + GN += CStart.slice(k); + } + arma::mat Cstar = gN * arma::inv(GN); + for (unsigned int k = 0; k < K; ++k) + { + CStart.slice(k) = Cstar; + } + mixlik += logdwishart(CStart, gvec, G, std::log(arma::det(G))); + mixlik += logdwishart(CStart, gNvec, GN, std::log(arma::det(GN))); + } + /* Prior for sigma (Wishart for sigmainv) */ + mixlik += logdwishart(sigma, cStart, CStart, logdetC); + return mixlik; } inline -double priormixlik_student (const bool& INDEPENDENT, const bool& HIER, - const arma::rowvec& bStart, const arma::rowvec BStart, - const arma::rowvec& cStart, arma::rowvec CStart, - const arma::rowvec& mu, const arma::rowvec& sigma, - const double& g, const double& G, - const arma::rowvec& df, const double& trans, - const double& a0, const double& b0, const double& d) +double priormixlik_student(const bool& INDEPENDENT, const bool& HIER, + const arma::rowvec& bStart, const arma::rowvec BStart, + const arma::rowvec& cStart, arma::rowvec CStart, + const arma::rowvec& mu, const arma::rowvec& sigma, + const double& g, const double& G, + const arma::rowvec& df, const double& trans, + const double& a0, const double& b0, const double& d) { - double loglik = priormixlik_normal(INDEPENDENT, HIER, bStart, BStart, - cStart, CStart, mu, sigma, g, G); - arma::rowvec fnu(mu.n_elem); - arma::rowvec nu = df - trans; - if (b0 == 1.0) { - fnu = std::log(d + a0) + (a0 - 1) * arma::log(nu) - - (a0 + 1) * arma::log(nu + d); - } else { - fnu = b0 * std::log(d) + (a0 - 1) * arma::log(nu) + double loglik = priormixlik_normal(INDEPENDENT, HIER, bStart, BStart, + cStart, CStart, mu, sigma, g, G); + arma::rowvec fnu(mu.n_elem); + arma::rowvec nu = df - trans; + + if (b0 == 1.0) + { + fnu = std::log(d + a0) + (a0 - 1) * arma::log(nu) + - (a0 + 1) * arma::log(nu + d); + } + else + { + fnu = b0 * std::log(d) + (a0 - 1) * arma::log(nu) - (a0 + b0) * arma::log(nu + d) - R::lbeta(a0, b0); - } - loglik += arma::sum(fnu); - return loglik; + } + loglik += arma::sum(fnu); + return loglik; } -inline -double priormixlik_studmult (const bool& INDEPENDENT, const bool& HIER, - const arma::mat& bStart, const arma::cube BInvStart, - const arma::cube& BStart, const arma::rowvec& cStart, - arma::cube CStart, const arma::rowvec& logdetC, - const double& g, const arma::mat& G, const arma::mat& mu, - const arma::cube& sigma, const arma::rowvec& df, - const double& trans, const double& a0, const double& b0, - const double& d) +inline +double priormixlik_studmult(const bool& INDEPENDENT, const bool& HIER, + const arma::mat& bStart, const arma::cube BInvStart, + const arma::cube& BStart, const arma::rowvec& cStart, + arma::cube CStart, const arma::rowvec& logdetC, + const double& g, const arma::mat& G, const arma::mat& mu, + const arma::cube& sigma, const arma::rowvec& df, + const double& trans, const double& a0, const double& b0, + const double& d) { - double loglik = priormixlik_normult(INDEPENDENT, HIER, - bStart, BInvStart, BStart, cStart, CStart, logdetC, - g, G, mu, sigma); - arma::rowvec fnu(mu.n_elem); - arma::rowvec nu = df - trans; - if (b0 == 1.0) { - fnu = std::log(d + a0) + (a0 - 1.0) * arma::log(nu) - - (a0 + 1.0) * arma::log(nu + d); - } else { - fnu = b0 * std::log(d) + (a0 - 1.0) * arma::log(nu) + double loglik = priormixlik_normult(INDEPENDENT, HIER, + bStart, BInvStart, BStart, cStart, CStart, logdetC, + g, G, mu, sigma); + arma::rowvec fnu(mu.n_elem); + arma::rowvec nu = df - trans; + + if (b0 == 1.0) + { + fnu = std::log(d + a0) + (a0 - 1.0) * arma::log(nu) + - (a0 + 1.0) * arma::log(nu + d); + } + else + { + fnu = b0 * std::log(d) + (a0 - 1.0) * arma::log(nu) - (a0 + b0) * arma::log(nu + d) - R::lbeta(a0, b0); - } - loglik += arma::sum(fnu); - return loglik; + } + loglik += arma::sum(fnu); + return loglik; } #endif diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index 310dd43..5959d62 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -1,25 +1,25 @@ /****************************************************************************** - * - * Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. - * - * Author: Lars Simon Zehnder - * - * This file is part of the R package finmix. - * - * finmix is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published - * by the Free Software Foundatio, either version 3 of the License, or - * any later version. - * - * finmix is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with finmix. If not, see . - * - ******************************************************************************/ +* +* Copyright (C) 2013 Lars Simon Zehnder. All Rights Reserved. +* +* Author: Lars Simon Zehnder +* +* This file is part of the R package finmix. +* +* finmix is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published +* by the Free Software Foundatio, either version 3 of the License, or +* any later version. +* +* finmix is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with finmix. If not, see . +* +******************************************************************************/ // [[Rcpp::depends(RcppArmadillo)]] @@ -37,16 +37,16 @@ /** * ------------------------------------------------------------ * stephens1997a_poisson_cc - * @brief Defines Stephens (1997a) relabelling algorithm for - * Poisson models. The nlopt library is used for + * @brief Defines Stephens (1997a) relabelling algorithm for + * Poisson models. The nlopt library is used for * optimization (Nelder-Mead algorithm) * @par values1 sampled lambda parameters; M x K * @par values2 sampled weight parameters; M x K * @par pars Gamma and Dirichlet hyper parameters * @par perm matrix with all possible permutations of labels; - * @return matrix indicating the optimal labeling of sampled + * @return matrix indicating the optimal labeling of sampled * parameters; M x K - * @detail See Stephens (1997a) + * @detail See Stephens (1997a) * @see nlopt * @author Lars Simon Zehnder * ------------------------------------------------------------ @@ -54,83 +54,92 @@ // [[Rcpp::export]] -arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, - Rcpp::NumericMatrix values2, - arma::vec pars, const arma::umat perm) +arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, + Rcpp::NumericMatrix values2, + arma::vec pars, const arma::umat perm) { - const unsigned int M = values1.rows(); - const unsigned int K = values1.cols(); - const unsigned int P = perm.n_rows; - const unsigned int n = pars.n_elem; - double value = 0.0; - double value_next = -10.0e-8; - arma::mat lambda(values1.begin(), M, K, true, true); - arma::mat weight(values2.begin(), M, K, true, true); - const arma::umat arma_perm = perm - 1; - arma::uvec row_index = arma::linspace(0, M - 1, M); - arma::uvec col_index(K); - arma::vec tmp(M); - arma::vec tmp2(K); - arma::umat index = arma::ones(M, K); - arma::umat ind(M, K); - arma::vec dirich(K); - arma::vec shape(K); - arma::vec rate(K); - arma::mat func_val(M, K); - for (unsigned int k = 0; k < K; ++k) { - index.unsafe_col(k) *= k; - } - /* Set up the optimizer */ - std::vector f_data(2); - f_data[0] = λ - f_data[1] = &weight; - nlopt_opt optim; - optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); - double lower_bound = 10e-6; - nlopt_set_lower_bounds1(optim, lower_bound); - nlopt_set_max_objective(optim, obj_stephens1997a_poisson, &f_data); - while (value != value_next) { - value = value_next; - nlopt_optimize(optim, pars.memptr(), &value_next); - for (unsigned int k = 0; k < K; ++k) { - dirich.at(k) = pars[k]; - shape.at(k) = pars[k + K]; - rate.at(k) = pars[k + 2 * K]; - } - /* Loop over permutations */ - for (unsigned int p = 0; p < P; ++p) { - tmp = arma::prod(arma::exp(ldgamma(lambda(row_index, arma_perm.row(p)), shape, rate)), 1); - tmp %= arma::exp(lddirichlet(weight(row_index, arma_perm.row(p)), dirich)); - func_val.unsafe_col(p) = arma::log(tmp); - } - for (unsigned int m = 0; m < M; ++m) { - tmp2 = arma::conv_to::from(func_val.row(m)); - col_index = arma::sort_index(tmp2, "descend"); - ind.row(m) = arma_perm.row(col_index(0)); - } - swapmat_by_index(lambda, ind); - swapmat_by_index(weight, ind); - swapumat_by_index(index, ind); - } - nlopt_destroy(optim); - index += 1; - return arma::conv_to::from(index); + const unsigned int M = values1.rows(); + const unsigned int K = values1.cols(); + const unsigned int P = perm.n_rows; + const unsigned int n = pars.n_elem; + double value = 0.0; + double value_next = -10.0e-8; + arma::mat lambda(values1.begin(), M, K, true, true); + arma::mat weight(values2.begin(), M, K, true, true); + const arma::umat arma_perm = perm - 1; + arma::uvec row_index = arma::linspace(0, M - 1, M); + arma::uvec col_index(K); + arma::vec tmp(M); + arma::vec tmp2(K); + arma::umat index = arma::ones(M, K); + arma::umat ind(M, K); + arma::vec dirich(K); + arma::vec shape(K); + arma::vec rate(K); + arma::mat func_val(M, K); + + for (unsigned int k = 0; k < K; ++k) + { + index.unsafe_col(k) *= k; + } + /* Set up the optimizer */ + std::vector f_data(2); + + f_data[0] = λ + f_data[1] = &weight; + nlopt_opt optim; + + optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); + double lower_bound = 10e-6; + + nlopt_set_lower_bounds1(optim, lower_bound); + nlopt_set_max_objective(optim, obj_stephens1997a_poisson, &f_data); + while (value != value_next) + { + value = value_next; + nlopt_optimize(optim, pars.memptr(), &value_next); + for (unsigned int k = 0; k < K; ++k) + { + dirich.at(k) = pars[k]; + shape.at(k) = pars[k + K]; + rate.at(k) = pars[k + 2 * K]; + } + /* Loop over permutations */ + for (unsigned int p = 0; p < P; ++p) + { + tmp = arma::prod(arma::exp(ldgamma(lambda(row_index, arma_perm.row(p)), shape, rate)), 1); + tmp %= arma::exp(lddirichlet(weight(row_index, arma_perm.row(p)), dirich)); + func_val.unsafe_col(p) = arma::log(tmp); + } + for (unsigned int m = 0; m < M; ++m) + { + tmp2 = arma::conv_to::from(func_val.row(m)); + col_index = arma::sort_index(tmp2, "descend"); + ind.row(m) = arma_perm.row(col_index(0)); + } + swapmat_by_index(lambda, ind); + swapmat_by_index(weight, ind); + swapumat_by_index(index, ind); + } + nlopt_destroy(optim); + index += 1; + return arma::conv_to::from(index); } /** * ------------------------------------------------------------ * stephens1997a_poisson_cc - * @brief Defines Stephens (1997a) relabelling algorithm for - * Binomial models. The nlopt library is used for + * @brief Defines Stephens (1997a) relabelling algorithm for + * Binomial models. The nlopt library is used for * optimization (Nelder-Mead algorithm) * @par values1 sampled lambda parameters; M x K * @par values2 sampled weight parameters; M x K * @par pars Beta and Dirichlet hyper parameters * @par perm matrix with all possible permutations of labels; - * @return matrix indicating the optimal labeling of sampled + * @return matrix indicating the optimal labeling of sampled * parameters; M x K - * @detail See Stephens (1997a) + * @detail See Stephens (1997a) * @see nlopt * @author Lars Simon Zehnder * ------------------------------------------------------------ @@ -138,344 +147,386 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, // [[Rcpp::export]] -arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, - Rcpp::NumericMatrix values2, - arma::vec pars, const arma::umat perm) +arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, + Rcpp::NumericMatrix values2, + arma::vec pars, const arma::umat perm) { - const unsigned int M = values1.rows(); - const unsigned int K = values2.cols(); - const unsigned int P = perm.n_rows; - const unsigned int n = pars.n_elem; - double value = 1.0; - double value_next = -10.0e-8; - arma::mat pp(values1.begin(), M, K, true, true); - arma::mat weight(values2.begin(), M, K, true, true); - const arma::umat arma_perm = perm - 1; - arma::uvec row_index(M); - arma::uvec col_index(K); - arma::vec tmp(M); - arma::vec tmp2(K); - arma::umat index = arma::ones(M, K); - arma::umat ind(M, K); - arma::vec dirich(K); - arma::vec shape1(K); - arma::vec shape2(K); - arma::mat func_val(M, K); - for (unsigned int k = 0; k < K; ++k) { - index.unsafe_col(k) *= k; - } - for (unsigned int m = 0; m < M; ++m) { - row_index.at(m) = m; - } - /* Set up the optimizer */ - nlopt_opt optim; - optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); - std::vector f_data(2); - f_data[0] = &pp; - f_data[1] = &weight; - double lower_bound[1] = {1e-10}; - double upper_bound[1] = {1e+7}; - nlopt_set_lower_bounds(optim, lower_bound); - nlopt_set_upper_bounds(optim, upper_bound); - nlopt_set_max_objective(optim, obj_stephens1997a_binomial, &f_data); - - while (value != value_next) { - value = value_next; - nlopt_optimize(optim, pars.memptr(), &value_next); - for (unsigned int k = 0; k < K; ++k) { - dirich.at(k) = pars[k]; - shape1.at(k) = pars[k + K]; - shape2.at(k) = pars[k + 2 * K]; - } - /* Loop over permutations */ - for (unsigned int p = 0; p < P; ++p) { - tmp = arma::prod(arma::exp(ldbeta(pp(row_index, arma_perm.row(p)), shape1, shape2)), 1); - tmp %= arma::exp(lddirichlet(weight(row_index, arma_perm.row(p)), dirich)); - func_val.unsafe_col(p) = arma::log(tmp); - } - for (unsigned int m = 0; m < M; ++m) { - tmp2 = arma::conv_to::from(func_val.row(m)); - col_index = arma::sort_index(tmp2, "descend"); - ind.row(m) = arma_perm.row(col_index(0)); - } - - swapmat_by_index(pp, ind); - swapmat_by_index(weight, ind); - swapumat_by_index(index, ind); - - } - nlopt_destroy(optim); - index += 1; - return arma::conv_to::from(index); + const unsigned int M = values1.rows(); + const unsigned int K = values2.cols(); + const unsigned int P = perm.n_rows; + const unsigned int n = pars.n_elem; + double value = 1.0; + double value_next = -10.0e-8; + arma::mat pp(values1.begin(), M, K, true, true); + arma::mat weight(values2.begin(), M, K, true, true); + const arma::umat arma_perm = perm - 1; + arma::uvec row_index(M); + arma::uvec col_index(K); + arma::vec tmp(M); + arma::vec tmp2(K); + arma::umat index = arma::ones(M, K); + arma::umat ind(M, K); + arma::vec dirich(K); + arma::vec shape1(K); + arma::vec shape2(K); + arma::mat func_val(M, K); + + for (unsigned int k = 0; k < K; ++k) + { + index.unsafe_col(k) *= k; + } + for (unsigned int m = 0; m < M; ++m) + { + row_index.at(m) = m; + } + /* Set up the optimizer */ + nlopt_opt optim; + + optim = nlopt_create(NLOPT_LN_NELDERMEAD, n); + std::vector f_data(2); + + f_data[0] = &pp; + f_data[1] = &weight; + double lower_bound[1] = { 1e-10 }; + double upper_bound[1] = { 1e+7 }; + + nlopt_set_lower_bounds(optim, lower_bound); + nlopt_set_upper_bounds(optim, upper_bound); + nlopt_set_max_objective(optim, obj_stephens1997a_binomial, &f_data); + + while (value != value_next) + { + value = value_next; + nlopt_optimize(optim, pars.memptr(), &value_next); + for (unsigned int k = 0; k < K; ++k) + { + dirich.at(k) = pars[k]; + shape1.at(k) = pars[k + K]; + shape2.at(k) = pars[k + 2 * K]; + } + /* Loop over permutations */ + for (unsigned int p = 0; p < P; ++p) + { + tmp = arma::prod(arma::exp(ldbeta(pp(row_index, arma_perm.row(p)), shape1, shape2)), 1); + tmp %= arma::exp(lddirichlet(weight(row_index, arma_perm.row(p)), dirich)); + func_val.unsafe_col(p) = arma::log(tmp); + } + for (unsigned int m = 0; m < M; ++m) + { + tmp2 = arma::conv_to::from(func_val.row(m)); + col_index = arma::sort_index(tmp2, "descend"); + ind.row(m) = arma_perm.row(col_index(0)); + } + + swapmat_by_index(pp, ind); + swapmat_by_index(weight, ind); + swapumat_by_index(index, ind); + } + nlopt_destroy(optim); + index += 1; + return arma::conv_to::from(index); } // [[Rcpp::export]] -arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, - Rcpp::NumericMatrix comp_par, - Rcpp::NumericMatrix weight_par, - signed int max_iter=200) +arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, + Rcpp::NumericMatrix comp_par, + Rcpp::NumericMatrix weight_par, + signed int max_iter = 200) { - unsigned int N = values.size(); - unsigned int M = comp_par.rows(); - unsigned int K = comp_par.cols(); - double value = 1.0; - double value_next = 0.0; - arma::vec arma_values(values.begin(), N, false, true); - arma::mat lambda(comp_par.begin(), M, K, true, true); - arma::mat weight(weight_par.begin(), M, K, true, true); - arma::umat index(M, K); - arma::umat index_out(M, K); - arma::umat indM(K, K); - arma::mat pmat_hat(N, K); - arma::mat cost(K, K); - arma::uvec seq_vec(K); - std::vector mat_vector(M); - pmat_hat = arma::zeros(N, K); - index_out = arma::ones(M, K); - for (unsigned int k = 0; k < K; ++k) { - seq_vec.at(k) = k * K; - index_out.unsafe_col(k) *= (k + 1); - } - for (unsigned int m = 0; m < M; ++m) { - arma::mat* pmat_ptr = new arma::mat(N, K); - /* Save a pointer to the STL vector */ - mat_vector[m] = pmat_ptr; - } - signed int iter = 0; - while (value != value_next){ - iter += 1; - value = value_next; - value_next = 0.0; - /* For all sampled MCMC parameters a matrix - * pmat (N x K) is computed with p_ij - * indicating the probability for a value i - * being from component j. - * */ - for (unsigned int m = 0; m < M; ++m) { - for (unsigned int n = 0; n < N; ++n) { - mat_vector[m]->row(n) = weight.row(m) - % dpoisson(arma_values.at(n), lambda.row(m)); - mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); - } - pmat_hat += *(mat_vector[m]); - } - /* This computes the reference estimator P_hat*/ - pmat_hat /= M; - /* Now for each sampled MCMC parameter it is - * searched for the optimal label by computing - * the Kullback-Leibler distance of each 'pmat' - * column 'l' from column 'k' of the reference - * estimator P_hat. - * The cost matrix cost_mat contains then the - * distance of column 'l' from column 'k'. - * An optimal assignment method computes the minimal - * 'cost' regarding the labeling. - * If 'k' is therein assigned to 'l', than the - * label 'k' is switched to 'l'. - * */ - for (unsigned int m = 0; m < M; ++m) { - for (unsigned int k = 0; k < K; ++k) { - for (unsigned int l = 0; l < K; ++l) { - cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), - pmat_hat.unsafe_col(k)); - } + unsigned int N = values.size(); + unsigned int M = comp_par.rows(); + unsigned int K = comp_par.cols(); + double value = 1.0; + double value_next = 0.0; + arma::vec arma_values(values.begin(), N, false, true); + arma::mat lambda(comp_par.begin(), M, K, true, true); + arma::mat weight(weight_par.begin(), M, K, true, true); + arma::umat index(M, K); + arma::umat index_out(M, K); + arma::umat indM(K, K); + arma::mat pmat_hat(N, K); + arma::mat cost(K, K); + arma::uvec seq_vec(K); + std::vector mat_vector(M); + + pmat_hat = arma::zeros(N, K); + index_out = arma::ones(M, K); + for (unsigned int k = 0; k < K; ++k) + { + seq_vec.at(k) = k * K; + index_out.unsafe_col(k) *= (k + 1); + } + for (unsigned int m = 0; m < M; ++m) + { + arma::mat* pmat_ptr = new arma::mat(N, K); + /* Save a pointer to the STL vector */ + mat_vector[m] = pmat_ptr; + } + signed int iter = 0; + + while (value != value_next) + { + iter += 1; + value = value_next; + value_next = 0.0; + /* For all sampled MCMC parameters a matrix + * pmat (N x K) is computed with p_ij + * indicating the probability for a value i + * being from component j. + * */ + for (unsigned int m = 0; m < M; ++m) + { + for (unsigned int n = 0; n < N; ++n) + { + mat_vector[m]->row(n) = weight.row(m) + % dpoisson(arma_values.at(n), lambda.row(m)); + mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); + } + pmat_hat += *(mat_vector[m]); + } + /* This computes the reference estimator P_hat*/ + pmat_hat /= M; + /* Now for each sampled MCMC parameter it is + * searched for the optimal label by computing + * the Kullback-Leibler distance of each 'pmat' + * column 'l' from column 'k' of the reference + * estimator P_hat. + * The cost matrix cost_mat contains then the + * distance of column 'l' from column 'k'. + * An optimal assignment method computes the minimal + * 'cost' regarding the labeling. + * If 'k' is therein assigned to 'l', than the + * label 'k' is switched to 'l'. + * */ + for (unsigned int m = 0; m < M; ++m) + { + for (unsigned int k = 0; k < K; ++k) + { + for (unsigned int l = 0; l < K; ++l) + { + cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), + pmat_hat.unsafe_col(k)); } - value_next += arma::trace(cost); - /* Assignment */ - indM = hungarian(cost); - arma::uvec f = arma::find(indM.t() == 1); - index.row(m) = arma::trans(arma::find(indM.t() == 1) - seq_vec); - } - /* Permute parameters */ - swapmat_by_index(lambda, index); - swapmat_by_index(weight, index); - swapumat_by_index(index_out, index); - pmat_hat.fill(0.0); - } - for (unsigned int m = 0; m < M; ++m) { - delete mat_vector[m]; - } - return arma::conv_to::from(index_out); + } + value_next += arma::trace(cost); + /* Assignment */ + indM = hungarian(cost); + arma::uvec f = arma::find(indM.t() == 1); + index.row(m) = arma::trans(arma::find(indM.t() == 1) - seq_vec); + } + /* Permute parameters */ + swapmat_by_index(lambda, index); + swapmat_by_index(weight, index); + swapumat_by_index(index_out, index); + pmat_hat.fill(0.0); + } + for (unsigned int m = 0; m < M; ++m) + { + delete mat_vector[m]; + } + return arma::conv_to::from(index_out); } // [[Rcpp::export]] -arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, - Rcpp::NumericVector reps, Rcpp::NumericMatrix comp_par, - Rcpp::NumericMatrix weight_par) +arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, + Rcpp::NumericVector reps, Rcpp::NumericMatrix comp_par, + Rcpp::NumericMatrix weight_par) { - unsigned int N = values.size(); - unsigned int M = comp_par.rows(); - unsigned int K = comp_par.cols(); - double value = 1.0; - double value_next = 0.0; - arma::vec arma_values(values.begin(), N, false, true); - arma::vec arma_reps(reps.begin(), N, false, true); - arma::mat p(comp_par.begin(), M, K, true, true); - arma::mat weight(weight_par.begin(), M, K, true, true); - arma::umat index(M, K); - arma::umat index_out(M, K); - arma::umat indM(K, K); - arma::mat pmat_hat(N, K); - arma::mat cost(K, K); - arma::uvec seq_vec(K); - std::vector mat_vector(M); - pmat_hat = arma::zeros(N, K); - index_out = arma::ones(M, K); - for (unsigned int k = 0; k < K; ++k) { - seq_vec.at(k) = k * K; - index_out.unsafe_col(k) *= (k + 1); - } - for (unsigned int m = 0; m < M; ++m) { - arma::mat* pmat_ptr = new arma::mat(N, K); - /* Save a pointer to the STL vector */ - mat_vector[m] = pmat_ptr; - } - while (value != value_next) { - value = value_next; - value_next = 0.0; - /* For all sampled MCMC parameters a matrix - * pmat (N x K) is computed with p_ij - * indicating the probability for a value i - * being from component j. - * */ - for (unsigned int m = 0; m < M; ++m) { - for (unsigned int n = 0; n < N; ++n) { - mat_vector[m]->row(n) = weight.row(m) - % dbinomial(arma_values.at(n), arma_reps.at(n), p.row(m)); - mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); - } - } - for (unsigned int m = 0; m < M; ++m) { - pmat_hat += *(mat_vector[m]); - } - /* This computes the reference estimator P_hat*/ - pmat_hat /= M; - /* Now for each sampled MCMC parameter it is - * searched for the optimal label by computing - * the Kullback-Leibler distance of each 'pmat' - * column 'l' from column 'k' of the reference - * estimator P_hat. - * The cost matrix cost_mat contains then the - * distance of column 'l' from column 'k'. - * An optimal assignment method computes the minimal - * 'cost' regarding the labeling. - * If 'k' is therein assigned to 'l', than the - * label 'k' is switched to 'l'. - * */ - for (unsigned int m = 0; m < M; ++m) { - for (unsigned int k = 0; k < K; ++k) { - for (unsigned int l = 0; l < K; ++l) { - cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), - pmat_hat.unsafe_col(k)); - } + unsigned int N = values.size(); + unsigned int M = comp_par.rows(); + unsigned int K = comp_par.cols(); + double value = 1.0; + double value_next = 0.0; + arma::vec arma_values(values.begin(), N, false, true); + arma::vec arma_reps(reps.begin(), N, false, true); + arma::mat p(comp_par.begin(), M, K, true, true); + arma::mat weight(weight_par.begin(), M, K, true, true); + arma::umat index(M, K); + arma::umat index_out(M, K); + arma::umat indM(K, K); + arma::mat pmat_hat(N, K); + arma::mat cost(K, K); + arma::uvec seq_vec(K); + std::vector mat_vector(M); + + pmat_hat = arma::zeros(N, K); + index_out = arma::ones(M, K); + for (unsigned int k = 0; k < K; ++k) + { + seq_vec.at(k) = k * K; + index_out.unsafe_col(k) *= (k + 1); + } + for (unsigned int m = 0; m < M; ++m) + { + arma::mat* pmat_ptr = new arma::mat(N, K); + /* Save a pointer to the STL vector */ + mat_vector[m] = pmat_ptr; + } + while (value != value_next) + { + value = value_next; + value_next = 0.0; + /* For all sampled MCMC parameters a matrix + * pmat (N x K) is computed with p_ij + * indicating the probability for a value i + * being from component j. + * */ + for (unsigned int m = 0; m < M; ++m) + { + for (unsigned int n = 0; n < N; ++n) + { + mat_vector[m]->row(n) = weight.row(m) + % dbinomial(arma_values.at(n), arma_reps.at(n), p.row(m)); + mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); + } + } + for (unsigned int m = 0; m < M; ++m) + { + pmat_hat += *(mat_vector[m]); + } + /* This computes the reference estimator P_hat*/ + pmat_hat /= M; + /* Now for each sampled MCMC parameter it is + * searched for the optimal label by computing + * the Kullback-Leibler distance of each 'pmat' + * column 'l' from column 'k' of the reference + * estimator P_hat. + * The cost matrix cost_mat contains then the + * distance of column 'l' from column 'k'. + * An optimal assignment method computes the minimal + * 'cost' regarding the labeling. + * If 'k' is therein assigned to 'l', than the + * label 'k' is switched to 'l'. + * */ + for (unsigned int m = 0; m < M; ++m) + { + for (unsigned int k = 0; k < K; ++k) + { + for (unsigned int l = 0; l < K; ++l) + { + cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), + pmat_hat.unsafe_col(k)); } - value_next += arma::trace(cost); - /* Assignment */ - indM = hungarian(cost); - arma::uvec f = arma::find(indM.t() == 1); - index.row(m) = arma::trans(arma::find(indM.t() == 1) - seq_vec); - } - /* Permute parameters */ - swapmat_by_index(p, index); - swapmat_by_index(weight, index); - swapumat_by_index(index_out, index); - pmat_hat.fill(0.0); - } - for (unsigned int m = 0; m < M; ++m) { - delete mat_vector[m]; - } - return arma::conv_to::from(index_out); + } + value_next += arma::trace(cost); + /* Assignment */ + indM = hungarian(cost); + arma::uvec f = arma::find(indM.t() == 1); + index.row(m) = arma::trans(arma::find(indM.t() == 1) - seq_vec); + } + /* Permute parameters */ + swapmat_by_index(p, index); + swapmat_by_index(weight, index); + swapumat_by_index(index_out, index); + pmat_hat.fill(0.0); + } + for (unsigned int m = 0; m < M; ++m) + { + delete mat_vector[m]; + } + return arma::conv_to::from(index_out); } // [[Rcpp::export]] -arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, - Rcpp::NumericMatrix comp_par, - Rcpp::NumericMatrix weight_par) +arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, + Rcpp::NumericMatrix comp_par, + Rcpp::NumericMatrix weight_par) { - unsigned int N = values.size(); - unsigned int M = comp_par.rows(); - unsigned int K = comp_par.cols(); - double value = 1.0; - double value_next = 0.0; - arma::vec arma_values(values.begin(), N, false, true); - arma::mat lambda(comp_par.begin(), M, K, true, true); - arma::mat weight(weight_par.begin(), M, K, true, true); - arma::umat index(M, K); - arma::umat index_out(M, K); - arma::umat indM(K, K); - arma::mat pmat_hat(N, K); - arma::mat cost(K, K); - arma::uvec seq_vec(K); - std::vector mat_vector(M); - pmat_hat = arma::zeros(N, K); - index_out = arma::ones(M, K); - for (unsigned int k = 0; k < K; ++k) { - seq_vec.at(k) = k * K; - index_out.unsafe_col(k) *= (k + 1); - } - for (unsigned int m = 0; m < M; ++m) { - arma::mat* pmat_ptr = new arma::mat(N, K); - /* Save a pointer to the STL vector */ - mat_vector[m] = pmat_ptr; - } - while (value != value_next) { - value = value_next; - value_next = 0.0; - /* For all sampled MCMC parameters a matrix - * pmat (N x K) is computed with p_ij - * indicating the probability for a value i - * being from component j. - * */ - for (unsigned int m = 0; m < M; ++m) { - for (unsigned int n = 0; n < N; ++n) { - mat_vector[m]->row(n) = weight.row(m) - % dexponential(arma_values.at(n), lambda.row(m)); - mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); - } - } - for (unsigned int m = 0; m < M; ++m) { - pmat_hat += *(mat_vector[m]); - } - /* This computes the reference estimator P_hat*/ - pmat_hat /= M; - /* Now for each sampled MCMC parameter it is - * searched for the optimal label by computing - * the Kullback-Leibler distance of each 'pmat' - * column 'l' from column 'k' of the reference - * estimator P_hat. - * The cost matrix cost_mat contains then the - * distance of column 'l' from column 'k'. - * An optimal assignment method computes the minimal - * 'cost' regarding the labeling. - * If 'k' is therein assigned to 'l', than the - * label 'k' is switched to 'l'. - * */ - for (unsigned int m = 0; m < M; ++m) { - for (unsigned int k = 0; k < K; ++k) { - for (unsigned int l = 0; l < K; ++l) { - arma::vec mycol = mat_vector[m]->unsafe_col(l); - cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), - pmat_hat.unsafe_col(k)); - } + unsigned int N = values.size(); + unsigned int M = comp_par.rows(); + unsigned int K = comp_par.cols(); + double value = 1.0; + double value_next = 0.0; + arma::vec arma_values(values.begin(), N, false, true); + arma::mat lambda(comp_par.begin(), M, K, true, true); + arma::mat weight(weight_par.begin(), M, K, true, true); + arma::umat index(M, K); + arma::umat index_out(M, K); + arma::umat indM(K, K); + arma::mat pmat_hat(N, K); + arma::mat cost(K, K); + arma::uvec seq_vec(K); + std::vector mat_vector(M); + + pmat_hat = arma::zeros(N, K); + index_out = arma::ones(M, K); + for (unsigned int k = 0; k < K; ++k) + { + seq_vec.at(k) = k * K; + index_out.unsafe_col(k) *= (k + 1); + } + for (unsigned int m = 0; m < M; ++m) + { + arma::mat* pmat_ptr = new arma::mat(N, K); + /* Save a pointer to the STL vector */ + mat_vector[m] = pmat_ptr; + } + while (value != value_next) + { + value = value_next; + value_next = 0.0; + /* For all sampled MCMC parameters a matrix + * pmat (N x K) is computed with p_ij + * indicating the probability for a value i + * being from component j. + * */ + for (unsigned int m = 0; m < M; ++m) + { + for (unsigned int n = 0; n < N; ++n) + { + mat_vector[m]->row(n) = weight.row(m) + % dexponential(arma_values.at(n), lambda.row(m)); + mat_vector[m]->row(n) /= arma::sum(mat_vector[m]->row(n)); + } + } + for (unsigned int m = 0; m < M; ++m) + { + pmat_hat += *(mat_vector[m]); + } + /* This computes the reference estimator P_hat*/ + pmat_hat /= M; + /* Now for each sampled MCMC parameter it is + * searched for the optimal label by computing + * the Kullback-Leibler distance of each 'pmat' + * column 'l' from column 'k' of the reference + * estimator P_hat. + * The cost matrix cost_mat contains then the + * distance of column 'l' from column 'k'. + * An optimal assignment method computes the minimal + * 'cost' regarding the labeling. + * If 'k' is therein assigned to 'l', than the + * label 'k' is switched to 'l'. + * */ + for (unsigned int m = 0; m < M; ++m) + { + for (unsigned int k = 0; k < K; ++k) + { + for (unsigned int l = 0; l < K; ++l) + { + arma::vec mycol = mat_vector[m]->unsafe_col(l); + cost(k, l) = kulback_leibler(mat_vector[m]->unsafe_col(l), + pmat_hat.unsafe_col(k)); } - value_next += arma::trace(cost); - /* Assignment */ - indM = hungarian(cost); - arma::uvec f = arma::find(indM.t() == 1); - index.row(m) = arma::trans(arma::find(indM.t() == 1) - seq_vec); - } - /* Permute parameters */ - swapmat_by_index(lambda, index); - swapmat_by_index(weight, index); - swapumat_by_index(index_out, index); - pmat_hat.fill(0.0); - } - for (unsigned int m = 0; m < M; ++m) { - delete mat_vector[m]; - } - return arma::conv_to::from(index_out); + } + value_next += arma::trace(cost); + /* Assignment */ + indM = hungarian(cost); + arma::uvec f = arma::find(indM.t() == 1); + index.row(m) = arma::trans(arma::find(indM.t() == 1) - seq_vec); + } + /* Permute parameters */ + swapmat_by_index(lambda, index); + swapmat_by_index(weight, index); + swapumat_by_index(index_out, index); + pmat_hat.fill(0.0); + } + for (unsigned int m = 0; m < M; ++m) + { + delete mat_vector[m]; + } + return arma::conv_to::from(index_out); } diff --git a/src/rtruncnorm.h b/src/rtruncnorm.h index 81b1e20..7ade9a5 100644 --- a/src/rtruncnorm.h +++ b/src/rtruncnorm.h @@ -1,22 +1,22 @@ /****************************************************************************** - * - * TODO: Project Title - * - * Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. - * Web: http://www.ascolab.com - * - * Author: Gerhard Gappmeier - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - * - ******************************************************************************/ +* +* TODO: Project Title +* +* Copyright (C) 2003-2009 ascolab GmbH. All Rights Reserved. +* Web: http://www.ascolab.com +* +* Author: Gerhard Gappmeier +* +* This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE +* WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +* +******************************************************************************/ #ifndef __FINMIX_RTRUNCNORM_H__ #define __FINMIX_RTRUNCNORM_H__ #define _USE_MATH_DEFINES -#define M1_SQRT_2PI std::sqrt(2 * M_PI) +#define M1_SQRT_2PI std::sqrt(2 * M_PI) #include #include @@ -27,176 +27,229 @@ static const double t3 = 0.725; static const double t4 = 0.45; inline -static double ers_a_inf (const double& a) +static double ers_a_inf(const double& a) { - const double ainv = 1.0 / a; - double x, rho; - do { - x = R::rexp(ainv) + a; /* rexp works with 1/lambda */ - rho = std::exp(-0.5 * std::pow((x - a), 2.0)); - } while (R::runif(0.0, 1.0) > rho); - return x; + const double ainv = 1.0 / a; + double x, rho; + + do + { + x = R::rexp(ainv) + a; /* rexp works with 1/lambda */ + rho = std::exp(-0.5 * std::pow((x - a), 2.0)); + } while (R::runif(0.0, 1.0) > rho); + return x; } /* Exponential rejection sampling (a,b) */ inline -static double ers_a_b (const double& a, const double& b) +static double ers_a_b(const double& a, const double& b) { - const double ainv = 1.0 / a; - double x, rho; - do { - x = R::rexp(ainv) + a; /* rexp works with 1/lambda */ - rho = exp(-0.5 * std::pow((x - a), 2.0)); - } while (R::runif(0.0, 1.0) > rho || x > b); - return x; + const double ainv = 1.0 / a; + double x, rho; + + do + { + x = R::rexp(ainv) + a; /* rexp works with 1/lambda */ + rho = exp(-0.5 * std::pow((x - a), 2.0)); + } while (R::runif(0.0, 1.0) > rho || x > b); + return x; } /* Normal rejection sampling (a,b) */ inline -static double nrs_a_b (const double& a, const double& b) +static double nrs_a_b(const double& a, const double& b) { - double x = a - 1.0; - while (x < a || x > b) { - x = R::rnorm(0.0, 1.0); - } - return x; + double x = a - 1.0; + + while (x < a || x > b) + { + x = R::rnorm(0.0, 1.0); + } + return x; } /* Normal rejection sampling (a,inf) */ inline -static double nrs_a_inf (const double & a) +static double nrs_a_inf(const double & a) { - double x = a - 1.0; - while (x < a) { - x = R::rnorm(0.0, 1.0); - } - return x; + double x = a - 1.0; + + while (x < a) + { + x = R::rnorm(0.0, 1.0); + } + return x; } /* Half-normal rejection sampling */ inline -static double hnrs_a_b (const double& a, const double& b) +static double hnrs_a_b(const double& a, const double& b) { - double x = a - 1.0; - while (x < a || x > b) { - x = R::rnorm(0.0, 1.0); - x = std::fabs(x); - } - return x; + double x = a - 1.0; + + while (x < a || x > b) + { + x = R::rnorm(0.0, 1.0); + x = std::fabs(x); + } + return x; } /* Uniform rejection sampling */ inline -static double urs_a_b (const double& a, const double& b) +static double urs_a_b(const double& a, const double& b) { - const double phi_a = R::dnorm(a, 0.0, 1.0, 0); - double x = 0.0; - - /* Upper bound of normal density on [a,b] */ - const double ub = a < 0.0 && b > 0.0 ? M1_SQRT_2PI : phi_a; - do { - x = R::runif(a, b); - } while (R::runif(0.0, 1.0) * ub > R::dnorm(x, 0.0, 1.0, 0)); - return x; + const double phi_a = R::dnorm(a, 0.0, 1.0, 0); + double x = 0.0; + + /* Upper bound of normal density on [a,b] */ + const double ub = a < 0.0 && b > 0.0 ? M1_SQRT_2PI : phi_a; + + do + { + x = R::runif(a, b); + } while (R::runif(0.0, 1.0) * ub > R::dnorm(x, 0.0, 1.0, 0)); + return x; } /* Previously this was referred to as type 1 sampling: */ inline -static double r_lefttruncnorm (const double& a, const double& mean, - const double& sd) +static double r_lefttruncnorm(const double& a, const double& mean, + const double& sd) { - const double alpha = (a - mean) / sd; - if (alpha < t4) { - return mean + sd * nrs_a_inf(alpha); - } else { - return mean + sd * ers_a_inf(alpha); - } + const double alpha = (a - mean) / sd; + + if (alpha < t4) + { + return mean + sd * nrs_a_inf(alpha); + } + else + { + return mean + sd * ers_a_inf(alpha); + } } inline -static double r_righttruncnorm (const double& b, const double& mean, - const double& sd) +static double r_righttruncnorm(const double& b, const double& mean, + const double& sd) { - const double beta = (b - mean) / sd; - /* Exploit symmetry */ - return mean + sd * r_lefttruncnorm(-beta, 0.0, 1.0); + const double beta = (b - mean) / sd; + + /* Exploit symmetry */ + return mean + sd * r_lefttruncnorm(-beta, 0.0, 1.0); } inline -static double r_truncnorm (const double& a, const double& b, - const double& mean, const double& sd) +static double r_truncnorm(const double& a, const double& b, + const double& mean, const double& sd) { - const double alpha = (a - mean) / sd; - const double beta = (b - mean) / sd; - const double phi_a = R::dnorm(alpha, 0.0, 1.0, 0); - const double phi_b = R::dnorm(beta, 0.0, 1.0, 0); - if (beta <= alpha) { - return NA_REAL; - } else if (alpha <= 0.0 && 0 <= beta) { - if (phi_a <= t1 || phi_b <= t1) { - return mean + sd * nrs_a_b(alpha, beta); - } else { - return mean + sd * urs_a_b(alpha, beta); - } - } else if (alpha > 0) { - if (phi_a / phi_b <= t2) { - return mean + sd * urs_a_b(alpha, beta); - } else { - if (alpha < t3) { - return mean + sd * hnrs_a_b(alpha, beta); - } else { - return mean + sd * ers_a_b(alpha, beta); - } - } - } else { - if (phi_b / phi_a <= t2) { - return mean + sd * urs_a_b(-beta, -alpha); - } else { - if (beta > -t3) { - return mean + sd * hnrs_a_b(-beta, -alpha); - } else { - return mean + sd * ers_a_b(-beta, -alpha); - } - } - } + const double alpha = (a - mean) / sd; + const double beta = (b - mean) / sd; + const double phi_a = R::dnorm(alpha, 0.0, 1.0, 0); + const double phi_b = R::dnorm(beta, 0.0, 1.0, 0); + + if (beta <= alpha) + { + return NA_REAL; + } + else if (alpha <= 0.0 && 0 <= beta) + { + if (phi_a <= t1 || phi_b <= t1) + { + return mean + sd * nrs_a_b(alpha, beta); + } + else + { + return mean + sd * urs_a_b(alpha, beta); + } + } + else if (alpha > 0) + { + if (phi_a / phi_b <= t2) + { + return mean + sd * urs_a_b(alpha, beta); + } + else + { + if (alpha < t3) + { + return mean + sd * hnrs_a_b(alpha, beta); + } + else + { + return mean + sd * ers_a_b(alpha, beta); + } + } + } + else + { + if (phi_b / phi_a <= t2) + { + return mean + sd * urs_a_b(-beta, -alpha); + } + else + { + if (beta > -t3) + { + return mean + sd * hnrs_a_b(-beta, -alpha); + } + else + { + return mean + sd * ers_a_b(-beta, -alpha); + } + } + } } inline -arma::vec do_rtruncnorm (const unsigned int& n, const double& a, - const double& b, const double& mean, const double& sd) +arma::vec do_rtruncnorm(const unsigned int& n, const double& a, + const double& b, const double& mean, const double& sd) { - arma::vec output(n); - Rcpp::RNGScope scope; - for (unsigned int i = 0; i < n; ++i) { - if (R_FINITE(a) && R_FINITE(b)) { - output(i) = r_truncnorm(a, b, mean, sd); - } else if (R_NegInf == a && R_FINITE(b)) { - output(i) = r_righttruncnorm(b, mean, sd); - } else if (R_FINITE(a) && R_PosInf == b) { - output(i) = r_lefttruncnorm(a, mean, sd); - } else if (R_NegInf == a && R_PosInf == b) { - output(i) = R::rnorm(mean, sd); - } else { - output(i) = NA_REAL; - } - } - return output; + arma::vec output(n); + Rcpp::RNGScope scope; + + for (unsigned int i = 0; i < n; ++i) + { + if (R_FINITE(a) && R_FINITE(b)) + { + output(i) = r_truncnorm(a, b, mean, sd); + } + else if (R_NegInf == a && R_FINITE(b)) + { + output(i) = r_righttruncnorm(b, mean, sd); + } + else if (R_FINITE(a) && R_PosInf == b) + { + output(i) = r_lefttruncnorm(a, mean, sd); + } + else if (R_NegInf == a && R_PosInf == b) + { + output(i) = R::rnorm(mean, sd); + } + else + { + output(i) = NA_REAL; + } + } + return output; } inline -double do_dtruncnorm (const double& x, const double& a, - const double& b, const double& mean, - const double& sd) +double do_dtruncnorm(const double& x, const double& a, + const double& b, const double& mean, + const double& sd) { - double output = 0.0; - if (a <= x && x <= b) { /* in range */ - const double c1 = R::pnorm(a, mean, sd, 1, 0); - const double c2 = R::pnorm(b, mean, sd, 1, 0); - const double c3 = sd * (c2 - c1); - const double c4 = R::dnorm((x - mean)/sd, 0.0, 1.0, 0); - output = c4 / c3; - } - return output; + double output = 0.0; + + if (a <= x && x <= b) /* in range */ + { + const double c1 = R::pnorm(a, mean, sd, 1, 0); + const double c2 = R::pnorm(b, mean, sd, 1, 0); + const double c3 = sd * (c2 - c1); + const double c4 = R::dnorm((x - mean) / sd, 0.0, 1.0, 0); + output = c4 / c3; + } + return output; } #endif /* __FINMIX_RTRUNCNORM_H__ */ diff --git a/tests/doRUnit.R b/tests/doRUnit.R index b9c5ebd..5fc62bd 100644 --- a/tests/doRUnit.R +++ b/tests/doRUnit.R @@ -1,64 +1,71 @@ ## Unit tests will not be done if RUnit is not available ## -if(require("RUnit", quietly = TRUE)) { +if (require("RUnit", quietly = TRUE)) { - ## --- Setup --- ## - - pkg <- "finmix" - if(Sys.getenv("RCMDCHECK") == "FALSE") { - ## Path to unit tests for standalone running under - ## Makefile (not R CMD check) - ## finmix/tests/../inst/unitTests - path <- file.path(getwd(), "..", "inst", "unitTests") - } - else { - ## Path to unit tests for R CMD check - ## finmix.Rcheck/tests/../finmix/unitTests - path <- system.file(package=pkg, "unitTests") - } - cat("\nRunning unit tests\n") - print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path)) + ## --- Setup --- ## - library(package=pkg, character.only=TRUE) - - ## If desired, load the name space to allow testing of private - ## functions - ## if (is.element(pkg, loadedNamespaces())) - ## attach(loadNamespace(pkg), name=paste("namespace", pkg, - ## sep=":"), pos=3) - ## - ## or simply call PKG:::MyPrivateFuncion() in tests + pkg <- "finmix" + if (Sys.getenv("RCMDCHECK") == "FALSE") { + ## Path to unit tests for standalone running under + ## Makefile (not R CMD check) + ## finmix/tests/../inst/unitTests + path <- file.path(getwd(), "..", "inst", "unitTests") + } else { + ## Path to unit tests for R CMD check + ## finmix.Rcheck/tests/../finmix/unitTests + path <- system.file(package = pkg, "unitTests") + } + cat("\nRunning unit tests\n") + print(list(pkg = pkg, getwd = getwd(), pathToUnitTests = path)) - ## --- Testing --- ## - - ## Define tests - testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), - dirs=path) - - ## Run - tests <- runTestSuite(testSuite) - - ## Default report name - pathReport <- file.path(path, "report") - - ## Report to stdout and text files - cat("--------------------- UNIT TEST SUMMARY -------------------------\n\n") - printTextProtocol(tests, showDetails=FALSE) - printTextProtocol(tests, showDetails=FALSE, - fileName=paste(pathReport, "Summary.txt", sep = "")) - printTextProtocol(tests, showDetails=TRUE, - fileName=paste(pathReport, ".txt", sep="")) - - ## Report to HTML file - printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep = "")) - - ## Return stop() to cause R CMD check stop in case of - ## - failure i.e. FALSE to unit tests or - ## - errors i.e. R errors - tmp <- getErrors(tests) - if (tmp$nFail > 0 | tmp$nErr > 0) { - stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, - ", #R errors: ", tmp$nErr, ")\n\n", sep = "")) - } + library(package = pkg, character.only = TRUE) + + ## If desired, load the name space to allow testing of private + ## functions + ## if (is.element(pkg, loadedNamespaces())) + ## attach(loadNamespace(pkg), name=paste("namespace", pkg, + ## sep=":"), pos=3) + ## + ## or simply call PKG:::MyPrivateFuncion() in tests + + ## --- Testing --- ## + + ## Define tests + testSuite <- defineTestSuite( + name = paste(pkg, "unit testing"), + dirs = path + ) + + ## Run + tests <- runTestSuite(testSuite) + + ## Default report name + pathReport <- file.path(path, "report") + + ## Report to stdout and text files + cat("--------------------- UNIT TEST SUMMARY -------------------------\n\n") + printTextProtocol(tests, showDetails = FALSE) + printTextProtocol(tests, + showDetails = FALSE, + fileName = paste(pathReport, "Summary.txt", sep = "") + ) + printTextProtocol(tests, + showDetails = TRUE, + fileName = paste(pathReport, ".txt", sep = "") + ) + + ## Report to HTML file + printHTMLProtocol(tests, fileName = paste(pathReport, ".html", sep = "")) + + ## Return stop() to cause R CMD check stop in case of + ## - failure i.e. FALSE to unit tests or + ## - errors i.e. R errors + tmp <- getErrors(tests) + if (tmp$nFail > 0 | tmp$nErr > 0) { + stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, + ", #R errors: ", tmp$nErr, ")\n\n", + sep = "" + )) + } } else { - warning("cannot run unit tests -- package RUnit is not available") + warning("cannot run unit tests -- package RUnit is not available") } From 41174687c8574302308097457a0e61364caf6c05 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Fri, 10 Sep 2021 15:53:44 +0200 Subject: [PATCH 08/24] Modified DESCRIPTION file. Only the License is missing. --- DESCRIPTION | 35 ++++++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0848b51..b001508 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,19 +1,32 @@ Package: finmix Type: Package -Title: Gibbs sampling for finite mixture distributions. -Version: 0.1 -Date: 2013-07-05 +Title: An R package for Bayesian estimation of finite mixture distributions. +Version: 0.1.0 +Date: 2021-09-10 Author: Lars Simon Zehnder -Maintainer: Lars Simon Zehnder -Description: More about what it does (maybe more than one line) +Maintainer: Lars Simon Zehnder +Description: An R package for Bayesian estimation of finite mixture + distributions. The package uses heavily C++ code to enable high performance + MCMC sampling. Each distribution comes along with some support functions + that create needed objects and start parameters. The following mixtures are + available: Poisson, binomial, exponential, Normal, multivariate Normal, + Student, and Multivariate Student. License: GPL (>= 3) SystemRequirements: C++11 -Depends: Rcpp (>= 0.10.2), RcppArmadillo (>= 0.3.6.2), graphics, - mvtnorm (>= 0.9-7), KernSmooth (>= 2.23.10), dfoptim(>= 2011.8.1), - nloptr (>= 1.2.0) -Imports: Rcpp (>= 1.0.6), graphics, mvtnorm (>= 0.9-7), KernSmooth (>= 0.3.6.2), nloptr (>= 1.2.0) -Suggests: RUnit -LinkingTo: Rcpp, RcppArmadillo, nloptr (>= 1.2.0) +Imports: + Rcpp (>= 1.0.7), + RcppArmadillo (>= 0.10.6), + graphics, + mvtnorm, + KernSmooth, + nloptr (>= 1.2.0), + dfoptim +LinkingTo: + Rcpp (>= 1.0.7), + RcppArmadillo (>= 0.10.6), + nloptr (>= 1.2.0) +Extends: + bayespin Collate: AllGenerics.R graphic_func.R From d566f4a8d407c69c38e70629cc4a127ab75c1d39 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Sat, 11 Sep 2021 14:25:09 +0200 Subject: [PATCH 09/24] Fixed some bugs after running R CMD check. --- DESCRIPTION | 4 +- NAMESPACE | 3 +- R/model.R | 234 +++++++++++++++++++++++++++++++++++++++++++++------ R/unass.R | 37 ++++++-- man/model.Rd | 2 +- 5 files changed, 243 insertions(+), 37 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b001508..b31e740 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: finmix Type: Package -Title: An R package for Bayesian estimation of finite mixture distributions. +Title: An R package for Bayesian estimation of finite mixture distributions Version: 0.1.0 Date: 2021-09-10 Author: Lars Simon Zehnder @@ -84,4 +84,4 @@ Collate: mcmcestfix.R mcmcestind.R mcmcestimate.R - +RoxygenNote: 7.1.1 diff --git a/NAMESPACE b/NAMESPACE index eda60b4..8c4f1cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,7 @@ useDynLib(finmix, .registration=TRUE) import(nloptr) importFrom("Rcpp", "sourceCpp") -#exportPattern("^[[:alpha:]]+") +exportPattern("^[[:alpha:]]+") importFrom(graphics, barplot) importFrom(graphics, hist) @@ -61,6 +61,7 @@ exportMethods( ## name of the generic, as with other methods "setIndicfix<-", "setExp<-", "setT<-", + "simulate", ## 'modelmoments' class ## "getMean", diff --git a/R/model.R b/R/model.R index 1fa9b5f..1ed5d43 100644 --- a/R/model.R +++ b/R/model.R @@ -15,6 +15,24 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' An S4 class to represent a finite mixture model +#' +#' @slot dist A character, defining the distribution family. Possible choices +#' are binomial, exponential, normal, normult, poisson, student, and studmult. +#' @slot r An integer. Defines the vector dimension of a model. Is one for all +#' univariate distributions and larger than one for normult and studmult. +#' @slot K An integer, defining the number of components in the finite mixture. +#' @slot weight A matrix, containing the weights of the finite mixture model. +#' The matrix must have dimension \code{1\times K} and weights must add to one +#' must all be larger or equal to zero. +#' @slot par A list containing the parameter vectors for the finite mixture +#' distribution. The list can contain more than one named parameter vector. +#' @slot indicmod A character defining the indicator model. So far only +#' multinomial indicator models are possible. +#' @slot indicfix A logical. If \code{TRUE} the indicators are given and +#' therefore fixed. +#' @slot T A matrix containing the repetitions in case of a \code{"binomial"} or +#' \code{"poisson"} model. .model <- setClass("model", representation( dist = "character", @@ -43,7 +61,56 @@ ) ) -## Constructor for class 'model' ## +#' Constructor for the S4 model class +#' +#' \code{model} creates a finite mixture model with given parameters. +#' +#' This is a constructor that creates a class object and guides the user in +#' regard to the different parameters needed to define a finite mixture model. +#' +#' @param dist A character, defining the distribution family. Possible choices +#' are \code{"binomial"}, \code{"exponential"}, \code{"normal}, +#' \code{"normult"}, \code{"poisson"}, \code{"student"}, and \code{"studmult"}. +#' @param r An integer. Defines the vector dimension of a model. Is one for all +#' univariate distributions and larger than one for \code{"normult"} and +#' \code{"studmult"}. +#' @param K An integer, defining the number of components in the finite mixture. +#' Must be larger or equal to one. +#' @param weight A matrix, containing the weights of the finite mixture model. +#' The matrix must have dimension \code{1\times K} and weights must add to one +#' and must all be larger or equal to zero. +#' @param par A list containing the parameter vectors for the finite mixture +#' distribution. The list can contain more than one named parameter vector. +#' Depending on the distribution parameters must be defined in the list as +#' follows: a \code{K}-dimensional vector of probabilities named \code{"p"} for +#' a \code{"binomial"} model, a \code{K}-dimensional vector of positive rates +#' named \code{"lambda"} for an \code{"exponential"} model, +#' \code{K}-dimensional vectors of means named \code{"mu"} and variances named +#' \code{sigma} for a \code{"normal"} model, a \code{r\times K}-dimensional +#' matrix of means named \code{"mu"} and a \code{K\times r\times r} dimensional +#' array of variance-covariance matrices named \code{"sigma"} for a +#' \code{"normult"} model, a \code{K}-dimensional vector of rates named +#' \code{"rates"} for a \code{"poisson"} model, \code{K}-dimensional vectors of +#' means named \code{"mu"}, variances named \code{sigma}, and degrees of freedom +#' named \code{"df"} for a \code{"student"} model, a +#' \code{r\times K}-dimensional matrix of means named \code{"mu"}, a +#' \code{K\times r\times r} dimensional array of variance-covariance matrices +#' named \code{"sigma"}, and a \code{K}-dimensional vector of degrees of freedom +#' for a \code{"studmult"} model. +#' @param indicmod A character defining the indicator model used. For now only +#' \code{"multinomial"} is implemented. +#' @param indicfix A logical. If \code{TRUE} the indicators are given and +#' therefore fixed. +#' @param T A matrix containing the repetitions in case of a \code{"binomial"} or +#' \code{"poisson"} model. Must be positive integers. +#' @return An S4 \code{model} object. +#' @export +#' +#' @example +#' \preformatted(f_model <- model(dist = "poisson", K = 2, par = list(lambda = c(0.17, 0.2)), +#' weight = matrix(c(0.5, 0.5), nrow = 1))) +#' +#' @seealso \code{model} "model" <- function(dist = "poisson", r, K, weight = matrix(), par = list(), indicmod = "multinomial", @@ -81,6 +148,19 @@ ) } +#' Getter for weights +#' +#' \code{getWeight} returns the weight matrix. +#' +#' @param model An S4 model object. +#' @param verbose A logical indicating, if the function should give a print out. +#' @return Matrix of weights. +#' @export +#' +#' @example +#' \dontrun{ +#' weight <- getWeight(model) +#' } setMethod( "hasWeight", "model", function(object, verbose = FALSE) { @@ -113,6 +193,22 @@ setMethod( } ) +#' Checks for repetitions. +#' +#' \code{hasT} chwecks if the model object possesses repetitions. +#' +#' @param model An S4 model object. +#' @param verbose A logical indicating if the function should give a print out. +#' @return A logical. \code{TRUE} if repetitions are existent in the model. If +#' values of slot \code{T} are \code{NA} it returns \code{FALSE}. +#' @export +#' +#' @example +#' \dontrun{ +#' if(hasT(model)) {cat('Has repetitions.)} +#' } +#' +#' @seealso \code{model} setMethod( "hasT", "model", function(object, verbose = FALSE) { @@ -131,6 +227,21 @@ setMethod( } ) +#' Checks for parameters. +#' +#' \code{hasPar} checks if the model has parameters defined. +#' +#' @param model An S4 model object. +#' @param verbose A logical indicating, if the function should give a print out. +#' @return A matrix with repetitions. Can be empty, if no repetitions are set. +#' @export +#' +#' @example +#' \dontrun{ +#' if(hasPar(model)) {simulate(model)} +#' } +#' +#' @seealso \code{model} setMethod( "hasPar", "model", function(object, verbose = FALSE) { @@ -138,23 +249,28 @@ setMethod( } ) -### ---------------------------------------------------------------------- -### Simulate method -### @description Simulates values for a specified model in an 'model' -### object. -### @par model an S4 'model' object; with specified parameters -### @par N an R 'integer' value specifying the number of -### values to be simulated -### @par varargin an S4 'fdata' object; with specified variable -### dimension @r and repetitions @T -### @return an S4 object of class 'fdata' holding the simulated -### @see ?simulate -### @author Lars Simon Zehnder -### ---------------------------------------------------------------------- +#' Simulates data from a model. +#' +#' \code{simulate} simulates values for a specified mixture model in an +#' S4 \code{model} object. +#' +#' @param model An S4 model object with specified parameters and weights. +#' @param N An integer specifying the number of values to be simulated. +#' @param varargin An S4 fdata object with specified variable dimensions. +#' @param seed An integer specifying the seed for the RNG. +#' \code{r} and repetitions \code{T}. +#' @return An S4 fdata object holding the simulated values. +#' @export +#' +#' @seealso \code{model}, \code{fdata} +#' @example +#' \dontrun{ +#' f_data <- simulate(model, 100) +#' } setMethod( "simulate", "model", function(model, N = 100, varargin, seed = 0) { - ## TODO: CHeck model for parameters. Check varargin for dimension. Check + ## TODO: Check model for parameters. Check varargin for dimension. Check ## model anf varargin for consistency. if (!missing(seed)) { set.seed(seed) @@ -178,7 +294,23 @@ setMethod( } ) -## plot ## +#' Plots a model. +#' +#' \code{plot} plots the density or probabilities of a fully specified mixture +#' model. +#' +#' @param x An S4 model object. Must have specified parameters and weights. +#' @param y Unused. +#' @param dev A logical indicating, if the plot should be shown in a graphical +#' device. Set to \code{FALSE}, if plotted to a file. +#' @return Density or barplot of the S4 model object. +#' @export +#' +#' @example \dontrun{ +#' plot(f_model) +#' } +#' +#' @seealso \code{model} setMethod( "plot", "model", function(x, y, dev = TRUE, ...) { @@ -205,6 +337,23 @@ setMethod( } ) +#' Plots point process. +#' +#' \code{plotPointProc} plots the point process of an S4 model object that +#' defines a finite mixture model. Only available for Poisson mixtures so far. +#' +#' @param x An S4 model object with defined parameters and weigths. +#' @param y Unused. +#' @param dev A logical indicating, if the plot should be shown in a graphical +#' device. Set to \code{FALSE}, if plotted to a file. +#' @return A scatter plot of weighted parameters. +#' @export +#' +#' @example \dontrun{ +#' plotPointProc(f_model) +#' } +#' +#' @seealso \code{model} setMethod( "plotPointProc", signature( x = "model", @@ -220,6 +369,25 @@ setMethod( ) ## Marginal Mixture ## +#' Returns the marginal distribution. +#' +#' \code{mixturemar} returns the marginal distribution of a multivariate +#' mixture distribution. This can only be applied on S4 model objects with +#' \code{dist="normult"} or \code{dist="studmult"}. +#' +#' @param object An S4 model object with a multivariate distribution. +#' @param J An integer specifying the dimension for which the marginal +#' distribution should be returned. +#' @return An S4 model object with the marginal distribution for dimension +#' \code{J}. +#' @export +#' +#' @example +#' \dontrun{ +#' mar_model <- mixturemar(f_model, 1) +#' } +#' +#' @seealso \code{model} setMethod( "mixturemar", "model", function(object, J) { @@ -227,7 +395,20 @@ setMethod( } ) -## Show ## +#' Shows the model. +#' +#' \code{show} prints model information to the console. +#' +#' @param object An S4 model object. +#' @return A print out of model information about all slots. +#' @export +#' +#' @example +#' \dontrun{ +#' show(f_model) +#' } +#' +#' @seealso \code{model} setMethod( "show", "model", function(object) { @@ -465,13 +646,13 @@ setReplaceMethod( ### Marginal model ".mixturemar.Model" <- function(obj, J) { - if (object@dist == "normult") { + if (obj@dist == "normult") { .mixturemar.normult.Model(obj, J) - } else if (object@dist == "studmult") { + } else if (obj@dist == "studmult") { .mixturemar.studmult.Model(obj, J) } else { - stop("A marginal distribution can only be obtained from - multivariate distributions.") + stop("A marginal distribution can only be obtained from + multivariate distributions.") } } @@ -720,7 +901,7 @@ setReplaceMethod( axis(side = 2, cex = .7, cex.axis = .7) axis( side = 1, tick = FALSE, at = bp[which(x.grid %in% label.grid)], - labels = label.grid, cex.axis = .7 + labels = which(x.grid %in% label.grid), cex.axis = .7 ) mtext(side = 1, "x", cex = .7, cex.axis = .7, line = 3) mtext(side = 2, "P(x)", cex = .7, cex.axis = .7, line = 3) @@ -2236,7 +2417,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------ -".init.valid.Binomial.Model" <- function(model.obj) { +".init.valid.Binomial.Model" <- function(obj) { if (length(obj@par)) { if (!"p" %in% names(obj@par)) { stop(paste("Wrong specification of slot @par: ", @@ -2304,7 +2485,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------ -".valid.Binomial.Model" <- function(model.obj) { +".valid.Binomial.Model" <- function(obj) { if (length(obj@par)) { if (!"p" %in% names(obj@par)) { warning(paste("Wrong specification of slot @par: ", @@ -2657,7 +2838,7 @@ setReplaceMethod( } if (!"sigma" %in% names(obj@par)) { warning(paste("Wrong specification of slot @par: ", - "univariate Normal mictures need ", + "univariate Normal mixtures need ", "a variance vector named ", "'sigma'", sep = "" @@ -2973,7 +3154,7 @@ setReplaceMethod( } if (!"sigma" %in% names(obj@par)) { warning(paste("Wrong specification of slot @par: ", - "univariate Normal mictures need ", + "univariate Student-t mixtures need ", "a variance vector named ", "'sigma'", sep = "" @@ -3474,6 +3655,7 @@ setReplaceMethod( } ### Additional functions +#' @keywords internal ".get.univ.Model" <- function() { univ <- c( "poisson", "cond.poisson", diff --git a/R/unass.R b/R/unass.R index de9ddbd..a489918 100644 --- a/R/unass.R +++ b/R/unass.R @@ -1,14 +1,37 @@ +################################################################ # Copyright (c) 2013 All Rights Reserved # author: Barry Rowlingson -# created: January 2013 +# created: January 2013 # -# This code has been copied from 'https://gist.github.com/spacedman/4543212' -# and is used in package 'finmix' to assign several modified objects -# to a list. +# avialability: https://gist.github.com/spacedman/4543212 +################################################################# -unsass <- function(lhs, rhs) { +#' Unstructuring assignments +#' +#' \code{unsass} assigns multiple objects in its argument \code{rhs} (right-hand side) +#' to multiple objects (names) chained in its argument \code{lhs} (left-hand-side). +#' +#' This is a helper function to simplify the use of the package. The right-hand side can +#' be a function that returns multiple objects and the left-hand side must be a formula +#' with objects (names) chained by \code{~}. Assignment works via \code{lhs %=% rhs}. +#' +#' @param lhs A \code{formula} chaining multiple objects (names) together by \code{~}. +#' These are the objects (names) the right-hand side should be assigned to. +#' @param rhs A \code{list} of objects that should be assigned to the left-hand side +#' \code{lhs}. +#' +#' @return None. +#' +#' @example +#' f_model <- model(K=2, dist= 'poisson', par=list(lambda=c(0.17, 0.12)), weight = matrix(c(0.6, 0.4), nrow=1)) +#' f_data <- simulate(model) +#' mcmc <- mcmc() +#' f_data~f_model~mcmc) %=% mcmcstart(f_data, f_model, mcmc) +#' +#' @seealso \code{mcmcstart} +"unsass" <- function(lhs, rhs) { nvalues <- length(rhs) - lhss <- getFormulaNames(lhs) + lhss <- .getFormulaNames(lhs) if (length(lhss) != nvalues) { stop("Wrong number of values to unpack") } @@ -26,7 +49,7 @@ unsass <- function(lhs, rhs) { assign("%=%", unsass) -getFormulaNames <- function(formula) { +".getFormulaNames" <- function(formula) { ## extract elements from a~b[1]~c~d ## recursive - might be an easier way... ## diff --git a/man/model.Rd b/man/model.Rd index ed27149..da23127 100644 --- a/man/model.Rd +++ b/man/model.Rd @@ -245,7 +245,7 @@ In the following code snippets, \code{x} is an \code{model} object and the symbo \examples{ model.obj <- model(dist = "binomial", K = 2, indicfix = TRUE) model.obj - setT(model.obj) <- as.matrix(100) + setT(model.obj) <- as.matrix(as.integer(100)) setPar(model.obj) <- list(p = c(.3, .7)) setWeight(model.obj) <- matrix(c(.1, .9), nrow = 1, ncol = 2) plot(model.obj) From 659bcb161cc30e447a52013f26ec1ff1b23083a7 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Tue, 5 Oct 2021 09:07:19 +0200 Subject: [PATCH 10/24] Started documentation --- DESCRIPTION | 12 +- NAMESPACE | 399 ++--- R/.mcmcoutputbase.R.swp | Bin 49152 -> 0 bytes R/.model.R.swp | Bin 155648 -> 0 bytes R/AllGenerics.R | 157 +- R/RcppExports.R | 739 +++++++- R/binomialmodelmoments.R | 106 +- R/cdatamoments.R | 178 ++ R/cmodelmoments.R | 69 + R/csdatamoments.R | 319 +++- R/dataclass.R | 370 +++- R/datamoments.R | 41 + R/ddatamoments.R | 153 +- R/distributions.R | 14 +- R/dmodelmoments.R | 67 +- R/exponentialmodelmoments.R | 115 +- R/fdata.R | 968 +++++++++- R/graphic_func.R | 55 + R/groupmoments.R | 188 ++ R/likelihood.R | 145 ++ R/mcmc.R | 301 +++- R/mcmcestfix.R | 523 +++++- R/mcmcestimate.R | 272 ++- R/mcmcestind.R | 248 ++- R/mcmcextract.R | 49 +- R/mcmcoutputbase.R | 785 ++++++++- R/mcmcoutputfix.R | 1286 ++++++++++++-- R/mcmcoutputfixhier.R | 604 ++++++- R/mcmcoutputfixhierpost.R | 299 ++++ R/mcmcoutputfixpost.R | 456 +++++ R/mcmcoutputhier.R | 360 +++- R/mcmcoutputhierpost.R | 339 +++- R/mcmcoutputpermbase.R | 457 ++++- R/mcmcoutputpermfix.R | 649 ++++++- R/mcmcoutputpermfixhier.R | 460 ++++- R/mcmcoutputpermfixhierpost.R | 319 +++- R/mcmcoutputpermfixpost.R | 8 + R/mcmcoutputpermhier.R | 377 +++- R/mcmcoutputpermhierpost.R | 344 +++- R/mcmcoutputpermpost.R | 329 +++- R/mcmcoutputpost.R | 311 ++++ R/mcmcpermfix.R | 72 + R/mcmcpermfixpost.R | 41 + R/mcmcpermind.R | 123 ++ R/mcmcpermindpost.R | 40 + R/mcmcpermute.R | 17 +- R/mcmcstart.R | 302 +++- R/mincol.R | 100 +- R/mixturemcmc.R | 361 +++- R/mixturemoments.R | 10 +- R/model.R | 319 +++- R/modelmoments.R | 83 +- R/normalmodelmoments.R | 121 +- R/normultmodelmoments.R | 164 +- R/poissonmodelmoments.R | 64 +- R/prior.R | 913 ++++++++-- R/sdatamoments.R | 132 +- R/studentmodelmoments.R | 109 ++ R/studmultmodelmoments.R | 165 +- R/unass.R | 75 +- inst/unitTests/Makefile | 15 - inst/unitTests/report.html | 81 - inst/unitTests/report.txt | 112 -- inst/unitTests/reportSummary.txt | 9 - inst/unitTests/runit.dataclass.R | 88 - inst/unitTests/runit.datamoments.R | 142 -- inst/unitTests/runit.fdata.R | 477 ----- inst/unitTests/runit.mcmc.R | 34 - inst/unitTests/runit.mcmcoutput.R | 179 -- inst/unitTests/runit.mcmcpermute.poisson.R | 258 --- inst/unitTests/runit.mcmcstart.R | 72 - inst/unitTests/runit.mixturemcmc.R | 85 - inst/unitTests/runit.mixturemcmc.poisson.R | 911 ---------- inst/unitTests/runit.model.R | 198 --- inst/unitTests/runit.modelmoments.R | 42 - inst/unitTests/runit.prior.R | 81 - man/Summary-mcmcestfix-method.Rd | 23 + man/Summary-mcmcestind-method.Rd | 23 + man/binomialmodelmoments-class.Rd | 40 + man/cdatamoments_class.Rd | 41 + man/cmodelmoments.Rd | 30 + man/csdatamoments_class.Rd | 39 + man/dataclass.Rd | 36 + man/dataclass_class.Rd | 47 + man/datamoments.Rd | 36 + man/datamoments_class.Rd | 87 + man/ddatamoments_class.Rd | 36 + man/ddirichlet_cc.Rd | 25 + man/dgamma_cc.Rd | 27 + man/dmodelmoments.Rd | 27 + man/dot-generateMomentsNormal.Rd | 21 + man/dstud.Rd | 24 + man/exponentialmodelmoments.Rd | 28 + man/extract-mcmcoutputfix-numeric-method.Rd | 22 + man/fdata.Rd | 259 +-- man/fdata_class.Rd | 586 +++++++ man/finmix-package.Rd | 44 - ...nerateMoments-normalmodelmoments-method.Rd | 19 + man/generatePrior-prior-method.Rd | 37 + man/getMperm-mcmcpermfix-method.Rd | 31 + man/graphic_funs.Rd | 15 + man/groupmoments.Rd | 32 + man/groupmoments_class.Rd | 39 + man/hasPar-model-method.Rd | 28 + man/hasS-fdata-method.Rd | 30 + man/hasT-model-method.Rd | 29 + man/hungarian_cc.Rd | 35 + man/initialize-mcmcoutputpermbase-method.Rd | 67 + man/initialize-mcmcoutputpermfix-method.Rd | 41 + ...initialize-mcmcoutputpermfixhier-method.Rd | 45 + ...ialize-mcmcoutputpermfixhierpost-method.Rd | 49 + man/initialize-mcmcoutputpermhier-method.Rd | 68 + ...nitialize-mcmcoutputpermhierpost-method.Rd | 76 + man/initialize-mcmcoutputpermpost-method.Rd | 72 + man/initialize-normalmodelmoments-method.Rd | 30 + man/initialize-sdatamoments-method.Rd | 29 + man/lddirichlet_cc.Rd | 25 + man/ldgamma_cc.Rd | 27 + man/mcmc.Rd | 61 + man/mcmc_binomial_cc.Rd | 56 + man/mcmc_class.Rd | 46 + man/mcmc_condpoisson_cc.Rd | 56 + man/mcmc_exponential_cc.Rd | 56 + man/mcmc_normal_cc.Rd | 56 + man/mcmc_normult_cc.Rd | 56 + man/mcmc_poisson_cc.Rd | 56 + man/mcmc_student_cc.Rd | 56 + man/mcmc_studmult_cc.Rd | 56 + man/mcmcest_class.Rd | 88 + man/mcmcestimate.Rd | 69 + man/mcmcoutput-class.Rd | 10 + man/mcmcoutput_class.Rd | 1207 +++++++++++++ man/mcmcoutputbase-class.Rd | 38 + man/mcmcoutputhier-class.Rd | 30 + man/mcmcoutputhierpost-class.Rd | 57 + man/mcmcoutputperm_class.Rd | 1555 +++++++++++++++++ man/mcmcoutputpermbase-class.Rd | 28 + man/mcmcoutputpermfix-class.Rd | 28 + man/mcmcoutputpermfixhier-class.Rd | 28 + man/mcmcoutputpermfixhierpost-class.Rd | 28 + man/mcmcoutputpermfixpost-class.Rd | 11 + man/mcmcoutputpermhier-class.Rd | 28 + man/mcmcoutputpermpost-class.Rd | 28 + man/mcmcoutputpost-class.Rd | 27 + man/mcmcperm_class.Rd | 135 ++ man/mcmcpermfix-class.Rd | 40 + man/mcmcpermfixhier-class.Rd | 35 + man/mcmcpermfixhier-methods.Rd | 31 + man/mcmcpermute.Rd | 16 + man/mcmcstart.Rd | 50 + man/mixturemar-model-method.Rd | 32 + man/mixturemcmc.Rd | 115 ++ man/model.Rd | 300 +--- man/model_class.Rd | 193 ++ man/modelmoments-class.Rd | 35 + man/modelmoments.Rd | 32 + man/modelmoments_class.Rd | 84 + man/moments-mcmcoutputfix-method.Rd | 19 + man/moments_cc.Rd | 28 + man/normalmodelmoments.Rd | 28 + man/normultmodelmoments.Rd | 28 + man/permmoments_cc.Rd | 30 + man/plot-model-ANY-method.Rd | 32 + man/plotDens-mcmcoutputfixhierpost-method.Rd | 54 + man/plotDens-mcmcoutputhier-method.Rd | 51 + man/plotDens-mcmcoutputpost-method.Rd | 53 + man/plotHist-mcmcoutputhier-method.Rd | 50 + man/plotHist-mcmcoutputpost-method.Rd | 51 + ...tPointProc-mcmcoutputfixhierpost-method.Rd | 53 + man/plotPointProc-mcmcoutputhier-method.Rd | 49 + ...plotPointProc-mcmcoutputhierpost-method.Rd | 51 + ...tPointProc-mcmcoutputpermfixhier-method.Rd | 55 + man/plotPointProc-mcmcoutputpost-method.Rd | 51 + man/plotPointProc-model-method.Rd | 32 + ...otPostDens-mcmcoutputfixhierpost-method.Rd | 53 + ...lotSampRep-mcmcoutputfixhierpost-method.Rd | 53 + man/plotSampRep-mcmcoutputhier-method.Rd | 49 + man/plotSampRep-mcmcoutputhierpost-method.Rd | 51 + ...lotSampRep-mcmcoutputpermfixhier-method.Rd | 52 + man/plotSampRep-mcmcoutputpost-method.Rd | 51 + ...plotTraces-mcmcoutputfixhierpost-method.Rd | 62 + man/plotTraces-mcmcoutputhier-method.Rd | 60 + man/plotTraces-mcmcoutputpost-method.Rd | 62 + man/poissonmodelmoments.Rd | 28 + man/prior-class.Rd | 99 ++ man/prior.Rd | 58 + man/priordefine.Rd | 61 + man/qincol.Rd | 39 + man/qincolmult.Rd | 38 + man/qinmatr.Rd | 37 + man/qinmatrmult.Rd | 35 + man/sdatamoments.Rd | 32 + man/sdatamomentsOrNULL-class.Rd | 11 + man/sdatamoments_class.Rd | 49 + man/show-cdatamoments-method.Rd | 19 + man/show-csdatamoments-method.Rd | 19 + man/show-dataclass-method.Rd | 19 + man/show-ddatamoments-method.Rd | 19 + man/show-exponentialmodelmoments-method.Rd | 19 + man/show-groupmoments-method.Rd | 19 + man/show-mcmc-method.Rd | 19 + man/show-mcmcestfix-method.Rd | 19 + man/show-mcmcestind-method.Rd | 19 + man/show-mcmcoutputbase-method.Rd | 19 + man/show-mcmcoutputfix-method.Rd | 19 + man/show-mcmcoutputfixhier-method.Rd | 19 + man/show-mcmcoutputfixhierpost-method.Rd | 19 + man/show-mcmcoutputfixpost-method.Rd | 19 + man/show-mcmcoutputhier-method.Rd | 19 + man/show-mcmcoutputpermbase-method.Rd | 19 + man/show-mcmcoutputpermfix-method.Rd | 19 + man/show-mcmcoutputpermfixhier-method.Rd | 19 + man/show-mcmcoutputpermfixhierpost-method.Rd | 19 + man/show-mcmcoutputpermhier-method.Rd | 19 + man/show-mcmcoutputpermhierpost-method.Rd | 19 + man/show-mcmcoutputpermpost-method.Rd | 19 + man/show-model-method.Rd | 26 + man/show-normalmodelmoments-method.Rd | 19 + man/show-normultmodelmoments-method.Rd | 19 + man/show-poissonmodelmoments-method.Rd | 19 + man/show-prior-method.Rd | 19 + man/show-studentmodelmoments-method.Rd | 19 + man/simulate.Rd | 73 - man/stephens1997a_binomial_cc.Rd | 48 + man/stephens1997a_poisson_cc.Rd | 48 + man/stephens1997b_binomial_cc.Rd | 43 + man/stephens1997b_exponential_cc.Rd | 43 + man/stephens1997b_poisson_cc.Rd | 43 + man/studentmodelmoments.Rd | 28 + man/studmultmodelmoments-class.Rd | 24 + man/studmultmodelmoments.Rd | 28 + man/subseq-mcmcoutputpost-array-method.Rd | 26 + man/swapInd_cc.Rd | 34 + man/swapInteger_cc.Rd | 34 + man/swapST_cc.Rd | 29 + man/swap_3d_cc.Rd | 32 + man/swap_cc.Rd | 33 + man/unsass.Rd | 46 + src/RcppExports.cpp | 576 +++--- src/attributes.cpp | 233 ++- src/data | Bin 239295 -> 0 bytes src/mcmc_binomial.cpp | 41 +- src/mcmc_condpoisson.cpp | 41 +- src/mcmc_exponential.cpp | 41 +- src/mcmc_normal.cpp | 40 + src/mcmc_normult.cpp | 40 + src/mcmc_poisson.cpp | 40 + src/mcmc_student.cpp | 40 + src/mcmc_studmult.cpp | 40 + src/relabel_algorithms.cpp | 189 +- tests/.test.mixturemcmc.poisson.R.swp | Bin 12288 -> 0 bytes tests/doRUnit.R | 71 - 252 files changed, 25635 insertions(+), 4707 deletions(-) delete mode 100644 R/.mcmcoutputbase.R.swp delete mode 100644 R/.model.R.swp delete mode 100644 inst/unitTests/Makefile delete mode 100644 inst/unitTests/report.html delete mode 100644 inst/unitTests/report.txt delete mode 100644 inst/unitTests/reportSummary.txt delete mode 100644 inst/unitTests/runit.dataclass.R delete mode 100644 inst/unitTests/runit.datamoments.R delete mode 100644 inst/unitTests/runit.fdata.R delete mode 100644 inst/unitTests/runit.mcmc.R delete mode 100644 inst/unitTests/runit.mcmcoutput.R delete mode 100644 inst/unitTests/runit.mcmcpermute.poisson.R delete mode 100644 inst/unitTests/runit.mcmcstart.R delete mode 100644 inst/unitTests/runit.mixturemcmc.R delete mode 100644 inst/unitTests/runit.mixturemcmc.poisson.R delete mode 100644 inst/unitTests/runit.model.R delete mode 100644 inst/unitTests/runit.modelmoments.R delete mode 100644 inst/unitTests/runit.prior.R create mode 100644 man/Summary-mcmcestfix-method.Rd create mode 100644 man/Summary-mcmcestind-method.Rd create mode 100644 man/binomialmodelmoments-class.Rd create mode 100644 man/cdatamoments_class.Rd create mode 100644 man/cmodelmoments.Rd create mode 100644 man/csdatamoments_class.Rd create mode 100644 man/dataclass.Rd create mode 100644 man/dataclass_class.Rd create mode 100644 man/datamoments.Rd create mode 100644 man/datamoments_class.Rd create mode 100644 man/ddatamoments_class.Rd create mode 100644 man/ddirichlet_cc.Rd create mode 100644 man/dgamma_cc.Rd create mode 100644 man/dmodelmoments.Rd create mode 100644 man/dot-generateMomentsNormal.Rd create mode 100644 man/dstud.Rd create mode 100644 man/exponentialmodelmoments.Rd create mode 100644 man/extract-mcmcoutputfix-numeric-method.Rd create mode 100644 man/fdata_class.Rd delete mode 100644 man/finmix-package.Rd create mode 100644 man/generateMoments-normalmodelmoments-method.Rd create mode 100644 man/generatePrior-prior-method.Rd create mode 100644 man/getMperm-mcmcpermfix-method.Rd create mode 100644 man/graphic_funs.Rd create mode 100644 man/groupmoments.Rd create mode 100644 man/groupmoments_class.Rd create mode 100644 man/hasPar-model-method.Rd create mode 100644 man/hasS-fdata-method.Rd create mode 100644 man/hasT-model-method.Rd create mode 100644 man/hungarian_cc.Rd create mode 100644 man/initialize-mcmcoutputpermbase-method.Rd create mode 100644 man/initialize-mcmcoutputpermfix-method.Rd create mode 100644 man/initialize-mcmcoutputpermfixhier-method.Rd create mode 100644 man/initialize-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/initialize-mcmcoutputpermhier-method.Rd create mode 100644 man/initialize-mcmcoutputpermhierpost-method.Rd create mode 100644 man/initialize-mcmcoutputpermpost-method.Rd create mode 100644 man/initialize-normalmodelmoments-method.Rd create mode 100644 man/initialize-sdatamoments-method.Rd create mode 100644 man/lddirichlet_cc.Rd create mode 100644 man/ldgamma_cc.Rd create mode 100644 man/mcmc.Rd create mode 100644 man/mcmc_binomial_cc.Rd create mode 100644 man/mcmc_class.Rd create mode 100644 man/mcmc_condpoisson_cc.Rd create mode 100644 man/mcmc_exponential_cc.Rd create mode 100644 man/mcmc_normal_cc.Rd create mode 100644 man/mcmc_normult_cc.Rd create mode 100644 man/mcmc_poisson_cc.Rd create mode 100644 man/mcmc_student_cc.Rd create mode 100644 man/mcmc_studmult_cc.Rd create mode 100644 man/mcmcest_class.Rd create mode 100644 man/mcmcestimate.Rd create mode 100644 man/mcmcoutput-class.Rd create mode 100644 man/mcmcoutput_class.Rd create mode 100644 man/mcmcoutputbase-class.Rd create mode 100644 man/mcmcoutputhier-class.Rd create mode 100644 man/mcmcoutputhierpost-class.Rd create mode 100644 man/mcmcoutputperm_class.Rd create mode 100644 man/mcmcoutputpermbase-class.Rd create mode 100644 man/mcmcoutputpermfix-class.Rd create mode 100644 man/mcmcoutputpermfixhier-class.Rd create mode 100644 man/mcmcoutputpermfixhierpost-class.Rd create mode 100644 man/mcmcoutputpermfixpost-class.Rd create mode 100644 man/mcmcoutputpermhier-class.Rd create mode 100644 man/mcmcoutputpermpost-class.Rd create mode 100644 man/mcmcoutputpost-class.Rd create mode 100644 man/mcmcperm_class.Rd create mode 100644 man/mcmcpermfix-class.Rd create mode 100644 man/mcmcpermfixhier-class.Rd create mode 100644 man/mcmcpermfixhier-methods.Rd create mode 100644 man/mcmcpermute.Rd create mode 100644 man/mcmcstart.Rd create mode 100644 man/mixturemar-model-method.Rd create mode 100644 man/mixturemcmc.Rd create mode 100644 man/model_class.Rd create mode 100644 man/modelmoments-class.Rd create mode 100644 man/modelmoments.Rd create mode 100644 man/modelmoments_class.Rd create mode 100644 man/moments-mcmcoutputfix-method.Rd create mode 100644 man/moments_cc.Rd create mode 100644 man/normalmodelmoments.Rd create mode 100644 man/normultmodelmoments.Rd create mode 100644 man/permmoments_cc.Rd create mode 100644 man/plot-model-ANY-method.Rd create mode 100644 man/plotDens-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotDens-mcmcoutputhier-method.Rd create mode 100644 man/plotDens-mcmcoutputpost-method.Rd create mode 100644 man/plotHist-mcmcoutputhier-method.Rd create mode 100644 man/plotHist-mcmcoutputpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputhier-method.Rd create mode 100644 man/plotPointProc-mcmcoutputhierpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermfixhier-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpost-method.Rd create mode 100644 man/plotPointProc-model-method.Rd create mode 100644 man/plotPostDens-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputhier-method.Rd create mode 100644 man/plotSampRep-mcmcoutputhierpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermfixhier-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputhier-method.Rd create mode 100644 man/plotTraces-mcmcoutputpost-method.Rd create mode 100644 man/poissonmodelmoments.Rd create mode 100644 man/prior-class.Rd create mode 100644 man/prior.Rd create mode 100644 man/priordefine.Rd create mode 100644 man/qincol.Rd create mode 100644 man/qincolmult.Rd create mode 100644 man/qinmatr.Rd create mode 100644 man/qinmatrmult.Rd create mode 100644 man/sdatamoments.Rd create mode 100644 man/sdatamomentsOrNULL-class.Rd create mode 100644 man/sdatamoments_class.Rd create mode 100644 man/show-cdatamoments-method.Rd create mode 100644 man/show-csdatamoments-method.Rd create mode 100644 man/show-dataclass-method.Rd create mode 100644 man/show-ddatamoments-method.Rd create mode 100644 man/show-exponentialmodelmoments-method.Rd create mode 100644 man/show-groupmoments-method.Rd create mode 100644 man/show-mcmc-method.Rd create mode 100644 man/show-mcmcestfix-method.Rd create mode 100644 man/show-mcmcestind-method.Rd create mode 100644 man/show-mcmcoutputbase-method.Rd create mode 100644 man/show-mcmcoutputfix-method.Rd create mode 100644 man/show-mcmcoutputfixhier-method.Rd create mode 100644 man/show-mcmcoutputfixhierpost-method.Rd create mode 100644 man/show-mcmcoutputfixpost-method.Rd create mode 100644 man/show-mcmcoutputhier-method.Rd create mode 100644 man/show-mcmcoutputpermbase-method.Rd create mode 100644 man/show-mcmcoutputpermfix-method.Rd create mode 100644 man/show-mcmcoutputpermfixhier-method.Rd create mode 100644 man/show-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/show-mcmcoutputpermhier-method.Rd create mode 100644 man/show-mcmcoutputpermhierpost-method.Rd create mode 100644 man/show-mcmcoutputpermpost-method.Rd create mode 100644 man/show-model-method.Rd create mode 100644 man/show-normalmodelmoments-method.Rd create mode 100644 man/show-normultmodelmoments-method.Rd create mode 100644 man/show-poissonmodelmoments-method.Rd create mode 100644 man/show-prior-method.Rd create mode 100644 man/show-studentmodelmoments-method.Rd delete mode 100644 man/simulate.Rd create mode 100644 man/stephens1997a_binomial_cc.Rd create mode 100644 man/stephens1997a_poisson_cc.Rd create mode 100644 man/stephens1997b_binomial_cc.Rd create mode 100644 man/stephens1997b_exponential_cc.Rd create mode 100644 man/stephens1997b_poisson_cc.Rd create mode 100644 man/studentmodelmoments.Rd create mode 100644 man/studmultmodelmoments-class.Rd create mode 100644 man/studmultmodelmoments.Rd create mode 100644 man/subseq-mcmcoutputpost-array-method.Rd create mode 100644 man/swapInd_cc.Rd create mode 100644 man/swapInteger_cc.Rd create mode 100644 man/swapST_cc.Rd create mode 100644 man/swap_3d_cc.Rd create mode 100644 man/swap_cc.Rd create mode 100644 man/unsass.Rd delete mode 100644 src/data delete mode 100644 tests/.test.mixturemcmc.poisson.R.swp delete mode 100644 tests/doRUnit.R diff --git a/DESCRIPTION b/DESCRIPTION index b31e740..11ffdc5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,13 +9,19 @@ Description: An R package for Bayesian estimation of finite mixture distributions. The package uses heavily C++ code to enable high performance MCMC sampling. Each distribution comes along with some support functions that create needed objects and start parameters. The following mixtures are - available: Poisson, binomial, exponential, Normal, multivariate Normal, - Student, and Multivariate Student. + available: Poisson, Binomial, Exponential, Normal, Multivariate Normal, + Student-t, and Multivariate Student-t. License: GPL (>= 3) SystemRequirements: C++11 +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +Depends: + R (>= 3.0.2) Imports: Rcpp (>= 1.0.7), RcppArmadillo (>= 0.10.6), + methods, + stats, graphics, mvtnorm, KernSmooth, @@ -68,8 +74,10 @@ Collate: mcmcoutputhierpost.R mixturemcmc.R mcmcpermfix.R + mcmcpermfixhier.R mcmcpermfixpost.R mcmcpermind.R + mcmcpermindhier.R mcmcpermindpost.R mcmcoutputpermfix.R mcmcoutputpermfixhier.R diff --git a/NAMESPACE b/NAMESPACE index 8c4f1cb..2817a13 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,199 +1,202 @@ -useDynLib(finmix, .registration=TRUE) - +# Generated by roxygen2: do not edit by hand + +export("%=%") +export(dataclass) +export(datamoments) +export(ddirichlet_cc) +export(dgamma_cc) +export(fdata) +export(groupmoments) +export(hungarian_cc) +export(lddirichlet_cc) +export(ldgamma_cc) +export(mcmc) +export(mcmc_binomial_cc) +export(mcmc_condpoisson_cc) +export(mcmc_exponential_cc) +export(mcmc_normal_cc) +export(mcmc_normult_cc) +export(mcmc_poisson_cc) +export(mcmc_student_cc) +export(mcmc_studmult_cc) +export(mcmcestimate) +export(mcmcpermute) +export(mcmcstart) +export(mixturemcmc) +export(model) +export(modelmoments) +export(moments_cc) +export(permmoments_cc) +export(prior) +export(priordefine) +export(sdatamoments) +export(stephens1997a_binomial_cc) +export(stephens1997a_poisson_cc) +export(stephens1997b_binomial_cc) +export(stephens1997b_exponential_cc) +export(stephens1997b_poisson_cc) +export(swapInd_cc) +export(swapInteger_cc) +export(swapST_cc) +export(swap_3d_cc) +export(swap_cc) +exportClasses(binomialmodelmoments) +exportClasses(cdatamoments) +exportClasses(cmodelmoments) +exportClasses(csdatamoments) +exportClasses(csdatamomentsOrNULL) +exportClasses(dataclass) +exportClasses(datamoments) +exportClasses(ddatamoments) +exportClasses(dmodelmoments) +exportClasses(exponentialmodelmoments) +exportClasses(fdata) +exportClasses(groupmoments) +exportClasses(mcmc) +exportClasses(mcmcest) +exportClasses(mcmcestfix) +exportClasses(mcmcestind) +exportClasses(mcmcextract) +exportClasses(mcmcoutput) +exportClasses(mcmcoutputbase) +exportClasses(mcmcoutputfix) +exportClasses(mcmcoutputfixhier) +exportClasses(mcmcoutputfixhierpost) +exportClasses(mcmcoutputfixpost) +exportClasses(mcmcoutputhier) +exportClasses(mcmcoutputhierpost) +exportClasses(mcmcoutputperm) +exportClasses(mcmcoutputpermbase) +exportClasses(mcmcoutputpermfix) +exportClasses(mcmcoutputpermfixhier) +exportClasses(mcmcoutputpermfixhierpost) +exportClasses(mcmcoutputpermfixpost) +exportClasses(mcmcoutputpermhier) +exportClasses(mcmcoutputpermhierpost) +exportClasses(mcmcoutputpermpost) +exportClasses(mcmcoutputpost) +exportClasses(mcmcpermfix) +exportClasses(mcmcpermfixhier) +exportClasses(mcmcpermfixpost) +exportClasses(mcmcpermind) +exportClasses(mcmcpermindhier) +exportClasses(mcmcpermindpost) +exportClasses(model) +exportClasses(modelmoments) +exportClasses(normalmodelmoments) +exportClasses(normultmodelmoments) +exportClasses(poissonmodelmoments) +exportClasses(prior) +exportClasses(sdatamoments) +exportClasses(sdatamomentsOrNULL) +exportClasses(studentmodelmoments) +exportClasses(studmultmodelmoments) +exportMethods("setBycolumn<-") +exportMethods("setDist<-") +exportMethods("setExp<-") +exportMethods("setHier<-") +exportMethods("setIndicfix<-") +exportMethods("setIndicmod<-") +exportMethods("setK<-") +exportMethods("setN<-") +exportMethods("setName<-") +exportMethods("setPar<-") +exportMethods("setR<-") +exportMethods("setS<-") +exportMethods("setSim<-") +exportMethods("setStorepost<-") +exportMethods("setT<-") +exportMethods("setType<-") +exportMethods("setWeight<-") +exportMethods("setY<-") +exportMethods(Summary) +exportMethods(getB) +exportMethods(getBurnin) +exportMethods(getBycolumn) +exportMethods(getColExp) +exportMethods(getColS) +exportMethods(getColT) +exportMethods(getColY) +exportMethods(getDist) +exportMethods(getExp) +exportMethods(getGmoments) +exportMethods(getHier) +exportMethods(getIndicfix) +exportMethods(getIndicmod) +exportMethods(getK) +exportMethods(getMean) +exportMethods(getModel) +exportMethods(getN) +exportMethods(getName) +exportMethods(getPar) +exportMethods(getR) +exportMethods(getRowExp) +exportMethods(getRowS) +exportMethods(getRowT) +exportMethods(getRowY) +exportMethods(getS) +exportMethods(getSim) +exportMethods(getT) +exportMethods(getType) +exportMethods(getVar) +exportMethods(getWeight) +exportMethods(getY) +exportMethods(hasExp) +exportMethods(hasPar) +exportMethods(hasPriorPar) +exportMethods(hasPriorWeight) +exportMethods(hasS) +exportMethods(hasT) +exportMethods(hasWeight) +exportMethods(hasY) +exportMethods(mixturemar) +exportMethods(moments) +exportMethods(plot) +exportMethods(plotDens) +exportMethods(plotHist) +exportMethods(plotPointProc) +exportMethods(plotPostDens) +exportMethods(plotSampRep) +exportMethods(plotTraces) +exportMethods(show) +exportMethods(simulate) +import(graphics) +import(methods) import(nloptr) -importFrom("Rcpp", "sourceCpp") -exportPattern("^[[:alpha:]]+") - -importFrom(graphics, barplot) -importFrom(graphics, hist) -importFrom(graphics, persp) -importFrom(graphics, contour) -importFrom(graphics, pairs) -importFrom(KernSmooth, bkde2D) -importFrom(dfoptim, nmkb) -export( ## user-defined constructors - "model", - "modelmoments", - "fdata", - "groupmoments", - "sdatamoments", - "datamoments", - "prior", - "priordefine", - "mcmc", - "%=%", - "mcmcstart", - "dataclass", - "mixturemcmc", - "mcmcpermute", - "mcmcestimate" -) - -exportClasses( ## all classes - "model", - "fdata", - "prior", - "mcmc" -) - -exportMethods( ## name of the generic, as with other methods - ## 'model' class ## - "plotPointProc", - "hasWeight", - "hasPar", - "hasExp", - "hasT", - "getDist", - "getR", - "getK", - "getWeight", - "getPar", - "getIndicmod", - "getIndicfix", - "getExp", - "getT", - "setDist<-", - "setR<-", - "setK<-", - "setWeight<-", - "setPar<-", - "setIndicmod<-", - "setIndicfix<-", - "setExp<-", - "setT<-", - "simulate", - - ## 'modelmoments' class ## - "getMean", - "getVar", - "getModel", - - ## 'cmodelmoments' class ## - "getHigher", - "getSkewness", - "getKurtosis", - - ## 'dmodelmoments' class ## - "getOver", - "getFactorial", - "getZero", - - ## 'normultmodelmoments' class ## - "getB", - "getW", - "getRdet", - "getRtr", - "getCorr", - - ## 'exponentialmodelmoments' class ## - "getExtrabinvar", - - ## 'fdata' class ## - "hasY", - "hasS", - "hasExp", - "hasT", - "getY", - "setY<-", - "getColY", - "getRowY", - "getN", - "setN<-", - "getS", - "setS<-", - "getColS", - "getRowS", - "getBycolumn", - "setBycolumn<-", - "getName", - "setName<-", - "getType", - "setType<-", - "getSim", - "setSim<-", - "getColExp", - "getRowExp", - "getColT", - "getRowT", - - ## 'groupmoments' class ## - "getNK", - "getWK", - "getFdata", - - ## 'sdatamoments' class ## - "getGmoments", - - ## 'cdatamoments' class ## - "getSmoments", - - ## 'prior' class ## - "getHier", - "setHier<-", - - ## 'mcmc' class ## - "getBurnin", - "setBurnin<-", - "getM", - "setM<-", - "getStoreS", - "setStoreS<-", - "getStartpar", - "setStartpar<-", - "getStorepost", - "setStorepost<-", - "getRanperm", - "setRanperm<-", - - ## 'dataclass' class ## - "getLogpy", - "getProb", - "getMixlik", - "getLoglikcd", - "getPostS", - - ## 'mcmcoutputfix' class ## - "plotTraces", - "plotHist", - "plotDens", - "plotSampRep", - "plotPostDens", - "subseq", - "swapElements", - "getLog", - "getPrior", - - ## 'mcmcoutputfixhier' class ## - "getHyper", - - ## 'mcmcoutputfixpost' class ## - "getPost", - - ## 'mcmcoutputbase' class ## - "getST", - "getClust", - - ## 'mcmcpermfix' class ## - "getMperm", - "getParperm", - "getLogperm", - - ## 'mcmcpermfixpost' class ## - "getPostperm", - - ## 'mcmcpermind' class ## - "getRelabel", - "getWeightperm", - "getEntropyperm", - "getSTperm", - "getSperm", - "getNKperm", - - ## 'mcmcestfix' class ## - "getMap", - "getBml", - "getIeavg", - - ## 'mcmcind' class ## - "getEavg" -) +importFrom(KernSmooth,bkde) +importFrom(KernSmooth,bkde2D) +importFrom(Rcpp,sourceCpp) +importFrom(grDevices,axisTicks) +importFrom(grDevices,dev.new) +importFrom(grDevices,gray.colors) +importFrom(grDevices,rainbow) +importFrom(mvtnorm,dmvnorm) +importFrom(mvtnorm,dmvt) +importFrom(mvtnorm,qmvnorm) +importFrom(mvtnorm,qmvt) +importFrom(mvtnorm,rmvnorm) +importFrom(stats,approx) +importFrom(stats,cor) +importFrom(stats,cov) +importFrom(stats,dbinom) +importFrom(stats,dexp) +importFrom(stats,dnorm) +importFrom(stats,dpois) +importFrom(stats,dt) +importFrom(stats,kmeans) +importFrom(stats,median) +importFrom(stats,pbeta) +importFrom(stats,qexp) +importFrom(stats,qnorm) +importFrom(stats,qpois) +importFrom(stats,qt) +importFrom(stats,rbinom) +importFrom(stats,rexp) +importFrom(stats,rgamma) +importFrom(stats,rnorm) +importFrom(stats,rpois) +importFrom(stats,runif) +importFrom(stats,sd) +importFrom(stats,var) +importFrom(utils,tail) +useDynLib(finmix) diff --git a/R/.mcmcoutputbase.R.swp b/R/.mcmcoutputbase.R.swp deleted file mode 100644 index e6830d20d58908b0300520a306baad2937485fe5..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 49152 zcmeI536xw_nSh^&OK=cIWD~@j4v=o_R5lm4qR#m4v zWC53>D1xYMv<)BR5U_b_8+=fL)5j3MH9%MuTMP~qU84ic}{(J9R>s41(ckl$Q zclxWYdhf3PUEclgIxy#~l|5=fYQDpDu;UEgwW9CBnO8gazRPhcxshVwTz9yTb<6U& z-qk1ODzkdhnWe?zmRak{#Z~HG_KnpvwLTcWJWT@(Q0Y5 zI*_iosouC7?cZ$)v?VYJ35-?;XPt7OGk@OPIbwT8$8>ebE7niKp|+K_1lkg4OQ0=* zwglP|XiK0ifwlzN5_rB!pjtY>Igh~aXCv??`~L;8{|DILo>K2A=AOA}_W3UR|JIoO zm)hUM_W!BYqG$gl_Wn})|Ff~@FS7UPqR`h7Ho%_!7u)-X+yAG;p6_q(d*PcGd;T)} zJZ1m)#-6{>-uJ@szSwj7xc#p!fwlzN5@<`HErGTK+7f6>pe=#61lkg4OQ0=*eNqDH ztm7O*$aaY$jdJbj|35y+arVFsa6Ocu8y^g4>4cZ6xppcyUvX7#P<5(ou2NNt7O4(* zyi_c>g=#LH?@(Q8yHjIL-$+%<>5N-REzK2*BbZGsWeP>78t+zFcdP13u$AcBfVJL? zSL=$oN~Kt6>{B#CC1b5a?bs2-GE*#MQ~s0MXlf_&xh?9rT;VvC=~Q#N)m+3;Yf=mD z)LCkL@klZ2<`>KFQ0&9<8yqcUs<~pp7t2Z zrBZkpa!gA;@k1;stadC}vk_T#H)l)y^=)-Ki7v-(O6rEJRNQKhTOBTDJ5@(1U##}) zT+z|3D!HLTx;k2xJfWQ+Y|;5P7;>C&M%n4a{NiUOpRQCoivw?WGu6eVa;{h=ZXIVA zI>HvkS|(lX?9leLDg8~Ug=(#~s)~cgsg9&rMm*7}*w7Pgs=g;l;xDBuRkt&n8}Xu( z$&Xg5_(a;}(Tfn!p&<2p0n!4A2T300-NI0H z*b7d+IMgsPG2^?sP_33qxHwoF-&)5@=_X1-y4;N8K@`jBLdh+UXiFk>Tkh=bMg?zR zv|Pv)jE^DP=5`~?J$^`ybgkDtjqK^NYwe1s;j%oD^liN`GpLhh#%h(sn%e}c%L(ee zj>>Rx438VtZlU7~2W6gSX zhFfsU>AYGuI)EFzsI)uI3|y)ISPd4-YNS|p(Fw?f`HFbjv%GiNnM>C6FIl>B^~(N@ z3L`64_ODsq*QZvj?Nv+Ex+T5+E0?Wby`)#ITi?5GZQt^gQhh{-uwZ|~%KkIguJ2bg zbk&9>y}dZK@%35?OyySYR=1!7of|3Tb3|oKa%q9WQyj#yk(0_*v?fr_4UASX!%Iuz zIb1A>C+VunRdFz%R|BpZt+<1u`EG?t9otSGZ!353{z z`c#IA)WEh#dAW;HlT&Cxm}>83X%>yBG%sP?^?Qfc8r85KtFpIO0@ znC_bCNC%wQ>GL~xeP{dneHZ)s0~baAKZ0O)Gj=Wdzc)YrS#=C zFby7LPQh;Y2&{)ya3Z`I?q+_$H{k-<1>>+4M&XTcCdeFwBjIu89NY?5!62Ls^Wa%J zTb_b%!p(3Kd<`yy_d^c6`3X-l2jM61Nw@?CVLo)hQ_M&BANU2zUwJ^S6Zhd-51 z4=@rq;#NX)4+7hgR~flZ72L5-Rn1lD%A)U99LiO5*x8_m2`Y4EJ7QEWJp&+>8Fn*U zQbXm_-K}(ac6O=bk2ez>LK7pR-k84KAUvBkZP~mT_vp|ac*kgwAz(#k=%!Ss+M>EP zhdh+dQn^WQ$Z>_;7D4gW|<9-THL-Rp}JQk|U4gvR%yPhyB#E6wCuh zZs{nlQm5&e4aT=r7MY~_s-xMF(R|gPsLnSJ+BbTE;`IvM{7MPy1rdW<9q_`R+rhVK_%YD2sGIUh0Eb_=EUt&qDEr>yp zl)TWOSXP3HEL6FO#i%oKr^O0ZtTbQACe&5pKr|GlsD#37D_+q~tbFnn~@NRNcyG4D-xlFUdf9{*wtLHcMVGUVRsOTUFe5bn@u6GJ$QL zI)SgVB6H=M@+F@h8OX+8i*ZlzKwgaAtI-d1a*~9?;$T9F4CKFDq+o`*hfG^D9((PG zO)_>$bhJ-88eW9M)iAcl7l&S?#tq-)@x=_19cyknayO8`M1{m_eKc1nWO|kkhnaS` zDyY<#2QxS)lUHI{#WX2`82Cc3$tk8;vxU@O)wS7J(+Q}XG$Pe_9`R>uHRF1TCexN= zcO|iWxBT!K`Pg#mHIe*0VZxV~B}%c(;N=C+^NDgoNs`-MI&~x`lpMJeMAEA$Ya60= zTBGEEdQDF+^Vd)R$dufUNCVBZ&$_&qLcE&TN0Z*K8~!@!pI9Tbk_nox4xZzj5S}re zoDpWA;gdyCoS0-#k>P(mo+`~#qolaYgavCZ zY8yQ}>o~ta|2`FcUG#tc^z}V-`>(<%Y=I?kAiNOn#_XMNJKP4B!^dF^vLJ4q0LQ`~ zaQioKExZ%f!g4qS9!0Oe1+Ihlz(-&ki0*$HyaK+DPA~fYdtf;n38LG73}n5)DKHcM zfWH0>_za}s7&sUnLRY^MvTzo>2A)JG{}Pm70FHx0;6Qj88~_iZpFaS%!EU$=&V>PZ zBZ&U~V)zz1`g>skg!*3SV9h^|fX*msWM0iOyLZBIi`p3RlncR;Zxma(B=S5_jrUWi?8)m}Zthgmn|9RiW+O%TluNmRsmEeVzY4aoLAf{gD zfmGsN3sxIR=s)nB2usSh&%=-t$hEfrLF|VbT=6~#c^nI!I5}ZESnPy@BfpdFIPyp? zyGkVJ`-o+uO8CCMp&ubBefd^K zM)iGf`n;g8fEe&d*8|3k{-3G6-!;eDksnVy}k;NQ-dNAtpT+NO(hu0^G@h{g51MT z!{480r6ekezmIo;B$ub1>#8}_N8{bMNgDg9@5Zh0*72?}H~8kQDDm#tS53$-?@2SB z7_-fov@b#Hcxxew+if-uErcsPj1&kU_}17<9Z1iD{$J~T?VVcj+sK9kl+rKe`lBJ? z$5R*$F=~qmqt}a+_=1jB_cc04Si9QrH#0UV`u}6-*;({)QU1OC^Zo-p{|k@@nfHGR z$aw$%q0@`bFYEtrgBd{J8LI+HP_SKfaJ}rSrUCs}` zo{K%GcfYZPYA)tfT`SF+s}~mkzSnCX>Ikdrc7oYvI?cqriTsPZ5%)j(yA_w{>4;ww zS#QN`JkUwKh2q{s{w25(4?^^Ji;mTFUq)S1+1T%<0vof_Opsz$;@&iPyvS~NP`8tI zs`lyRo%kY-riEiacXBymC203}id?JrnE+PP%Btr^l3A96PtYQ(4PP^EME#HcN>EuR zZXdQ{y%n?1Ma2CSH39L`*Zb9S+$D>I@`(36JQt^6~?8{X5_)_zYYLTcHZ)z^QN;91MR! z*M9)M2=9hrI1NsLe}o6o@$ZA{LDm9%1>ObcgY*kXKfp0?1U!S@{}Akk^FihUq@WX? zLI1xKz6qa%Pr%1v1h&9BSOkZ{gY*mB2JeUSU>Fv{ejsxNZicVGweWek26n=BcpIz+ zk;#0JwE#ayMn44EbMRa!!CZKXeuSUGwXg$nY)uo`YZSK6CTyJ!<8CJ+t+v{)fWcV3B~hjcI!|Z!f5eo43=v z$sjnvw@y`W>X|>pDu#oA8LQ2E+PulQAL0|X?KL@fw5`^i&^DU)aW5HfJ)E^7Yd+Am zcJaT~x)-Q~uK0vo+H}49JgoO9>3-6^_@IpmT{9+$nY|`8mU3EPyYbLQOQGuYTt+zF z*Crz*6S2eN9%5ZvZPA^*XxutAg$N|(k$Af6d|DfM@x3)En(#ImTpPJbc~L*_>o7OY zR0&Zw<6P3*tz9zWw|4j5l93wS67?y(RHD)BjGDf%1_NIr?%E2e-om^D`G^D2YR)8d zD9~2FnYwxtauZ*1Z^F59O=h@w0S^W?Yu1eD^q$n35tFR3+2D415i^w>k)mAwTzez4 zB$4g)MI#|k{CVNw)mxz{jKNBdq%|W63F5B~uyNJP128war6O4LR*BH6H}aB2F2T$+ z69N4w$dnV6iB^}0=pfhyB4*j2&J>ehA)<3eEMu5L-c-JL4wi@zMLQj;^%Wx6ZEk%C z22CDlc5R3jyeZN)?Y)&D`bkr(LPXYPhILEJLbM09X+Eh{A$vEuMgKn@#qhtGYcBf# zuvHT8N3Z`ckUoH2umiTk3OF6)EPzAccj)&r2jE7y8e|SY29AfyFav&rj{XQd3_k(U;m?IP!CH7d91f48r~ejy05`&WK-LAE z1_!}3khFSG(yOUUDmh&NPhrg$`PUX`zkY9R-46~lQK~UzinQ^?o2_FP0M=RVgQcld z>E3W~sFkxfiuRP3`6#_oC#Y|{1w7tDA6e5g?AJy*h2zV70?XdwvXQDg&Sd;bE-RZY zAkdDLtTEDCpjH_B&9KSHA~h$qK#o5sh>`jBt(zXtvA+Woz4ePxvJ_X$Ow{ptvb0t9 zIG&F$nQW=3w?puJIN9vZYn=6s@&yAaxog4^@y{H@kf~(Sd3V!X)}M^i*1=o{A>ZbG zwKnA3gHC041|GCj`T5}fB?0$@y-=;(~Z=I_Uvn~u4wKbw!~NN!vob`X;0 zl;b+DnYel$PZV3vjKs;0t#{MWF*P48#g`K+_GWD7HyK;JZ4g&;ltwJB+zet`97&TG z*l6d(Zgo<(e4Z#%leGcb1FUu$EEmU&5%MwlpH)xn;IHjaeCC)xZ`1Ce!Dw=+mNM(H zwx!6s#WE!bM=Dj>tyhW}KDsRKldp46vcA@=wF$XYX4mk6BD`!-$F^Hoex>jU#&?w9fZ_mPiSh~@>q_o z!9zA>LuPiU&a&q;UdJ!lvRUs5J`+b~idosXUa!z(uj~@rWpitY9lr~*hQ>tF?9}bM zv~p0*Bq6nBeJl;dfR}-_E;~rGN4D&2uBt_qHg5Qq?H93-DY73oYfKe;V5jB08=DCd z!%ZzAC&z@08DGuGE`epeT-5~I?0Dt-oE9OKhI3TkGIxfpd(1xR5)_?%bhfiwYDdB# zd08$3SsW7kk*Bzo@Kl!j%WZSe4R#AE*v;J@q7iXMyTONUrJImd(jp+)i#&_3Z0l1o z5zD%jOgX3b8W&sZ^uk+-2Ehvni2b?AnrYdUJBO4#32Hau1xDYTdYN!cQIEcf>%8Wh zeakC0VK3*-rJ6DaBbirtYJsh7@@!Tndp2}bizQwI<|l?_<0n(%sVwz7n}_nDihyx7iD zggtDdUQ0+CMY$1i*_@P>nissd=Thip6sqy)|Jp0BwK}d$ z=Cu~Q$Kv~lHGZE-oD&xl$^)-UP&c2<553EWeF1JT3j@4)3z8Y*J8{|9plYd29xbdA zkm%*e&uAk($aL0dVvZO6AJx@461`INe{cUkIs5M>*bVOk(fzl=(ESqq!9{RbDoI!Hk$$licIqW|DtxCcH5SHUH)6?&l?j)y1cN7w`30oiY$0_&g?o}?e) z9=Hpxhs$9YP6C-5u!lss9=-_w40(7v$ew_wz{xNJ4uFT~U-&xQ05V_TY*+#(z@O<; z*bVQ7W$+p}5@gQ6FG=&Szz*mI$pc4#zHFvZ4XZ=xKa{H4Yy}gXy3$jb45r@%GFR(c3&ea zE!#o9R|Gb1PF;bSu*E+e?}ibh?bR{wqh`e@+di3P-^O}kAG-FZ6*Ws&q^UwH%2usb z6IB1L_0C(*B_^xbHEW(^6D_J$CUUk5H(cYl*l%w#$;2Hn;mY1L26S1PYre-aWo@l) zjEUeQo+Y$oCM>#P^LXO*%A^(q?(4)gjgg7VZD2*`H&fi2EVXv`O?IjxG5js1nk=zR zNr%cS99e(pqHe7gHa(GOlB%$nC`uDbAtYN}#C2ZOb(yy(saFI`LFqGFTS?k@%b630QRXc4hm>?bdKALg?jF+Fp0vSnk|A*s! z(=}F0FUWY=Z18$~-jz}uBeh{-H|J5QwftOizpSz<6CYx<4gk z)&EVanO?d6VUGUuH8b{Dqi2gl`jpvH-RrwsSI%wa6uH1$N^H~FMi(8sth3W|O3lz` zt*t52M^QD~wdvkJ*|*KQnPWe9wr^(>w<3MVg`8FF|zlaaapW;TVuP{NI6(!T`JpPKTwi1YQ7lp@YkO{ZGJKU=AD$9WWh!g&uw# zTnOjEGLZfH!}|bE%CmS_L_j)B~un8-1R-uJEPFAe`zdYh@68;F?6qcG+8#J4-<;s5 z|5AuYHEbv_Ui-~RhCX<6s4!|k@K#YB;Z!2!+19C`cbxPji&E9<>n2qh9bkT-N%Khh z#DybCGn_6AG3qr|;MH2uLomEjqp=`Uc+P~vB6*@KAxn5hb-a^&l*};Ggi+Gp=8L3k z5DLcx<;dn|ic>V$@n1Cw5h;HrK#?RcF_}aP#0rVonz&n~QmMM~kmm6^CU?k=w25V6 zIOmpUhGLi~5PL|4H^!9UVO%KYw+#M~(KvXxBa%Nm!oiBjMg{~EvL7TW%W>bi1K&Mc~_Mkgy6$K;3x zpIS0H2h__mHfXidiRBx~*B#x_Y*X7~9M4EPc;?iWNM}aqY=Kw|>?=gx2XZd7Y`EDm zkSi2Na_PKmmm4lmzE$HxSQD%7fqv8YPM3RJ3KZHT>?8!Y%bpB#rb?e`3iF=ip{jNT$}MT2CQ;hIx}oq`lZTl1L?` zQ8P77G?BvZC8euinS$6vHH9lF97*@W;WMpc+m!WQsnRnQ$(Md0gNVgf$k&fpsE!D7V8xyo zl~|Omcb*I*VYIoyAE*umE%ep18r#6H#XuI!VMtR9qZ0~O=&KjR+O=09L-uQ35u%1X zx1lr3fxO(Cm@5(kC!(9+6+pba_{YbnLVk(pe=#61lkg4OQ0=*eL(`! z(nJNRJ-s>cv|W3Wvu&QDbxV)y%0f0c#@Y5Cruq`wjMk$5S1<$NOt2l;W)`&QRR@6r zqPrMzNG`k@Npq_2c&E&KcgHt%svhRvu<*6)_Q{cgs%v3Sw_?(;BgVDzWFJmvEsNhJ zVeg3<9F(DHncd^2GsB8>GD}FpPO$pV<@DGpYuIGC+qJ_avQ~r@4n50ymf0b2Z+3BL zl)*|#Vi`Mj+}zrvQ=5b}v9I&#$o)X&4Zg{JamZvMokZzMN{=0Msx?bOdDLn%(T=OQ z)iU!yZC=>aZL=pCf*e9OB`W$FnR2dkq_<#80-!Tvx`0hyi-@{!h9LZ)zc31C(FF2;19J^_|66i{xD}k;Ax)SJ0peuo{ z1iBLFO5jN*f!gHE%;}W*>89Ly^Zm5Q_cP4jCz$V{$o_52-)EWc>m&Q0Y5ulGfkoy7 z_B_ur`(IN^ZgQ2V4MCq=J(a+dpxrL|C!(O=KGtG{m(VOzuJ8FZlyPD z{@X_OpB35vJhT5K^L<}r|MSi7Cz|g=x7Hgre@rjxGibg)9NE8}`Q2JZ9**pPf!S~6 zbGW%-Hvboz{r3FtjqKmv?6(@>!;$?jGW%DU?<36(xB2g2eqU<7-yhk(qxs!l-~EyO zFE;y^o9_cmg|YeXW`4K%za_HYh$C~DIqvSr{+-P4N0{%InhIz0-`V_rl=&`1_P@mZ zzR-MM5!t_s`Q4uXPm%pEjqKmwRA_ttmzn*Cn(x;|_P;!`|AxqZ&+ND7-^MfuoByt6 z{~_l4sL1}T`F)Z3J~y&|hWXu=@6O2nnUVc3HVw|6-!zAetp_JW_M7D0udW2T66i{x zD}k;Ax)SJ0peuo{1iBK~j1tI?Xx;xKGEhee&6{)Gjly~td;zY4N$7`Pqv+lMUxnAh zA+QzPiGq9wyd9RpQ7{|+h+=&utb_TGfv++4e-j)I+r$5&OMDqFgtK84yc~Xqj`Kx0 z3yy}D!tchLf97mgdTi5+yocF6s(02cs1+}k8YjGd>6hAx4~y%6HLN<5L>|4;N!3f4uY-V zf3QKk1(t)@GycXs_%2)x>VBwu;l)3jGV$NkFR43ZZ>3P1s+4-Y!xkR3YLVBMQ7Pj8 zZSo4^)q?lhwEfW()xxB=z{_U6zVtk!X|f~5i9)GbESJ2w-Ue?;F5BPi>9WTaifhJd zRc~UdTJweqUU}4OA$5-mFzNBiL$4_e*K%2}`4d;i%QdfOy*fP^G&*gyR-WwjCiB%= zp*MS6rCeI$1y@}+b#c_|_0|DGis$dyOmx^p$bK z1q*cGtVyRYGQ>gUPFx&>E#H&wDV;d@#$`i%>xHLK~##nt&`R0bl3d3u2 zgSn*=R@LiYxV~8v#cH)!TBCjrGE&8ra+<55cofT)(61!wu-I9HH0IR$2YY_%lS-$~ z@1Ne!bNAhm z639noKoPQ&Wu#UvWi#q${!`ge0TxhhF2KJ>!{yRQ&K~WbLQ*Y>UW*k=>{`^3=3186 zYq8?WNM7NKk@hMzBGk0xF#WNufZD1a0=hMrTPrCu_Q=q;N~YUHc4BJ0W-Fhm-=SmW z4^zMewp#b~OWWe4<20RK{>qpZD{=@LzLs1dVOke0i=$`E@D3rsuvVEGu9Yj^C=8G1 zt5wf-<}+qwGO5oqQ@lp|2km79#m?BDlD{2kj+fUI33%k%nn|NYIXsrHwxDxbz@E`Yi?{he#*HSVRpB zC|G8OmmimL-uhx~%+vABIdAc(S1Q-~Nl@@!F;=Th&YwMd{rdH}HKnOsxw2;VcyXAa zaG^T;z#JL8syyXY$I4UVBi>kkU4cRSaG|)aFyiIC;qv508Ftpj3f|$%j`0pJlnRyn zxVK_zh&;TbbUv9G zF-4tZtUM_v$=AGMjSR=fWyC*KEsRc$_j??vuC|xm8_QD_uRJL?u+PhvHhSZEx>gxP zik2Z4DPlXULYY^UM{5*;zsggk5p~b|y#lu^INsaK3ff4uADNH`$8(V6MCKD!dr%#5 z=d0eN+@Iy* z-A`8nT?uq0(3L<}0$mAoCD4^XR{~uLbS2Q0KuZ$Pz69g#QMTE2+R&-D#ZWQan=O?q z^0&B3s$gIVX|D}DDhrsLy+WZ3Tn;e92YX5_xpvFgOiIo1D$u_$VgF409Zw=nXYQD!FRj( z8^J|jyB*JAWoqCW^`d@Dt~zjkrkl00Bcr~%GLKC{nXyHsS8gBC+{0!qtP>^Wn9<%t z&$th(lZD~pD28UaL`kJQk^^Y}^PLQg6G1r!#tWr2wK3&Wlf!0Gjy`W!<=z`mzP*g- z|5&avC*yM#{r@mi{jNjjpMYK9LG<_wVKwXtTf-IT@TbA4uo|qd{~G-JHCPGHh9BbJ ze?PnmUH}i`*S`QxfL-9n`1G%VGhq?@Ke!1${zqUKX2SjW>o0}3!W-bVumB#yKYtmV z49CMUunJbfzwpcd3O)cEpa*`7FaG_o1h$5&@WD^Q0PFtiv*?ewy9VF=@-ZEpk$e zS60^?8TW~YXofedqaT&!Kz<5$b6`tOu%F492gJ1Nd=64Y>-P>?S6ovn)bRiJXv`jB#k01)fC+VuSOUGd*fKe1^fQP}5&w7GsZHH462d|hIJ~sG9V{PEiblc>1w6g`r^Z|ie)^w&|%EB za+~#2&@arwl2?!mNK9L(D6y9?-&d>oiV~ZCHdW;|>I|ht@SzT?O!Fau>O)2f)!|A} z*|p`EW5r=5J%PSN+AN-yLQOrP{W`(@ zR(CG%4MqAVEsY!=GTp~zqXP@=c=1Nc;$V@7>F}7`G$ZDmx4cAkWw0^JkGt{598x$H zpkv~54z=+}%BJrYvuChJ`Anjvqvy>?F4B*Yf3M#i4Gi|Jo_nGSV^HA$kzMoDF53$R z0t&VySN&=FIgyR_5#i^8E~(8m^quvqi&KwmXqEIn;gN|J8g)*hnpzu|c<#VN2MU>| z!pupeHAjLcf*)R?<6jb8tIdmr=0T(KM_GP7(0yT8NSTma+&{9D!RU>iRCl2MIIe90 z1$W1lP;}@v$-^-;a&t?lx0{zsPibnRP$>=*##ZrqjBB;|(L^?(t{4XzU6A#O-5!sUpro@GO^$NNw}!CTT*xq63m;BHl|6b05#5z=;)sY7jxdGo%vd+*(i#kO-3ZMV`!Y3p zZGV*O1fke|xI5I{(nH-k1KRjFTZf$W_VuX2xE^0J)RYJX2@6o8SIJNXtI1H$89Lh$ zoy1+38t-{(NGtUKgNWB?XuE1}H7YfcaMK=@27@G}|I6HM6>pCIZ|C>_8omD}cq1%< zt>F&z{!hcZ;Y`>7>tG6A1%0p!{1$t_%^)^{bKq!rG2D+m;8yq;oC~jmQ=kkbSOG7G z7r-yD72E~igFE0XsKOrbJoq}cgVSLJJR5GuZg4hKVGy1Tzs7d(S@fQZ zH;lnPunpXSJ>gt90cOGPu_=h`KMctqzovvXRNs|dK}b5`m}@*|^y~+Zh>=L?lWh>Z3KM=lbFt^eqgfox&cz6noH=SiVMH{HNw_mL8u zHaAIub1QTRt?uc1H}n&Vw65RF<#JKO;ihM+sR(+AjYg|13fME#%!GaQ&brE2KASkL zo&n*Xme5|uZkjkG)fXnGKrf#D8AzP1cMXdIu6O<3w2HV~>EHeZP))wR!^VUU%Yih^K+ z`$SdtTUC?LICDRw50r;A zYAwstiV?jUO%l78QgnTdCYF_3;9sUU+w3Ds-H1^H%A^_*h8V}h${sz39y|IISm=9| z87=YhH&NZZ#l%e(m@g%9krVli7}B&kak(-JRgIAj)to9P_oi9g$W%|MtkC$W|I1MNuDJ-h62^s1zzD-x>yoH;T>48(eT< zmGcgf*(u>nd==g7&FE9A|3g*WZ_7Gw8Wu92J7-SNyi~}oOyrrvMY?l`Z1apX?@pPJ zx%L^JH61rF86RZJq7y|djEo)`@nICfSS$V>GwWegnqQAMRvsU*RoZ5w4U3M<{7ql5 z*fG`E)irVr4C?b6gQVXiNv+G!W6r6|qGNkKfe^Q(CsiBNCV{8~h*oq~HSOjiz(UntYWy-F8vQz$IWp`{DiKW+< ztgWcnqeJG{Ri>k_>Jnl&RyKk_FuF9_{%&TgsFT=)9`<@Bw5i`Z<1$>ck&lrWU}o}B4-5b1#K)d> zuF%RSc@C(43h^kk^EFLBqf~&{v#8~o5bAKLa)VEVYLI+yGRZ%Oe|0NIc#r)nV>jx3 zCsdiVbV)Tvk3l+FZN&dCs^@>Ai;DmMETe>8gTDU>sK5{$3xluO8R_rgXPhefbI>Vq^FLTm~NjS%ct0I0J^^SlAmRzF{|*2|K`p*dT6z&%ztwXxIaGfbHRh z@F4bx8{slI6_!IEya-+hFMvN#FTMts!UU*#B6TFWmb=sH{0Xb3n~V*FO%{4LBjw=3 zAlsb^tsnnM=|laJNgs?1{RfpAKJ=-l)5^l+cz(FxPb6nxxWwt3yvQ@kYX?c5;=NUxkAfR)o0fd3G#F9FZEpG7whk37-@VI`qd zd#ZyHK*rn+=c^+X;82Pc5&`4MRVIp{vAQ3w1oHfJ%NZ(Qv}%gd>S`v0OI;Ld{WnNcuLn0Elu=q+imIS2^4a> zM#>7u0-`6_=FZnjd5fYf2@u`|9px6E>| zGz9H;kyUVf?_9hs1U7FRFxIG{JuuNcP5rHVT%x?RJCR=0_3KC}8-Bzc#D^<$_zGMPqVt~t zi{W|jJ#_Ue;Bu(KT=*jblC=Uq3Ll2kU^Og*e%Kvm!VLHsy7!0R1lSq=jGp}`xE(|n zmly$A7jOym!7d={16~R5gtx-k@Mbt1wu9fGci#`6hl}8YZ~?4_9YOBh?Q;LrM~vZ% zOT9i6Wp6%qxj2Knw!YNZ2MmKsx`SE;d zm@?@^g!A~tW?hdw4&>21^Qv+>mA+PesJdV}VuBQjllK=5MBc`+=8aa$6UrMY(Q#gE zl9Jz+)rM<*%!GHDzp_2@01a6N^_>qHrNcJGV@hjF+^JyQ6^R(J{e>A-#O%xVX1Mm5 zdEy{cVS{OguaK)Z$>p(JIHOMOs8^ZgmhRS8aV+Hvm&bq^0$k zu$7*^981qsSWKp<{AQ87Xp*X7^7PTo5LXwu6id{@&^ftNK@HP)zZb#T3MMWxrwuYk zY*2Etf$q{b$RX;fCBN90X1|hB z*w={Y!e`=Msk@Fm{Ub%Ao0=&3iv*cI#O)WCsBXgSP@M~-t#!o_$~?4Domb)s-4bNf zW$Ko#{r*n$qCDqiJtz8IKLn9_MlIEzSN})4E*4OtgNrySRZ^!41>GIRu{Bv);;K1s z;drf#y-HS1;y;yip^>WggG%jEMN(I0yLV|v_OT)jOC?lYr}(nDYidG>97QdZEc{ZJ zD{e>2(K#)R!7&!^3g&yNv&k?=Vx8n^rp~aULSv()*%3a|LZd@Y>6(H{ZaXUdZL7SI zd{R<5(3m;>^)?$Eu6JWGbe>{Lywv=JPbU6b^5U!s2iohl251SB5T8079hEo1ChXcF zH;b&y#aqo;WT1+aP;5{+FLeEHz~@2y{uLO5AvhT%4nXVzb`8MCumOA98QGA@O*eW$UFhj|K9{B!*1|P z^!h8|c-S5O#{Ky}_#NB>KLojFcSGVwHyt}}u|d5-g9^5!f`nTHM@w&#H52K=jbW9o zP;!V3gpPU@u*o%T#WA1_8)=g@n-y?i>cxr-SJGoE>ufjBR z4CDN)f7{cW8_L){iN8IxQHL}q1U{J)ai~*x8pVL#5nP2I#*0NEbVezW{x~`CV^UHt z+!KV7R#5+#e1W+9>}?AjP-7w)I*2({DV@>f-lYT#^GSiZcWrr{nz7(#r1$74$xddx zq=DHT2YT71&LZ9_QLJZDVb|v7x|%*JdYubZ7hsk`x9YlD!dxW0M5%H%^pi&>i}O2? z+!3{o6cWE2f7ZI;`$ zhX$9g^c5=>LTQV6rS>SJt*MqO2b_mj%JMC|D!K zSvtK8#P~=Eu1;&3zD*oDip!Ftl0uV}HK9k}w1L!MS&>m70Ijj6$M~yrw|RRzk%#Ej zHf~qtx1g<$HTl^t8s`vmLd*iwx>H~bR~%Vx0*4az`}aG#p@bWL^M%vTM2}W~t0bz= z(YJ=p^aYJn3NsE0-gY6C$h<})BS(ZvEFEqWuh38l{o+e5l2Cf`V2_kieb^J~9@QbH zD(fR8v3lzOwmZr;F{NBL6M43A;Y{S21T@Mv|7nS{;e1F;U6;smR!&lxt3>`0&VIFH z^^y4L`n?nN6N584ALrPKDLL>&m7x)$InW%We^mReYM>7=`ad)l&x^#++R=EYWI?gt%%F89U(KqrKgesQKB)PH$(*kH0?gg zE;KzGKK777ewc@1S=O9kic5J&*8jnftNc7l(6K?58x|05ViMD!8k=~P1YH=UzAAQ_JG6hks}(uHx` zCj{~iwxpc4uZYAPSqYl4t0XRg01I*wIXQy)@^}h7!pi+3*-H=V2oC zmoBpFBZFxX zuiPAQOer6*FAwGaN4?Api5`jn-@ZToYIOY%!O<`ieuPecDHPyv=!Ku6$BV!JV{k4U z3onC5(A%$v|Au2>F8mdpUFPw>2Tp{YE$q7Q+kSX7u#)VF^4R{)mqL z2^fVDI2d+^+tAHF58}7K3_c4oxBp;x4Bh;jAancW-G1A_&FJNCg9(@czd#57IeZO1 z0Plh-90yN>-=L4*58|i40M^4C_&b7=H3LtB!(bb@6*+zelsuJUE`o1w^lDP8TiB|O z(ytrh{Q2{P0d_DenKkMvxJh)*Mu$il*_#P~YC!=cbb5wK`3cWc2gQU#n4cC50JYrmdL?rmCsxEV?Vxx?%c)!HA z&$$-`)Aj9YY`C}ZT&Zj#H$>c3W?@wQ3{wYnrshP3X2C7e&o=+>fsINIbhg&8Q&AzK z*eUvh8#^$lVn5Zmcye`+c-4ujKO&2aWE1S*e(^WC`s4UupX!iQ_s%nIm^xU{=BD65 z5ge-=WsZ#-YlJ$J?i*#6S+9Sv(>2=aqNn4l3u3XA^nrqVt)}Pf%x#dapz{q_U68Jr zrU{Gm<&#qVm5h3{J;2IF=J3i4U7e57p#otx$SahpGfi2_zd4(-E^>1%Iku*vZp9w2 zjnej$NK+11F?FWSR3P1sGa?&1bPDcK(Lde+XAI>nos?QX-h3|gtrGs;}ECoqX4nqs(NN+Il{vBm6l(z?0FhBz&r z!bxBEJmLOVE7Pu&bWfRh7i`kH`G=}kTJ~yC;@@49Br8i)`acrdl<&KJ@+z-~^Dl{QJVra5wt?d2lLhfc3C1>ff^hP;?tKk|E>U;SAPh+1b&D;K-T(u4S4Vnwt%Z)1FQpi zpTGjx34VpF#fSe<5V>CjsUI0Usa5k1Hp^ot4VsifD>}EkmY%ZsP~TK#AxP3&Qz>GP zl!#FN*f1-Cy*DyIHZ6=H$6m+rqq z$%znP+GNvd)$?^cKZIk1Q>l%dh$nJNeIhA=Ehguw60{&0_N{U01 zL1G>#L-~r-q~49@QYYla0J3TuZbw#SA20B}fenNTb8Y>eE^v@OvQ@%_$boa`=)wlq zs`Pxh&OyXf?H%sjFkYOye=*4Ka}jHhR}J$Cc-o{a2@98}f8Df*Vuu;dX=(Upos z)_Oxd~^ zl~zmq_lk*FmbLFq3R05cv|WlI$b!L`E@55MBm;Hs$W(c%noSsu8_g}L_R1hWIx6>{ ze+f5MT~NY*nS|fMKUK7RQFG?xSOjryj#UqvxzW{AD#YQ5aDp2ghzFDIY_B}Qd^~d7 zLzN=f=^Kk3ldR2%yBZuwE_*h3o?y_D=^2az1WF*BXSWfR{$@e288tT#(G)38lZ|7Tv*zcy+qw2L!!2~J^0bTQMR1~mBr>0 zxnJ#zDM3owLeP9Od7^vHhnPSJi$KY@c5+HxLl)eeu<2F z@6-aP2FNWmbs+t=M>O|j_1-;quw9j!u0~P1CPcD|8Uad3*jHgBoH!#{CFuXN#M+^4 z9yC<-9#&4o0_Ai17!32e4c@z}(n|W+N0mwra!Mu{+5-{FDN>Z)oL2sgPNlOoh4Pb= zh~xRQR|;Ip=PDBvMHC)=$vTzJy6%C^7!p*0O)(`iF$#!fGEgrvve%6|jU8qr6Ew)= z#^{Nr+@!6+H>2uG^h9bQ(T>^(Pf5v_UQ-sZRXUn`R?T1gsg4b-)*EXki7h}|!E9p} zGwp182&Fda%Gq415mxsix?W=Kn@gZiBSHF!$444wb{2)2n9_%~(;OqM%(M;NVs+i# z!#kzsw>wOy_JXk1v90f(RB4QNBco~U%{CL$-qfFI$J(}Hj!kaF&9qHhIw@nU(Iw1q zh#jMfnUUnSOtKw2tl9P}j}xY(Wh9f(!!zO8={I0g$)BVxm`^YML`%~q!lYM zMIKMFCY*Foq^XQBz+1+opw6ieEYTeRSBUEO@ccv72brYY#mrThu?SMSWozJ|}B zY1LupCbwFTCuJ47YHScTIXp(ynrGZGQu56*pc|u?&8Xay{tF)Vv2lHJW%vDt;i0@f zMJKAd3g?hHU#E&~v4on#*JQnltA}k-SBGYCwR0SD@osZcNw#Fq#doM@ z9ptsb>WC)mq&l`yw<`Mo?kJkqi@u5e|7xRjUW=Yz16l8XPxuQu{sZuRkaYlG3nzih z1K0}wv@JFPcn_QduK`)xU*Z71fqs8B90t#U@1Wa%4X%buK-TpCPuL4&PQV;^6utft zkoEqqfD2(A90dEo-_h@{f%9NFJO@PIKL8y-cMzY}hR zb6^Zkf&<{i@O||9cf+ed*3ZBznUiP8^d7E$z#%hDVnDb9L^2PCW_UO?(YxU! z|3R@yQe{+9{tGIx{YAd@u*fK6t8p}~JyADSd(en+Bn{KDM|$zc)_A&D?ME(qt@X9r z6nY^P3adBvG|u1EYft2Hma#`EU(;G~HHq^U>&cSPqPc!1b5siBh?*)5i@5y@SH;nJ zx}AZXL+*+{nAba1PIeq9$H*siobQpz$S!xtC4a{bW!NR7q$GPsiY=he`WPd3Llu=c zHC8XI5~rkJiq4xL_mL$-<=pa7v*EJ(MG7o#$5>9kDLotzr9w<(IWAdf(!RwEX=fyh z*aWU{Il_NQ0{bxr3S$^h;Sc>Do;JHsq8Xdm!`*LV=LjdoRp}?~4{C**PPQG>mNKB} z0FF74P!;(*6Hi*Im8U9ASzlO9h`5*e*6PLux5yU4?vcNx+US*m`8BYE$rQc? z-f%CHcuhols%^Z+X&aSL+fciem)10$3a=2I8#*L@Bg+$Fw;b->yWhk3NPF8Sa#HGk z?*!fec{ky3FWt*N($LimbM+^`$Um0pwHFzyOm;`>=h~~ubNR-+y{$3No>RVCJTF3! zMZoJ`qkqD^+!Kbyn`|uMO?)`9se#IBS+#1Hl(W$oL5^{PWh-<9^CXOewY$81-Ezo* zgwYt|p|r|*j29z~MDI;#Gtp`*aaPuls8`P@$Qoy-hHaD9Y$<1(8#6a{t>p#YfvM*B z$E-pbb+`Dh$==02zJmMIT)lfLTFk>&t{?5)=cTPs{`V8}d8tjn-N&VRxwan4`ge?t z79U$Yg}aYSH>^=)`J{PVivB+j_3{?cIUW69*8e{rhM*t*4;}wY@K#s}FNE)*+l#ON zU2r~}2Sac&><`<*z3BVb!H3}k@Mb8&LGXO|3A(PSvTNka5sDiPJuEU1!5m~6n$U(|FUkt zT37(jgrB1C%RBYn2uFkH{||Ey@42nJIn)q1%+{d1EQAR?DRZQkTKMzLmQbOS_?J1ut;H z)fb(i=E^EIPfc#Q%FZq{W!%0<_&|9HH*yyH1oQM!?vm`@61W+>7^Y88Fi~rRV?|)m z_Q=9|9yvKnn3HLqNN3_R^u(zn@+|Tl8mQ^v2>+YNh0)@;ys6#(pd~(Dz<@H+n`I@J zN^#AYtc|6A;>eM5ZdjIJ;oepXyhNppAz1I^Em{+WD(YKCq!66d-Mbo_lLSPgfe)QB zRVJ)OI~rE!de`La#$E?&-Kbvrh#;^kO`OkQGbHxedu{5TR<60wo^XArxQkwXwtV!atQn8@BCw^X)t z;cspoCnIu63&bXrgOHa@k;(B}xl-*F7ey^!ky$Kra`Utq!7sT!9PigULVe0uZOlrH zm<;#UIY+z`yxgQ0x0ksO=EWs)R^w>mSD=nh_P4J~>~b5;qw`A(tbONa|XGs3YZ(a$ge_ zHa6-PGMUCKcUzT23SwKQiG!E!`pb8-;;gMNMQdo6BB^Z? zogt1^0vcx8i8L8GnL3GVm=7mEWn!Hl1VMz4ibB+vXWFRF$fi&Qma5x0B0`eL)k)-s zcmVtoMqL@|2>qiZ2wWL@2PUI_S-M9}CX6{V{9}Sk(l<@*K&6o|Ia3q$b%ihG$?0KH z7e^~l-`c(6N9FKv3Rf9iEw$c|pT)n?PeMnF8~b9aSm2P6jy56wCGj{VyNv9boonCBiV|WYSgbQrMR?lI(Dt(Cx}G@wo9O?j z(wPq${r@DRcix81ec?#vCg;FTEhD zcBOjR<0@rV4ls-Uusk^lq zbfOE;8H`&A*qN7V26|+cWMUpRAueF_zZ{Ryq@=-7W-D7Numo&AxF3WK$s5UfCVRq5 zkp^DOSRV3276mMNj}A8LL1^bgHA%A3+an7*)VV#8dy{%!WJh)~t5-QtdaoERL|YN3 zuhD>`x=o;($OWa{fI7mjCwP6KSzT?Vrp4qX6SE5wlf25(xyr;VOsa8IGG=VVOc>S% zlVrhHB z%T)9sWTC4+vU0i_d0m`-ubj?7ZUi5D0%k`d6!dB72lT6)d(d-v3&glyi&JWlB;Y9d zN?X2Ajg^vD?{r^1sD)y4>)HKehG6b8&M@>k3n|lf8(-zJTH$CiDLJqh&_*XcyuJfa=$7J42UyHQII#f)2S*|zl} z>25Z6C#QWEy~pNp+Tl#oY@cP)}b;zLA=rFQI^)rAi| zEv1K3ot<93TMmv%I5KKUyF0OTl9~S0Yeio1B`;a2Vfq^y8w2E?coKm9o&MxFKYqHy8&JfG9Tb} z^nH2f-|?^u+=ZV1L68`L^&s!~n+Z>c|3k;W3vPw$;asSI%mer%y1vB!zZN78U;sRL z0Xz+ELFfMzoD465Tha6X3l4Dle{1*(u z4EPDU{)HfZ|Cx}5?cn$5_jkhkU_Fe&kuU(WLFWDcFI)&G!b{;x==l=&|0a<20A;@a zKCnHA{BLu0e{&yN`|>*NdR=?2BsDh4VR1HS9xOQ$zRc9n(%iY9x zrtUFz(4y>p;ql7Elv3{-q)!;EEK|V@Eok%&2AGkXnR+ADj$Lv6PfVo`RIH)Jc03{- z{}RKU&osKxC(39=uF5z$Wt67foF-(!jWr36UUcMwuT*wQ;SUX98ffjl-fEuco{oYT zFvF6Th9j=EKtI%#_S~W_FH0IdS#)`~V z8tKO+v(&!a-x+-U#H31L(I1r zLe=AKk_V&Pea5WoqW`1%W~xU2A2bT5tp7g+GWTEf{6C=6{}{drG6!H3c7Z$4?ZwA` zDC`K2q0ip|*TP3ZV*Ll;Pw4U=hvQ%?_zk-Ix8UP&E^LAljDW1~cLJ=2?cs0e^)lDL z2CszO;bHW8S@ZuC*aIHsA|3+q@m~)ghu6RnAnX0V1hxaY*zcg%e-0)g2Y*1He+x{( zF>n~{1G3h?tnK$(J9Qd`=;zjg1e+F2q@JXjaIYtWJh zNhWp&-5-+fX2T}i-mOf%jegVY8nomV)iY@MlfJqZt%lJlU5i%pKG}vAt$25m{QOJ) zRjRdpGA3BSWVd`8J{;3?*BLnfi~VRozXPMuu-Zvgf3q_WQhSc1F1VQos!iWsZ)|gs z@6?_-c2L9upyiw7KC&t6-qQ5jX)8-od`nYV+k;{{l)t0iMt67}kxs)J;y=T?!)uvo zDzv8Uul%o-=g#14)1{yc+{WD=M>qh*MY19 zZ~@2~0B?i0z}avx^uqnv0Avk-Ghr2E;m6nkK4feHS-xf7zr6qNcj)|gzq~Z;_IIc z_oDB=7nZ?u;3w$&Uj>QrKLd&&zWr_Bi|G3@pI`j?H>2-g2Is*s&Ua&6d>?WuK(&W?&ihazfC0Hb-R3ZKt}#= z>eGFSM`mTzsV`04S#?nNDUPEv(_95K-l@%FBs0?sS?#NFchH$`pkXD^&Aw|VGplKC zo(FkS)ocI$*1flh4ZmwCo1UetnReUW{Y<@=e*5ei%cK>h8OtP+)?dY_Yb^WsHI{`c z!j|$o#|Ib5rjF!arCwVDNY`2>(%_S*O}R6l>x_&geS6)p{r|f3#6gKZU+8G5@mm-`~;oe+t*Zd9VS7 zUZg z^?w1k!$t5$SO}v3Uu$&#L-?Kn+rw7yef0g$Lm4D4;8*DU?}sE1K#7TQN`*VllA+U*WH^O$Y;i1oFguDfCLxf_xiO#An@?!8qz zyU{$XVri$-PkVY=*G7@H@{g{=O@+l{9?IBekXUimj}d#i8y7E$>)9xRWt_W4ims7j zsf5!%d5jeGhsbtZRmX%Ot)s5aD+kD@{+Z+md$xL`I5|!}O`TF7>iqxsD|Vv)FGuJ9 znbH64{QrB<`#%lmz&I>~9+3I||3b%?HUI8|pM%&2egfZx_k+9_Q04|a7sL)Au>i+` zybJI_bpI>i9U$xf?F_f0>&trpUkUR-=Ka42@Ev$uO;8}1Vwg7o2;2U5C{0sg62Vma^ zDC+?13V*>4a0h%6)_|<}Cv*OP51)ex=z(XzBiICf5BI~p@GCeUQ)ipR(Qf=nF(PF7sE7&)M=@e!{ab$gu#T>{A z_VRkY;z+T!(HkBs46pTMA#+)mFmdAM5`19l#4O)itmRbF+!8&tt3!QN5UAKN5HSsN|HQ)(4Ort_$Y zuF)85HB?{*g3MI6<+O+Wdt3vQd&RO-Uv2avV?!u)Xz&^WDSbpjYSC$V`+*Ff%+iX?UJjL9k~yF7 z+YxwM!jMf@Kbi3#Afl{ns`qlRZC1On_gG((b2?cIm-6Y!=aN{qD6DKc)8Qn&yk-_F`W{Tagw}+KF+)ZQFm>+7_IeeB3i$N(gOTWQ)L#D zzxuU(2?sgYe$AX|(5&!-2z2!`zw4KcrtCy)DSOg>H@&p1_!&A)P|@_RpbDxHXjm1I z#CoZx;Bq>!rSD>Xsy0RkYClKiD^+h*ae@fS;|pV~2Vc>LHD5{lJ@+xS2Y>3ewTH^c zp2vRE_sB|_1y7d4EMj=z6{^)*p)_19m=}`_G^*~yg$k?LQ}@d}4&(t)RhfBc|brVf6}{-o76FC}!5Ide-Sx@pwZE518Rvaa}=H7E)GO zdIcF(ORrL^Ov$@xSSELbx6JUy5+%Gr_KwRdUP7tE&7G-EX>DEGdo03%u;~Qmx>B5HL@u@0h9^a^PloGEm+Y6}9mt}pW z1)(z(Pn87r(rgB_&OzD>ZgqSAN_=r zxqH+1$WhjS@B}tji2mP;Hu+wo{~u#C%d61y-wR_Py1(fA-+-IoQaAG{zFiMWgu$+>O0|fU zUc)LAyKM7AR$b>1U9Mh4YKVcKH(9RI!67@|xy9?`Ds@9bljL`3(FqoIgfK1XDQ#HG zhj)ef@==QJI;HpK))Zw2&i#4+=Xhb24S)=j3+D>C9TIPPn})^I#a?{#J%7$e71y@H91}?_fx;uC-5Ht^H3@s!xzi z{tW-6kFftY+wkr2?$S9K|HrhA`is={ENQ%ex#S#KTP}D9OZxJ3W`x$u{6I8KY($~% zLs<@cwEom1V?L)pkrVpe!xD)i3_RsJ1>J@1Q2m2&wc(E8$kLGnvfZrdE<4)$iT-~$I_XD6H)a0+3ZtLifX;s=90AXUyU_Kogipao;lpqd zEC-4I{}Vd@ci?rf7yLiC2VMUv7zXk6FMwU(uju#x3!?X*0t;Xl_$PY)|G~9zIvfhm zggepmKL@h@-+u5II{ueI*7+ZS<6#h1!qJd{U!wP)4;w&y`_F(Y(ed97C&7MjA3FXQ z;R|pM6hPMazZV_<5)u4Pf2fuLXl2uYoP#~IrSEDXf(*n)1xxw&ohP2YBib;Nq+L9zm5cFw z1q&J~fig-K^a$Ijy=qew2IFSIYN8bYTXD6{;8mw4yjt0t+pm17rNSE4B^B#tMLRmu zow7Q&&`l0B8@w0F3F8`rrmIq@3rN-=>X>hWvQ))864OgmY21;$TU$C`GmI@Kc;Ww#1W~;72S+awB7-`i($=FJ=$1atipiWz~&0|Hic-ZOUzYk64VfUb$W}y_PifCUb8-xv0*O*f@CR6LK&lrY zsm2{z&jVoXe09~PzSgQ^It$jE20B9@4Q`PwI`o&z6ex#N7mMk|m$3BPrMi&gi zjK@GfC{pcMPVifjjsD-lJFul5Cy8xY-Q`FR_!N7Zi2g6C>e2Ea`u|d+vtEhLFYo=6 z_5Ys+52E9L98Q22!mrWqMcJIkl967x4LJI38b-E>iUY9k2;< zS*^&oUCUsS6hkVRnU9s>K>ri(H!Jdj)<6N+lJ-HZnCUyU1xpTx}?8> zHW%b94i8&6YJ_rl_&$|zFoe#tadbix^E>Qy$=TH?GkuC@!pxz~HqzWu1I<=C55GZ& z22rgKF(b}`C+7GvBA5n27b2RFR9YNbc0?rIaiw2F%|=A5>ak;9;>>hn^Y(zSYf3+= zMgK?L&6JJ)Z{Pp-V|4zrLHz$O23h;>e0V2Jz~PXAYtjAR4OJL}Iq(2F{$;Qpj)5g0 zy1)4R-vy(v2xP6lePAz;dH+8^_y0PqhgFb)ub}&%3wy(J;92l1^#1E%J?sVB!f(<2 ze+C!BFzgP0K>z<1+yEEBE8)5D6Knw2!sp;Ka0z@0#6~a(^WksU1bzVj4M)La2ryX}Rk!|*M0T}w>Z zGH%q70#jGVZFTVm$B1E9L(yPq2!4@=j-G%f!;)2d2f3Eb^xRadxbqg2swY!oy@ctq z(;YXZ_*v;IwRf4ylAkEZj5&1%w|4vWXmbpe=sL6sBrt>oTfVTv8d9A_2(k>1mo04G z325q!x6-jx+K3BlSh7A4c{69Y4`|`xG^hg96Rd6FNB*FvqpNKj7YQ_!N4>=yvgi!6 zd_9fsGW34TOd#RNmKh4=LXz>Fq>POs+HjI6{L{*?TtB1hi=pI4kPOlfO7IBtp8^%z z{umNY_>P#Xhz$MGFSAMWLpG^?a8X*rF|k(hSrAD=QAtwdp=+ZnT2(v58WxJ@5v$k>Qdl2FRChH(@7L1>^)=L0S^Y;vb+}R_TP7LvIW{~=*)AZ|tan5`WO9$YV?^JL zP|NCe#Nh{1w;x|aSp)Dt;9B(mi(wL$g1iq<>;dEOGPoO^|6+JO>H!8Sp#47<&F+;V$?%i0+?-pP}!+50=9&@E3IbU&CkNc-R`Q zK*v7|@~{ddCg3h)C~`bYWZB{;+9O2&&W`6NhDMm^Yvw{0SgRjp3=J$_spK~j)M_J9 zBO^}9D8(<4Y#@@!#q(oh_#{1hrYV#1Z;N^ze*;C*pj=ASe22%uj=MT>7%Lg-Pj-c` zpZSvV$Df$(Wx533z>3GJeQN4qd@xEzN#oJ5tbFGjvQpkftFc%`DRLA1@u?|;c8HTW z5FtbO*Z?+kfE~%&YZZYz2VmjIS93ZVIi7vSrjqZD+>~rP1x2Q4EZm&Ui&>KwKiWI`vFKjb#)LdWIo>l-$ef9KV; zCnPZUJ?+McYL^LRW_p4~uh2|tu#^tNm?~pL-wB!KlC+-9@vPMkS;q|4#8Pc~EkTvi zN=3d=?1BiF_}&saGV?-gUuk0YseY#NsW+dPwkh3%=^eyyh3hbu-yk+Czvg-4vKoo% zm$9{}b=&Bb3*!Y=@L(#B?jw7&5v>@{E6qNqM>p;@cGftj40AGvBw_8=1_nB#zNKo7 z%~a$K68(P>sS4E2i+n5 zl|}s_?rO2LAT7A?BY@`Fw|TTJ)#wJCM}WwuiN}B(R%cn+SdT5o7YO^9n)Fm(ANE|N z^}&hRh=o=!k%f78m|1CSaAZiP<*AxkJI`a;W^b%8KB;VR%4@>RGkvYo@sHR=`p884 zWYp6nv2>wjG@K4mJ4*buNH;dJ{H6EdrNS`F3+5{<^zAH9ifqjVw%(;58#eqg0!wzb z=tl0>QFZ;D=%<}L8g|*vtjo^!+mVbr)p-@?4{mzEvFbihDOW|ke^zVYB z;prgn^LqpyhCjnY@L@O|_JSSYA$0o7UVkx3ywy<}~wbxlpO>lz#w3-t#NWPMj6|91@zYWj0rug$oEdI}gEoS|i) z`UUG&bd3(`hPP&PaAcY^>NLSk5=QJip*yjuM`F&XvxyOB*YMDxsGui{;lb^|WIJR< zh{jtlPBx^758D}pGqTNlPOaA?X4fL&?9@%7^MhOlExJEeEjH3MXI*c*#Ic~`*rmer zo>ghBEX<7PERRVuD?Z}t&gy}@38UAuT>`Bk=Pj2-hGU^Os$e2=Wv$h7-Ge19m2t-{ zW)IOaBIs!8Y#5SsN|=^=_3|2GHXrO;J@-T#I1}47Pwlei_CP?vmXu9@njWNOqtg$< z5k_@}8Ch$4aBGrv1Bu-;V&-nc#O+#f^ctVm$uOx5$JnBSAL0>MRw(MbX~}SOgQ06! zRGH9eB7bBjeLp~B*I1iwF;`lV2-KOAm|GH8JqpU(w19%?ic!y%>lsTIi@ZwO1TFf) zG2<0FBo%1Y-*z1eDzGb-V4+xdsWQr=1jH23Xvmh`6$EYt0+X$X(1Npu596;6)hVY! z1!KIZAFFNYWn#tWha^9f)GOOFNt%$b5oW~8B!{OsnDj2C|M&7psG-w}{(qFwX}^We zZ`c3ZhV9$X`M(UZ_WuPS@&A87@4p$u=l=z`3a*4a90HGE1Gp332nWMo(EUFH6_9oQ z??UZLrOuqXTjUH@2B0H1@CK;GT=d361^!6-k;9KbXXTlM%4M<%7m*G;l0FDHS>%Seu25>z{eE*kW43|?-fsqbWGfT?GvP0Pc~~1jTJP!;($gQO z2-l9%qKTRp;Q%6(fR#)%3#EK%q|&OExNz0sZXL^m}{uLUpkLK|`_Yv57oton%|s4Yjd zpWeJ6Gszb{?Z~2t8@iG0E@TfhAstSaq|JBwc6Y*N?dQ?-xR++pN^hPvK(qa6`slYW zJoIYGtkNC-_9qX&JMe^RX8bGh|NZE#M~VK5{=d-Zu$QCrzZ&Mjedzk{gVpdnxB=aM z9qa**q1S&8PKOmB@A{Ki|9_$1e+|xrLqUB1KSaO(B)kUt;D6EUKMi9r1MWqy|1eC# za@ZMuj9&jfSPk<*eEm;@8`160f>kgReve*%F}xafg`c3;e+J$P$AiT2{}jDmbo{r$ ze()$d{8cakvc}(Ek%7FcZwf>nOQ4mH`#^HHT`hojb%$F^=)h`m%>-(EqZt2aCeyDg zVf)dD#Lm%Y^hzjp;M3Km!pLu4HBezX;Sg`z(_a$wA2v$)mqb?MId6e?*utY$Eph@7 z{R7N~E1+;7cuS!R*~eFW!{hmCH6}IvoJ5Gt%F6NTNyb7JEVIf`I)GE&?<6-NDy8NcAkE_Y~Hu1<)$*pru zM{R`L>hy)+o?LIchVO)V8&)`xrWI6PQD z*M^mJ+HJrllWDi!bb&Vr7o-9;*Q%ZR7?@n@d&s8WOm(lI|4;Id8F2-R5V_Si!Th3* zPcglieQ^mkU8iZE1>DePl95rMCZ?KxZ&G6Kr&fgCJiXtb(4{9fIc8)R+;Mo z3ePCev0a-%JKnO3E4kG%*|uz^km)g%9j3+1S2mxK(fMkVN>hKrni;eeOKVc|vUzr* zTweQ!R@qxhRb$@yWteqvi4O@_M9f=krzPCl;(}lby(+ zoq2rf>;#|1*VvLk|JJASDgQsJZ)RW7b6#jt?;0hRl-QkDm|L4GourK@q{r`*b1vnqp!0vEAc7Tt<8L&S* z6TX2R;0)Lgo(9*W|8Il?;1P8HZ@|Z45@y41j4j~5_&yDm!gJv^Yyj_u5ts${V*|Jl z^6*l4072Xe@=m`K;AQZ8|&SYl>uBt$GXUl2RYq(S3YoSdn~-SvYfn;wC8 zwaVV4WkHmP)jK#cQiDRDh-^dq>>nAsk?`HfnA@ykN!D(~Y*x2yt6I93^MqF~ML_Lp zn36|Q&zP=cwk2QFGj>GJ)S(Mq6|<)`6|<|#nWb4$RJrad0lqRjyct#r&_)tsQ)Mxc8*V?Me)r=oIIzJKRW-7a3P!k z&xLD@4Pb!pN6_^@1t-D_;9KbV7r`dzhrgreKL&Thr(ptS!ynN3Z-Wa!;{LN>=lzeM z`%5gqgXsF-hBv`s@Cds8_d(+RKM1deUE!DL{8z!*un#Vz0i-wN-J-V==K>H^!ooJfRjbIu4S*33px#AAOu0bSMHRQCH?{>GiFN*0x#v(CO0(RfE!vEwIET$13^R&epj2 zWY$hvKh?S3R=X2}KqGTqfzLDODk6PI`kic7k3>@+ulZBK{N5m4jhwzXI;lgZt&X&1 zoRxYk+*?vK%JRjBBX?%#elp)0)~Fjlognb{59oW2e^;YoL@ zx>UV3r>rR^(P-jw3;73IC>DkRdEZ~XPik(CcTtzh`0iUOR&$=k;uFlZ=qpwo^DRDc z=DF&YHvMU?q25hp7Mp3)W-d6gPPEw>s3xx;M(MIQ{ zi$*QSj@5dD9k-_%e53iaWswYx;fpDQE~C&y$6cKZfUYayByB$v6`u3A8{EtCE%oIn z`v1#NXq8@z{(q=ZZf`*Em-YXaLk_-<&VQEC|F`A)0d)NL!tt=P(f7ZBj(;tD0j>gB z4{!(;!{5>Qe*jm(TFAjq(fehs|06->{a*#Lw*SuX9d!M(;Y64ZvYx;A{jUX?4=@4! z@H_PVi{Xv161Iao(D^?K%V9hCF1r2);8d6c52EYKd;B&+83y2A==w6xe-p_3{+Ghd z==yIpI{)Hyz28X8xdWli=H{b@o6+<~N1^)Mah;S4i*z%=rDlT7*j8I^-f1YO6d+|p znjSmcRyWcCmoH_G$Tky`WAKCP8e{ODu!epkMYXN#4OO$WZc`MKXrKAG>8dN9I?8Ii zrUdn({!_d)m9>L4B>u*PI$CS|`ZCT1MmMwV>aJv%(pjXduWgB@lNxN`1@%XuUF9`e zMS{P(%B%AdoJ1|Sqsr^!>`b+4UtFVA&8E&9X-r8uECQl;JE`f#%&sjP2*ikS4%pQ91=$~xM@^Hw*@a6WCEwb|8E zBPBJ;#NHPXRVL_O!&|PTi~)^z@L20$V2<1@!m96i4c0cx6u1P3&U^#>g<5w^1aV9V_= z>iH8_1S`c@D`4Dvk0r8G9Y(0Q>W>Ct^+st4MQVgp;b!J!n@qY>I^*Jh!pGcZ+f_DO zjJBP=A+VE5rsF1+m)`jArr9!@CWA*kdA4fOnrlwnt}2%6c@6bOYHuesP5K@4 zssw*&U4J7~g`3qjNi+?GQ&NRpqs{1?ZCNNoW15buom^1s5=&8?GGvzaaitb0PmT1? z&I#^`rGg@*`g(l27Ai@d8W_kjO%dHvGHfbB$o^nCIAuY%{nz3BOu!yDjaI1cuN-=q6q z3hUq)cmYW4|GBUPc7{jM`EP}DU;*p`_oMTF3dUg{*dCq*PX}55|6kYu#2#=y90t9x zHC%};K;8kk8{CZz;2m%%Jc4Y#1R|rgBByD7Bpxd1qwaEdb&XQ3J0(lv9?{$!Uv*pS zDC-GRZ%yU)zc}wqvk{lVCYjqC@A28)Y2r`9%Mpg+67v!Rp|S&*55Ah0J^@!|I0dmhk>jCuq!-_zAx|mn}WHpE!>E{e;ynS+rka#`)9*p z@HDs)egAY=2D9L===oQ}DKH0~3r~mdq3fRq^1i=a;J4`dm&0p7=KTK(J^vyo!!md& z{0!ax!!QXF`~Mg^{g>br=z*=^GIaYA><*8i+uvaH{BgdAVL$i_vbYj9g2-hMTKXi_ z%c$U!jxoPYa}*?%vGsvaTjr}a$3m326|p2ebL)2ksgLjQU@&?wnjRO4$aPO<^|$)7 zZJZOeCHK(ayyK&z7H>`XFBx(>; zacbRlI180}OK7&I1=R}$j8{I@R-^xAqCYr)yW^N}e7b%#QWF)(#%5(`D?n-fq|z(Ikns>ZMPrq=s?l`=b+r4EIKaw z|01L4UWeW`riau@Be7n9)5zpFZ2H|hfCm-a4{SU`@`?h z|8IheK;8qeEqoapz}sP=u?1X$?tc=z5N<>7e?1%k&xZ%l`#)f80AqX~1`-4CV|4!y z!13^(@GQ6m{r~MS1kVFm1K=I78s@_v(f>aO!*DR{56=c!|Nku@?*o)I0RDtrJ_I74 zSBs2V{Mh@EVJBXM)Y}R*U1sEKW`H;;(7U9A`%s=*sN85Z;IT64`0l;{oGd@ELHH72)1NFOInzb=>#VR}oJr@k3WN-dY6-x9rL zMoMZ7GT=<2Xkr3I=O<5WzBgedPYH0JTu;0O@JihU@SZU5*79d6#Fq<@2~g8`xz^*j z0A8$H+#J*Woq1uhwt(NCb$lj9d>#hPIzF&!dgQfb;`BC~Wv&~l*W`P}6T{x0)H9Gf z9jYh#|IX;Nhly_M%>VxidjDHM-uWl<|K%M3UxxR?AnXA5p!3U`|7XBXa1T2Edm#@4 z@BsS#XQ2cKz|OE8Nc{iDAP+sT6?_$a|Fy6H9!1yxAGjDcg6RLhL(jhj-UWlOBm5ja z|10nXxEwwUm%<5fFg%RjFYf`k1oAKw?nL)L3kKjJ^!-cV1o#j5I{NG96vQPL$XgWOvbS~cCY*v#Z!M{zkVzV-t#uWcZG|J&hBAZr0`58p-SKNsZvf3x8p z^!^XR3D5(w_TQc8{pZ6<$ic7C`7eed9wL_aQUP(d?eueL<8d52#uR;0Si(q_mk z?c++V`Egk11Xq7Nv89*yMN0L@v+1KTN$S+VK$d9(vMnXUrp9EHzLkEf)sb1}uJuVd zICC0bhsLNK4<3wHfS}NsU^BMWVhADWvu#BYN(QNML+OEpZB@Vy#1c~MR@ztF5ru7C zZ&OdUZcw4u>%|vTX*Z}aUQzhPelm6=;aetlSXJ2sq1JniZ3ipJlj@y7Y2)VbMB=uj z(^jM*E&%Ipssc;-@17An~-w3neVRZjb!Yg4u%zzAh z7X4q|18@e6z~1mnYyek433}nD=>MOFGhsa}fZt#TI3EUJNBBSN0Ad&T3>4tSa5FZ5 zi{Pzr9Q+5|jUC`!Ah7^P!Yg1;_#w7{|AG-X4vvQ9unhi&%t&0{4dYxu5r^+7UcD@m}-2Fy5z_?yj(ZvgSlcV%Vs zP<>ly?zp~fo|!rxbzmmS*k-1_BO=U%b|(DMXf9;)Qz2F6SyO&{BbuEPsS;1?F%iBu zN}$mhyQWNamhnrglr2fKTJXILnFL7(KQ(RGbK~@4SvIbIv{$vdk#4263m*DQZdot^^SgIA)$P8dRKJyQV*4W4aubAZ}tO;OKhpw?B_ayO^&Y{!Dg@-=b ze5I1#NIbq>?kII352y1BP+GdBO#Z@x0ajPVBxBy$-!36vA_ub&Z}!rxUJ^C z>skEC`!n{kRc59mXf#(W)L!W&lZI>NS(iR1L_N|w`pDL!j@IUc%v6s?mC{N=zOl#! zkE8frvm~l#DxF;>!C&QceX%y?nR!&Q_^D}mCI&H~`D zW@`#HT0yZiR;ci9lktt}Z3@L|jXykfv33{`OZoo?N}I*NE_xoQGEUA&%u5H}$^i08 zerbt9YEe;sQL#c2keQL1QvklIp|m))NTDPj;syt#MQR}#K$lT*ftsTNw3b0TPdFuC zfubXY;rj8MDh%Cg08HkfgaIrWK@>2Ak;4)kl)wN$Y43&+J~J5BAVh8ELi#%>8HffA tT#Ri9xZ1Zs-;z?J;wwLKw{p?ev6IxO7;Wc*lO!rZh1v*Q%nzk@E&z0SgarTq diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 10940be..180f937 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -15,297 +15,408 @@ # You should have received a copy of the GNU General Public License # along with Rcpp. If not, see . +## Load the dyanmic library +#' @useDynLib finmix +#' @importFrom Rcpp sourceCpp +NULL + ## Class 'model' -------------------------------------------------- +#' @describeIn model_class Simulates data from mixture model setGeneric("simulate", function(model, N = 100, varargin, seed = 0) standardGeneric("simulate")) +#' @describeIn model_class Plots point process of mixture model setGeneric("plotPointProc", function(x, dev = TRUE, ...) standardGeneric("plotPointProc")) +#' @describeIn model_class Checker for slot `weight` of model class setGeneric("hasWeight", function(object, verbose = FALSE) standardGeneric("hasWeight")) +#' @describeIn model_class Checker for slot `T` of model class setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) +#' @describeIn model_class Checker for slot `par` of model class setGeneric("hasPar", function(object, verbose = FALSE) standardGeneric("hasPar")) +#' @describeIn model_class Extract marginal distribution setGeneric("mixturemar", function(object, J) standardGeneric("mixturemar")) +#' @describeIn model_class Getter for slot `dist` of model class setGeneric("getDist", function(object) standardGeneric("getDist")) +#' @describeIn model_class Getter for slot `r` of model class setGeneric("getR", function(object) standardGeneric("getR")) +#' @describeIn model_class Getter for slot `K` of model class setGeneric("getK", function(object) standardGeneric("getK")) +#' @describeIn model_class Getter for slot `weight` of model class setGeneric("getWeight", function(object) standardGeneric("getWeight")) +#' @describeIn model_class Getter for slot `par` of model class setGeneric("getPar", function(object) standardGeneric("getPar")) +#' @describeIn model_class Getter for slot `indicmod` of model class setGeneric("getIndicmod", function(object) standardGeneric("getIndicmod")) +#' @describeIn model_class Getter for slot `indicfix` of model class setGeneric("getIndicfix", function(object) standardGeneric("getIndicfix")) +#' @describeIn model_class Getter for slot `T` of model class setGeneric("getT", function(object) standardGeneric("getT")) +#' @describeIn model_class Setter for slot `dist` of model class setGeneric("setDist<-", function(object, value) standardGeneric("setDist<-")) +#' @describeIn model_class Setter for slot `r` of model class setGeneric("setR<-", function(object, value) standardGeneric("setR<-")) +#' @describeIn model_class Setter for slot `K` of model class setGeneric("setK<-", function(object, value) standardGeneric("setK<-")) +#' @describeIn model_class Setter for slot `weight` of model class setGeneric("setWeight<-", function(object, value) standardGeneric("setWeight<-")) +#' @describeIn model_class Setter for slot `par` of model class setGeneric("setPar<-", function(object, value) standardGeneric("setPar<-")) +#' @describeIn model_class Setter for slot `indicmod` of model class setGeneric("setIndicmod<-", function(object, value) standardGeneric("setIndicmod<-")) +#' @describeIn model_class Setter for slot `indicfix` of model class setGeneric("setIndicfix<-", function(object, value) standardGeneric("setIndicfix<-")) +#' @describeIn model_class Setter for slot `T` of model class setGeneric("setT<-", function(object, value) standardGeneric("setT<-")) ## Class 'modelmoments' -------------------------------------------- +#' @describeIn modelmoments_class setGeneric("getMean", function(object) standardGeneric("getMean")) +#' @describeIn modelmoments_class setGeneric("getVar", function(object) standardGeneric("getVar")) +#' @describeIn modelmoments_class setGeneric("getModel", function(object) standardGeneric("getModel")) ## Class 'cmodelmoments' ------------------------------------------- +#' @describeIn modelmoments_class setGeneric("getHigher", function(object) standardGeneric("getHigher")) +#' @describeIn modelmoments_class setGeneric("getSkewness", function(object) standardGeneric("getSkewness")) +#' @describeIn modelmoments_class setGeneric("getKurtosis", function(object) standardGeneric("getKurtosis")) ## Class 'dmodelmoments' ------------------------------------------- - +#' @describeIn modelmoments_class setGeneric("getOver", function(object) standardGeneric("getOver")) +#' @describeIn modelmoments_class setGeneric("getFactorial", function(object) standardGeneric("getFactorial")) +#' @describeIn modelmoments_class setGeneric("getZero", function(object) standardGeneric("getZero")) ## Class 'normultmodelmoments' ------------------------------------- - +#' @describeIn modelmoments_class setGeneric("generateMoments", function(object) standardGeneric("generateMoments")) +#' @describeIn modelmoments_class setGeneric("getB", function(object) standardGeneric("getB")) +#' @describeIn modelmoments_class setGeneric("getW", function(object) standardGeneric("getW")) +#' @describeIn modelmoments_class setGeneric("getRdet", function(object) standardGeneric("getRdet")) +#' @describeIn modelmoments_class setGeneric("getRtr", function(object) standardGeneric("getRtr")) +#' @describeIn modelmoments_class setGeneric("getCorr", function(object) standardGeneric("getCorr")) ## Class 'exponentialmodelmoments' --------------------------------- - +#' @describeIn modelmoments_class setGeneric("getExtrabinvar", function(object) standardGeneric("getExtrabinvar")) ## Class 'fdata' ---------------------------------------------------- - +#' @describeIn fdata_class setGeneric("hasY", function(object, verbose = FALSE) standardGeneric("hasY")) +#' @describeIn fdata_class setGeneric("hasS", function(object, verbose = FALSE) standardGeneric("hasS")) +#' @describeIn fdata_class setGeneric("hasExp", function(object, verbose = FALSE) standardGeneric("hasExp")) +#' @describeIn fdata_class setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) +#' @describeIn fdata_class setGeneric("getColY", function(object) standardGeneric("getColY")) +#' @describeIn fdata_class setGeneric("getRowY", function(object) standardGeneric("getRowY")) +#' @describeIn fdata_class setGeneric("getColS", function(object) standardGeneric("getColS")) +#' @describeIn fdata_class setGeneric("getRowS", function(object) standardGeneric("getRowS")) +#' @describeIn fdata_class setGeneric("getColExp", function(object) standardGeneric("getColExp")) +#' @describeIn fdata_class setGeneric("getRowExp", function(object) standardGeneric("getRowExp")) +#' @describeIn fdata_class setGeneric("getColT", function(object) standardGeneric("getColT")) +#' @describeIn fdata_class setGeneric("getRowT", function(object) standardGeneric("getRowT")) +#' @describeIn fdata_class setGeneric("getY", function(object) standardGeneric("getY")) +#' @describeIn fdata_class setGeneric("getBycolumn", function(object) standardGeneric("getBycolumn")) +#' @describeIn fdata_class setGeneric("getN", function(object) standardGeneric("getN")) +#' @describeIn fdata_class setGeneric("getS", function(object) standardGeneric("getS")) +#' @describeIn fdata_class setGeneric("getName", function(object) standardGeneric("getName")) +#' @describeIn fdata_class setGeneric("getType", function(object) standardGeneric("getType")) +#' @describeIn fdata_class setGeneric("getSim", function(object) standardGeneric("getSim")) +#' @describeIn fdata_class setGeneric("getExp", function(object) standardGeneric("getExp")) +#' @describeIn fdata_class setGeneric("setY<-", function(object, value) standardGeneric("setY<-")) +#' @describeIn fdata_class setGeneric("setN<-", function(object, value) standardGeneric("setN<-")) +#' @describeIn fdata_class setGeneric("setS<-", function(object, value) standardGeneric("setS<-")) +#' @describeIn fdata_class setGeneric("setBycolumn<-", function(object, value) standardGeneric("setBycolumn<-")) +#' @describeIn fdata_class setGeneric("setName<-", function(object, value) standardGeneric("setName<-")) +#' @describeIn fdata_class setGeneric("setType<-", function(object, value) standardGeneric("setType<-")) +#' @describeIn fdata_class setGeneric("setSim<-", function(object, value) standardGeneric("setSim<-")) +#' @describeIn fdata_class setGeneric("setExp<-", function(object, value) standardGeneric("setExp<-")) ## Class 'groupmoments' ---------------------------------------------- - +#' @describeIn groupmoments_class setGeneric("getNK", function(object) standardGeneric("getNK")) +#' @describeIn groupmoments_class setGeneric("getWK", function(object) standardGeneric("getWK")) +#' @describeIn groupmoments_class setGeneric("getFdata", function(object) standardGeneric("getFdata")) ## Class 'sdatamoments' ---------------------------------------------- - +#' @describeIn sdatamoments_class setGeneric("getGmoments", function(object) standardGeneric("getGmoments")) ## Class 'cdatamoments' --------------------------------------------- - +#' @describeIn cdatamoments_class setGeneric("getSmoments", function(object) standardGeneric("getSmoments")) ## Class 'prior' ----------------------------------------------------- - +#' @describeIn prior-class setGeneric("hasPriorPar", function(object, model, verbose = FALSE) standardGeneric("hasPriorPar")) +#' @describeIn prior-class setGeneric("hasPriorWeight", function(object, model, verbose = FALSE) standardGeneric("hasPriorWeight")) -setGeneric("generatePrior", function(object, ...) { - standardGeneric("generatePrior") -}) +#' @describeIn prior-class +setGeneric("generatePrior", function(object, ...) standardGeneric("generatePrior")) +#' @describeIn prior-class setGeneric("getHier", function(object) standardGeneric("getHier")) +#' @describeIn prior-class setGeneric("setHier<-", function(object, value) standardGeneric("setHier<-")) ## Class 'mcmc' ------------------------------------------------------- - +#' @describeIn mcmc_class setGeneric("getBurnin", function(object) standardGeneric("getBurnin")) +#' @describeIn mcmc_class setGeneric("getM", function(object) standardGeneric("getM")) +#' @describeIn mcmc_class setGeneric("getStartpar", function(object) standardGeneric("getStartpar")) +#' @describeIn mcmc_class setGeneric("getStoreS", function(object) standardGeneric("getStoreS")) +#' @describeIn mcmc_class setGeneric("getStorepost", function(object) standardGeneric("getStorepost")) +#' @describeIn mcmc_class setGeneric("getRanperm", function(object) standardGeneric("getRanperm")) +#' @describeIn mcmc_class setGeneric("setBurnin<-", function(object, value) standardGeneric("setBurnin<-")) +#' @describeIn mcmc_class setGeneric("setM<-", function(object, value) standardGeneric("setM<-")) +#' @describeIn mcmc_class setGeneric("setStartpar<-", function(object, value) standardGeneric("setStartpar<-")) +#' @describeIn mcmc_class setGeneric("setStoreS<-", function(object, value) standardGeneric("setStoreS<-")) +#' @describeIn mcmc_class setGeneric("setStorepost<-", function(object, value) standardGeneric("setStorepost<-")) +#' @describeIn mcmc_class setGeneric("setRanperm<-", function(object, value) standardGeneric("setRanperm<-")) ## Class 'dataclass' ---------------------------------------------------- - +#' @describeIn dataclass setGeneric("getLogpy", function(object) standardGeneric("getLogpy")) +#' @describeIn dataclass setGeneric("getProb", function(object) standardGeneric("getProb")) +#' @describeIn dataclass setGeneric("getMixlik", function(object) standardGeneric("getMixlik")) +#' @describeIn dataclass setGeneric("getEntropy", function(object) standardGeneric("getEntropy")) +#' @describeIn dataclass setGeneric("getPostS", function(object) standardGeneric("getPostS")) +#' @describeIn dataclass setGeneric("getLoglikcd", function(object) standardGeneric("getLoglikcd")) ## Class 'mcmcextract' -------------------------------------------------------------------------- - +#' @describeIn mcmcextract_class setGeneric("moments", function(object) standardGeneric("moments")) ## Class 'mcmcoutputfix' ------------------------------------------------ - +#' @describeIn mcmcoutput_class setGeneric("plotTraces", function(x, dev = TRUE, lik = 1, col = FALSE, ...) standardGeneric("plotTraces")) +#' @describeIn mcmcoutput_class setGeneric("plotHist", function(x, dev = TRUE, ...) standardGeneric("plotHist")) +#' @describeIn mcmcoutput_class setGeneric("plotDens", function(x, dev = TRUE, ...) standardGeneric("plotDens")) +#' @describeIn mcmcoutput_class setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSampRep")) +#' @describeIn mcmcoutput_class setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPostDens")) +#' @describeIn mcmcoutput_class setGeneric("subseq", function(object, index) standardGeneric("subseq")) +#' @describeIn mcmcoutput_class setGeneric("swapElements", function(object, index) standardGeneric("swapElements")) +#' @describeIn mcmcoutput_class setGeneric("extract", function(object, index) standardGeneric("extract")) +#' @describeIn mcmcoutput_class setGeneric("getLog", function(object) standardGeneric("getLog")) +#' @describeIn mcmcoutput_class setGeneric("getPrior", function(object) standardGeneric("getPrior")) ## Class 'mcmcoutputhier' ----------------------------------------------- - +#' @describeIn mcmcoutput_class setGeneric("getHyper", function(object) standardGeneric("getHyper")) ## Class 'mcmcoutputpost' ----------------------------------------------- - +#' @describeIn mcmcoutput_class setGeneric("getPost", function(object) standardGeneric("getPost")) ## Class 'mcmcoutputbase' ----------------------------------------------- - +#' @describeIn mcmcoutput_class setGeneric("getST", function(object) standardGeneric("getST")) +#' @describeIn mcmcoutput_class setGeneric("getClust", function(object) standardGeneric("getClust")) ## Class 'mcmcpermfix' --------------------------------------------------- - +#' @describeIn mcmcperm_class setGeneric("getMperm", function(object) standardGeneric("getMperm")) +#' @describeIn mcmcperm_class setGeneric("getParperm", function(object) standardGeneric("getParperm")) +#' @describeIn mcmcperm_class setGeneric("getLogperm", function(object) standardGeneric("getLogperm")) -## Class 'mcmcpermfixpost' ----------------------------------------------- +## Class 'mcmcpermfixhier' ----------------------------------------------- +#' @noRd mcmcperm_class +setGeneric("getHyperperm", function(object) standardGeneric("getHyperperm")) +## Class 'mcmcpermfixpost' ----------------------------------------------- +#' @noRd mcmcperm_class setGeneric("getPostperm", function(object) standardGeneric("getPostperm")) ## Class 'mcmcpermind' --------------------------------------------------- - +#' @describeIn mcmcperm_class setGeneric("getRelabel", function(object) standardGeneric("getRelabel")) +#' @describeIn mcmcperm_class setGeneric("getWeightperm", function(object) standardGeneric("getWeightperm")) +#' @describeIn mcmcperm_class setGeneric("getEntropyperm", function(object) standardGeneric("getEntropyperm")) +#' @describeIn mcmcperm_class setGeneric("getSTperm", function(object) standardGeneric("getSTperm")) +#' @describeIn mcmcperm_class setGeneric("getSperm", function(object) standardGeneric("getSperm")) +#' @describeIn mcmcperm_class setGeneric("getNKperm", function(object) standardGeneric("getNKperm")) ## Class 'mcmcestfix' ----------------------------------------------------- - +#' @describeIn mcmcest_class setGeneric("getMap", function(object) standardGeneric("getMap")) +#' @describeIn mcmcest_class setGeneric("getBml", function(object) standardGeneric("getBml")) +#' @describeIn mcmcest_class setGeneric("getIeavg", function(object) standardGeneric("getIeavg")) +#' @describeIn mcmcest_class setGeneric("getSdpost", function(object) standardGeneric("getSdpost")) ## Class 'mcmcestind' ------------------------------------------------------ - +#' @describeIn mcmcest_class setGeneric("getEavg", function(object) standardGeneric("getEavg")) diff --git a/R/RcppExports.R b/R/RcppExports.R index e954ab9..c6f96d0 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,71 +1,776 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 +#' Swaps values in each row +#' +#' @description +#' This function swaps the values in each row of a matrix by permuting the +#' columns via the indices provided in the `index` matrix. All +#' `swapElements()`-methods use this function internally. The code is extended +#' to `C++` using the packages `Rcpp` and `RcppArmadillo`. +#' +#' @param values A matrix containing the values to be swapped. +#' @param index An integer matrix defining how values should be swapped. +#' @return A matrix with swapped values. +#' @export +#' +#' @examples +#' values <- matrix(rnorm(10), nrow = 2) +#' index <- matrix(c(2,1), nrow = 5, ncol = 2) +#' swap_cc(values, index) +#' +#' @seealso +#' * [swapElements()][mcmcoutput_class] for the calling function swap_cc <- function(values, index) { - .Call(`_finmix_swap_cc`, values, index) + .Call('_finmix_swap_cc', PACKAGE = 'finmix', values, index) } +#' Swap elements in a 3d array +#' +#' @description +#' This function swaps the elements in a three-dimensional array by using the +#' scheme provided in the `index` matrix. +#' +#' @param values An array of dimension `M x r x K` of values to swap. +#' @param index An integer matrix of dimension `M x K`. containing the scheme +#' by which values should be swapped. +#' @param A three-dimensional array with swapped values. +#' @export +#' +#' @examples +#' values <- array(rnorm(40), dim = c(10, 2, 2)) +#' index <- matrix(c(1,2), nrow = 10, ncol = 2) +#' swap_3d_cc(values, index) +#' +#' @seealso +#' * [swapElements()][mcmcoutput_class] for the calling method +#' * [swap_cc()] for the equivalent function for 2-dimensional arrays swap_3d_cc <- function(values, index) { - .Call(`_finmix_swap_3d_cc`, values, index) + .Call('_finmix_swap_3d_cc', PACKAGE = 'finmix', values, index) } +#' Swap values in an integer matrix +#' +#' @description +#' This function swaps the values in an integer matrix column-wise defined +#' by the `index` matrix. This function is used mainly for the +#' `swapElements()`-method of MCMC samples to swap the indicator values. +#' +#' @param values An integer matrix containing the values to swap. +#' @param index An integer matrix containing the indices by which values +#' should be swapped. +#' @return An integer matrix containing the swapped values. +#' @export +#' +#' @examples +#' values <- matrix(c(2, 4, 1, 3), nrow = 10, ncol = 2) +#' index <- matrix(c(1, 2), nrow = 10, ncol = 2) +#' swapInteger_cc(values, index) +#' +#' @seealso +#' * [swap_cc()] for the equivalent function for numeric values +#' * [swap_3d_cc()] for the equivalent function for three-dimensional arrays swapInteger_cc <- function(values, index) { - .Call(`_finmix_swapInteger_cc`, values, index) + .Call('_finmix_swapInteger_cc', PACKAGE = 'finmix', values, index) } +#' Swap values of stored indicators +#' +#' @description +#' This function is used to swap elements in the stored indicators from MCMC +#' sampling. Note that this function reuses R memory and should therefore be +#' treated with caution. Do not use this function unless you really know what +#' you are doing. +#' +#' @param values An integer matrix containing the last indicators stored in +#' MCMC sampling. The number of these last stored indicators is defined by +#' the hpyer-parameter `storeS` in the `mcmc` object. +#' @param index An integer matrix defining the swapping scheme. +#' @return A matrix with swapped values. +#' @export +#' +#' @seealso +#' * [mcmc()] for the hyper-parameter `storeS` +#' * [swapElements()][mcmcoutput_class] for the calling method +#' * [swapInteger_cc()] for the equivalent function that swaps simple integer +#' matrices +#' * [swap_3d_cc()] for a function that swaps values in three-dimensional +#' arrays swapInd_cc <- function(values, index) { - .Call(`_finmix_swapInd_cc`, values, index) + .Call('_finmix_swapInd_cc', PACKAGE = 'finmix', values, index) } +#' Swap the `ST` slot in the MCMC output +#' +#' @description +#' This function is used to swap the elements in slot `ST` of an `mcmcoutput` +#' object (An MCMC sampling output). The main difference to the +#' [swapInteger_cc()] function is that this function reuses memory from R. Do +#' only use this function, if you really know what you are doing. +#' +#' @param values An integer matrix containing the values to swap in R memory. +#' @param index An integer matrix containing the swapping scheme. +#' @return An integer matrix with swapped values. +#' @export +#' +#' @seealso +#' * [swapInteger_cc()] for the equivalent function not using R memory +#' * [swap_3d_cc()] for an equivalent function for three-dimensional arrays +#' * [swapElements()][mcmcoutput_class] for the calling method swapST_cc <- function(values, index) { - .Call(`_finmix_swapST_cc`, values, index) + .Call('_finmix_swapST_cc', PACKAGE = 'finmix', values, index) } +#' Computes the log density of the Gamma distribution +#' +#' @description +#' For each shape and rate parameter pair the log gamma density is computed. +#' Inside the function the unsafe access functions of Armadillo `at()` and +#' `unsafe_col()` are used, so now boundary check is performed. In each step +#' the `lngamma()` function from Rcpp's `R` namespace is used. At this time +#' unused. +#' +#' @param values A matrix of dimension `M x K` for which the log-density +#' should be calculated. +#' @param shape A vector of dimension `K x 1` with Gamma shape parameters. +#' @param rate A vector of dimension `K x 1` with Gamma rate parameters. +#' @return A matrix of Gamma log-density values for each pair of parameters +#' in a column. +#' @export ldgamma_cc <- function(values, shape, rate) { - .Call(`_finmix_ldgamma_cc`, values, shape, rate) + .Call('_finmix_ldgamma_cc', PACKAGE = 'finmix', values, shape, rate) } +#' Computes the density of the Gamma distribution +#' +#' @description +#' For each shape and rate parameter pair the gamma density is computed. +#' Inside the function the unsafe access functions of Armadillo `at()` and +#' `unsafe_col()` are used, so now boundary check is performed. In each step +#' the `lngamma()` function from Rcpp's `R` namespace is used. At this time +#' unused. +#' +#' @param values A matrix of dimension `M x K` for which the density +#' should be calculated. +#' @param shape A vector of dimension `K x 1` with Gamma shape parameters. +#' @param rate A vector of dimension `K x 1` with Gamma rate parameters. +#' @return A matrix of Gamma density values for each pair of parameters +#' in a column. +#' @export dgamma_cc <- function(values, shape, rate) { - .Call(`_finmix_dgamma_cc`, values, shape, rate) + .Call('_finmix_dgamma_cc', PACKAGE = 'finmix', values, shape, rate) } +#' Computes the log density of the Dirichlet distribution +#' +#' @description +#' For each shape and rate parameter pair the log-Dirichlet density is +#' computed. Inside the function the unsafe access functions of Armadillo +#' `at()` and `unsafe_col()` are used, so now boundary check is performed. +#' In each step the `lgammafn()` function from Rcpp's `R` namespace is used. +#' At this time unused. +#' +#' @param values A matrix of dimension `M x K` for which the log-density +#' should be calculated. +#' @param par A vector of dimension `K x 1` containing the Dirichlet +#' parameters. +#' @return A vector of Dirichlet log-density values. +#' @export lddirichlet_cc <- function(values, par) { - .Call(`_finmix_lddirichlet_cc`, values, par) + .Call('_finmix_lddirichlet_cc', PACKAGE = 'finmix', values, par) } +#' Computes the density of the Dirichlet distribution +#' +#' @description +#' For each shape and rate parameter pair the Dirichlet density is +#' computed. Inside the function the unsafe access functions of Armadillo +#' `at()` and `unsafe_col()` are used, so now boundary check is performed. +#' In each step the `lgammafn()` function from Rcpp's `R` namespace is used. +#' At this time unused. +#' +#' @param values A matrix of dimension `M x K` for which the log-density +#' should be calculated. +#' @param par A vector of dimension `K x 1` containing the Dirichlet +#' parameters. +#' @return A vector of Dirichlet density values. +#' @export ddirichlet_cc <- function(values, par) { - .Call(`_finmix_ddirichlet_cc`, values, par) + .Call('_finmix_ddirichlet_cc', PACKAGE = 'finmix', values, par) } +#' Compute the hungarian matrix +#' +#' @description +#' This function calls an implementation of the Hungarian algorithm by Munkres. +#' The Hungarian algorithm solves a weighted assignment problem on a bipartite +#' graph. Note, here this algorithm is used in the re-labeling algorithm by +#' Stephens (1997b). +#' +#' @param cost A matrix containing the costs for each row source and column +#' target. +#' @return An integer matrix defining the best solution to the assignment +#' problem. +#' @export +#' @seealso +#' * [mcmcpermute()] for the calling function +#' * [mcmcestimate()] for the function that uses the re-labeling algorithm by +#' Stephens (1997b) +#' +#' @references +#' * Stephens, Matthew (1997b), "Dealing with Label-Switching in Mixture +#' Models", Journal of the Royal Statistical Society Series B, 62(4) hungarian_cc <- function(cost) { - .Call(`_finmix_hungarian_cc`, cost) + .Call('_finmix_hungarian_cc', PACKAGE = 'finmix', cost) } +#' Calculate moments on samples of multivariate mixture models +#' +#' @description +#' This function calculates the moments for MCMC samples of multivariate +#' mixture models. Moments like means, standard deviations, kurtosis and +#' skewness are computed for each iteration in MCMC sampling. The moments are +#' used when plotting the traces of an MCMC sample output. +#' +#' @param classS4 An `mcmcoutput` class containing the MCMC samples. +#' @return A named list with vectors containing the data moments for each +#' iteration in the MCMC sample. +#' @export +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the `mcmcoutput` class definition +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces][mcmcoutput_class] for the calling function moments_cc <- function(classS4) { - .Call(`_finmix_moments_cc`, classS4) + .Call('_finmix_moments_cc', PACKAGE = 'finmix', classS4) } +#' Calculate moments on permuted samples of multivariate mixture models +#' +#' @description +#' This function calculates the moments for re-labeled MCMC samples of +#' multivariate mixture models. Moments like means, standard deviations, +#' kurtosis and skewness are computed for each iteration in MCMC sampling. The +#' moments are used when plotting the traces of an MCMC sample output. +#' +#' @param classS4 An `mcmcoutputperm` class containing the re-labeled MCMC +#' samples. +#' @return A named list with vectors containing the data moments for each +#' iteration in the re-labeled MCMC sample. +#' @export +#' @seealso +#' * [mcmcoutputperm][mcmcoutputperm_class] for the `mcmcoutput` class definition +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for re-labeling MCMC samples +#' * [plotTraces][mcmcoutputperm_class] for the calling function permmoments_cc <- function(classS4) { - .Call(`_finmix_permmoments_cc`, classS4) + .Call('_finmix_permmoments_cc', PACKAGE = 'finmix', classS4) } +#' Performs MCMC sampling for mixtures of Binomial distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a Binomial mixture +#' model. In addition an `mcmcoutput` object is given that stores the output +#' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +#' so-called "mixin" layers that help to design a software by organizing code +#' into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the Binomial finite mixture +#' model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_binomial_cc <- function(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_binomial_cc', PACKAGE = 'finmix', fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of conditional Poisson distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a conditional Poisson +#' mixture model. In addition an `mcmcoutput` object is given that stores the +#' output of MCMC sampling in R memory. Note that `finmix` relies in C++ code +#' on so-called "mixin" layers that help to design a software by organizing +#' code into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the conditional Poisson finite mixture +#' model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_condpoisson_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_condpoisson_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of Exponential distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a Exponential mixture +#' model. In addition an `mcmcoutput` object is given that stores the output +#' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +#' so-called "mixin" layers that help to design a software by organizing code +#' into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the Exponential finite mixture +#' model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_exponential_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_exponential_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of Normal distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a Normal mixture +#' model. In addition an `mcmcoutput` object is given that stores the output +#' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +#' so-called "mixin" layers that help to design a software by organizing code +#' into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the Normal finite mixture +#' model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_normal_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_normal_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of multivariate Normal distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a multivariate Normal +#' mixture model. In addition an `mcmcoutput` object is given that stores the +#' output of MCMC sampling in R memory. Note that `finmix` relies in C++ code +#' on so-called "mixin" layers that help to design a software by organizing +#' code into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the multivariate Normal finite +#' mixture model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_normult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_normult_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of Poisson distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a Poisson mixture +#' model. In addition an `mcmcoutput` object is given that stores the output +#' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +#' so-called "mixin" layers that help to design a software by organizing code +#' into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the Poisson finite mixture +#' model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_poisson_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_poisson_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of Student-t distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a Student-t mixture +#' model. In addition an `mcmcoutput` object is given that stores the output +#' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +#' so-called "mixin" layers that help to design a software by organizing code +#' into layers that build upon each others and enable modularity in MCMC +#' sampling by allowing to combine different sampling designs, e.g. with or +#' without a hierarchical prior, with fixed indicators or storing posterior +#' density parameters. See for more information on mixin layers Smaragdakis +#' and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the Student-t finite mixture +#' model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_student_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_student_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Performs MCMC sampling for mixtures of multivariate Student-t distributions +#' +#' @description +#' For internal usage only. This function gets passed the `fdata`, `model`, +#' `prior`, `mcmc` objects to perform MCMC sampling for a multivriate +#' Student-t mixture model. In addition an `mcmcoutput` object is given that +#' stores the output of MCMC sampling in R memory. Note that `finmix` relies +#' in C++ code on so-called "mixin" layers that help to design a software by +#' organizing code into layers that build upon each others and enable +#' modularity in MCMC sampling by allowing to combine different sampling +#' designs, e.g. with or without a hierarchical prior, with fixed indicators +#' or storing posterior density parameters. See for more information on mixin +#' layers Smaragdakis and Butory (1998). +#' +#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param model_S4 A `model` object specifying the multivariate Student-t +#' finite mixture model. +#' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +#' sampling. +#' @param mcmc_S4 An `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +#' sampling using R memory. +#' @return An `mcmcoutput` object containing the results from MCMC sampling +#' and using the R memory from the input argument `mcmcoutput_S4`. +#' @export +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' +#' @references +#' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +#' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +#' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +#' Berlin, Heidelberg. +mcmc_studmult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) { + .Call('_finmix_mcmc_studmult_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} + +#' Relabeling algorithm from Stephens (1997a) for Poisson mixture models +#' +#' @description +#' For internal usage only. This function runs the re-labeling algorithm from +#' Stephens (1997a) for MCMC samples of a Poisson mixture distribution. For +#' optimization a Nelder-Mead-Algorithm from the NLopt library is used. This +#' is also the reason why the package depends on the `nloptr` package which +#' provides a header file for direct access to the C routines. +#' +#' @param values1 A matrix containing the sampled component parameters +#' `lambda`. +#' @param values2 A matrix containing the sampled weights. +#' @param pars A vector containing the parameters of the prior distributions +#' of the component parameters and weights. More specifically, the +#' parameters of the Dirichlet distribution for the weights and the +#' shape and rate parameters for the Gamma distributions of the component +#' parameters. +#' @param perm A matrix with all possible permutations of the labels. +#' @return A matrix of dimension `MxK` that holding the optimal labeling. +#' @export +#' +#' @seealso +#' * \code{\link{mcmcpermute}} for the calling function +#' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +#' Stephens (1997b) +#' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +#' for mixtures of Binomial distributions +#' +#' @references +#' * Stephens, Matthew (1997a), Discussion of "On Bayesian Analysis of +#' Mixtures with an Unknown Number of Components", Journal of the Royal +#' Statistical Society: Series B (Statistical Methodology), 59: 731-792. stephens1997a_poisson_cc <- function(values1, values2, pars, perm) { - .Call(`_finmix_stephens1997a_poisson_cc`, values1, values2, pars, perm) + .Call('_finmix_stephens1997a_poisson_cc', PACKAGE = 'finmix', values1, values2, pars, perm) } +#' Relabeling algorithm from Stephens (1997a) for Binomial mixture models +#' +#' @description For internal usage only. This function runs the re-labeling +#' algorithm from Stephens (1997a) for MCMC samples of a Binomial mixture +#' distribution. For optimization a Nelder-Mead-Algorithm from the NLopt +#' library is used. This is also the reason why the package depends on the +#' `nloptr` package which provides a header file for direct access to the C +#' routines. +#' +#' @param values1 A matrix containing the sampled component parameters `p`. +#' @param values2 A matrix containing the sampled weights. +#' @param pars A vector containing the parameters of the posterior +#' distributions of the component parameters and weights. More specifically, +#' the parameters of the Dirichlet distribution for the weights and the shape +#' and rate parameters for the Beta distributions of the component +#' parameters. +#' @param perm A matrix with all possible permutations of the labels. +#' @return A matrix of dimension `MxK` that holding the optimal labeling. +#' @export +#' +#' @seealso +#' * \code{\link{mcmcpermute}} for the calling function +#' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +#' Stephens (1997b) +#' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +#' for mixtures of Binomial distributions +#' +#' @references +#' * Stephens, Matthew (1997a), Discussion of "On Bayesian Analysis of +#' Mixtures with an Unknown Number of Components", Journal of the Royal +#' Statistical Society: Series B (Statistical Methodology), 59: 731-792. stephens1997a_binomial_cc <- function(values1, values2, pars, perm) { - .Call(`_finmix_stephens1997a_binomial_cc`, values1, values2, pars, perm) + .Call('_finmix_stephens1997a_binomial_cc', PACKAGE = 'finmix', values1, values2, pars, perm) } +#' Relabeling algorithm from Stephens (1997b) for Poisson mixture models +#' +#' @description +#' For internal usage only. This function runs the re-labeling algorithm from +#' Stephens (1997b) for MCMC samples of a Poisson mixture distribution. +#' +#' @param values A matrix of observations of dimension `Nx1`. +#' @param comp_par An array of component parameter samples from MCMC sampling. +#' Dimension is `MxK`. +#' @param weight An array of weight parameter samples from MCMC sampling. +#' Dimension is `MxK`. +#' @param max_iter A signed integer specifying the number of iterations to be +#' run in optimization. Unused. +#' @return An integer matrix of dimension `MxK` that holding the optimal +#' labeling. +#' @export +#' +#' @seealso +#' * \code{\link{mcmcpermute}} for the calling function +#' * \code{\link{stephens1997a_poisson_cc}} for the re-labeling algorithm from +#' Stephens (1997a) +#' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +#' for mixtures of Binomial distributions +#' +#' @references +#' * Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +#' distributions, DPhil Thesis, University of Oxford, Oxford. stephens1997b_poisson_cc <- function(values, comp_par, weight_par, max_iter = 200L) { - .Call(`_finmix_stephens1997b_poisson_cc`, values, comp_par, weight_par, max_iter) + .Call('_finmix_stephens1997b_poisson_cc', PACKAGE = 'finmix', values, comp_par, weight_par, max_iter) } +#' Relabeling algorithm from Stephens (1997b) for Binomial mixture models +#' +#' @description +#' For internal usage only. This function runs the re-labeling algorithm from +#' Stephens (1997b) for MCMC samples of a Binomial mixture distribution. +#' +#' @param values A matrix of observations of dimension `Nx1`. +#' @param comp_par An array of component parameter samples from MCMC sampling. +#' Dimension is `MxK`. +#' @param weight An array of weight parameter samples from MCMC sampling. +#' Dimension is `MxK`. +#' @param max_iter A signed integer specifying the number of iterations to be +#' run in optimization. Unused. +#' @return An integer matrix of dimension `MxK` that holding the optimal +#' labeling. +#' @export +#' +#' @seealso +#' * \code{\link{mcmcpermute}} for the calling function +#' * \code{\link{stephens1997a_binomial_cc}} for the re-labeling algorithm from +#' Stephens (1997a) +#' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +#' for mixtures of Poisson distributions +#' +#' @references +#' * Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +#' distributions, DPhil Thesis, University of Oxford, Oxford. stephens1997b_binomial_cc <- function(values, reps, comp_par, weight_par) { - .Call(`_finmix_stephens1997b_binomial_cc`, values, reps, comp_par, weight_par) + .Call('_finmix_stephens1997b_binomial_cc', PACKAGE = 'finmix', values, reps, comp_par, weight_par) } +#' Relabeling algorithm from Stephens (1997b) for Exponential mixture models +#' +#' @description +#' For internal usage only. This function runs the re-labeling algorithm from +#' Stephens (1997b) for MCMC samples of a Exponential mixture distribution. +#' +#' @param values A matrix of observations of dimension `Nx1`. +#' @param comp_par An array of component parameter samples from MCMC sampling. +#' Dimension is `MxK`. +#' @param weight An array of weight parameter samples from MCMC sampling. +#' Dimension is `MxK`. +#' @param max_iter A signed integer specifying the number of iterations to be +#' run in optimization. Unused. +#' @return An integer matrix of dimension `MxK` that holding the optimal +#' labeling. +#' @export +#' +#' @seealso +#' * \code{\link{mcmcpermute}} for the calling function +#' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +#' for mixtures of Poisson distributions +#' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +#' for mixtures of Binomial distributions +#' +#' @references +#' * Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +#' distributions, DPhil Thesis, University of Oxford, Oxford. stephens1997b_exponential_cc <- function(values, comp_par, weight_par) { - .Call(`_finmix_stephens1997b_exponential_cc`, values, comp_par, weight_par) + .Call('_finmix_stephens1997b_exponential_cc', PACKAGE = 'finmix', values, comp_par, weight_par) } diff --git a/R/binomialmodelmoments.R b/R/binomialmodelmoments.R index 865d380..977b22d 100644 --- a/R/binomialmodelmoments.R +++ b/R/binomialmodelmoments.R @@ -15,6 +15,22 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `binomialmodelmoments` class +#' +#' @description +#' Defines a class that holds modelmoments for a finite mixture of Binomial +#' distributions. Note that this class is not directly used, but indirectly +#' when calling the `modelmoments` constructor \code{\link{modelmoments}}. +#' +#' This is a class that directly inherits from the `dmodelmoments` class. +#' @import methods +#' @exportClass binomialmodelmoments +#' @name binomialmodelmoments-class +#' +#' @seealso +#' * [modelmoments_class] for the base class for model moments +#' * \code{\link{modelmoments}} for the constructor of `modelmoments` classes +#' * \code{\link{dmodelmoments-class}} class for the parent class .binomialmodelmoments <- setClass("binomialmodelmoments", representation(extrabinvar = "numeric"), contains = c("dmodelmoments"), @@ -25,6 +41,24 @@ prototype(extrabinvar = numeric()) ) +#' Initializer of the `binomialmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object_ see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @noRd +#' +#' @seealso +#' * \code{\link{Classes_Details}} for details of class definitions, and +#' * \code{\link{setOldClass}} for the relation to S3 classes setMethod( "initialize", "binomialmodelmoments", function(.Object, ..., model) { @@ -33,6 +67,15 @@ setMethod( } ) +#' Generate moments for binomial mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' binomial mixture distribution. +#' +#' @param object An `binomialmodelmoments` object. +#' @return An `binomialmodelmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "binomialmodelmoments", function(object) { @@ -40,6 +83,16 @@ setMethod( } ) +#' Shows a summary of an `binomialmodelmoments` object. +#' +#' Calling [show()] on an `binomialmodelmoments` object gives an overview +#' of the moments of an binomial finite mixture. +#' +#' @param object An `binomialmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn binomialmodelmoments Shows a summary of an object setMethod( "show", "binomialmodelmoments", function(object) { @@ -71,6 +124,23 @@ setMethod( ) ## Getters ## +#' Getter method of `binomialmodelmoments` class. +#' +#' Returns the `extrabinvar` slot. +#' +#' @param object An `binomialmodelmoments` object. +#' @returns The `extrabinvar` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("binomial", par=list(p=c(0.3, 0.5)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getExtrabinvar(f_moments) +#' +#' @seealso +#' * \code{\link{modelmoments-class}} for the base class for model moments +#' * \code{\link{modelmoments}} for the constructor of the `modelmoments` class family setMethod( "getExtrabinvar", "binomialmodelmoments", function(object) { @@ -83,18 +153,38 @@ setMethod( ### Private functions ### These function are not exported +#' Generates theoretical moments for a binomial mixture +#' +#' @description +#' Calling [.genwerateMomentsBinomial()] generates theoretical model moments +#' for the binomial model defined in the `model` object. Next to the general +#' mixture moments available to any mixture model, the binomial moments also +#' include the extra-binomial variation `extrabinvar` +#' (see Fruehwirth-Schnatter (2006)) and the number of expected zeros `zero`. +#' +#' @param object A `binomialmodelmoments` object with correpsonding `model` +#' object. Note that, if the `model` object has repetitions in slot `T` with +#' dimension larger than one only the first repetition is used for theoretical +#' moments. +#' @returns A `modelmoments` object containing the theoreitcal moments of the +#' binomial mixture defined in the `model` object. +#' @noRd +#' +#' @seealso +#' * \code{\link{dmodelmoments-class}} for the class definition of `dmodelmoments` +#' * \code{\link{modelmoments}} for the constructor calling this function ".generateMomentsBinomial" <- function(object) { p <- object@model@par$p - n <- object@model@par$n + T <- object@model@T[1] weight <- object@model@weight - object@mean <- sum(weight * n * p) - object@var <- array(sum(weight * (n * p - object@mean)^2) - + sum(weight * n * p * (1 - p)), dim = c(1, 1)) + object@mean <- sum(weight * p) + object@var <- array(sum(weight * (T * p - object@mean)^2) + + sum(weight * T * p * (1 - p)), dim = c(1, 1)) factm <- array(NA, dim = c(4, 1)) factm[1] <- object@mean for (i in seq(2, 4)) { - if (n >= i) { - factm[i] <- sum(weight * factorial(n) / factorial(n - i) * p^i) + if (T >= i) { + factm[i] <- sum(weight * factorial(T) / factorial(T - i) * p^i) } else { factm[i] <- NaN } @@ -106,7 +196,7 @@ setMethod( } else { object@over <- 0 } - object@zero <- sum(weight * (1 - p)^n) - object@extrabinvar <- object@mean * (1 - object@mean / n[1]) + object@zero <- sum(weight * (1 - p)^T) + object@extrabinvar <- object@mean * (1 - object@mean / T) return(object) } diff --git a/R/cdatamoments.R b/R/cdatamoments.R index 43c4aa5..92a05ac 100644 --- a/R/cdatamoments.R +++ b/R/cdatamoments.R @@ -15,6 +15,31 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `cdatamoments` class +#' +#' Stores moments of an [fdata][fdata_class] object containing continuous data. +#' The `fdata` object is stored in the parent [datamoments][datamoments_class] +#' class. +#' +#' @slot higher An array containing the four higher centralized moments of the +#' continuous data stored in the `fdata` object. +#' @slot skewness A vector storing the skewness of the continuous data in the +#' corresponding `fdata` object. +#' @slot kurtosis A vector storing the kurtosis of the continuous data in the +#' corresponding `fdata` object. +#' @slot corr A matrix containing the correlations between the data dimensions +#' in case of multivariate data (i.e. slot `r` in the `fdata` object is +#' larger than one). +#' @slot smoments A `csdatamoments` object, if the `fdata` object also holds +#' indicators. `NULL`, if no indicators are present in the `fdata` object. +#' @exportClass cdatamoments +#' @name cdatamoments_class +#' @seealso +#' * [datamoments][datamoments_class] for the parent class +#' * [ddatamoments][ddatamoments_class] for the corresponding class for +#' discrete data +#' * [csdatamoments][csdatamoments_class] for the contained class if indicators +#' are present in the `fdata` object .cdatamoments <- setClass("cdatamoments", representation( higher = "array", @@ -37,6 +62,23 @@ ) ) +#' Initializer of the `cdatamoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step the moments for a passed-in `fdata` +#' object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `fdata` object containing the observations. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "cdatamoments", function(.Object, ..., value = fdata()) { @@ -50,6 +92,15 @@ setMethod( } ) +#' Generate moments for continuous data. +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of a +#' finite mixture with continuous data. +#' +#' @param object An `cdatamoments` object. +#' @return An `cdatamoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "cdatamoments", function(object) { @@ -57,6 +108,16 @@ setMethod( } ) +#' Shows a summary of a `cdatamoments` object. +#' +#' Calling [show()] on a `cdatamoments` object gives an overview +#' of the moments of a finit mixture with continuous data. +#' +#' @param object A `cdatamoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn cdatamoments_class setMethod( "show", "cdatamoments", function(object) { @@ -101,6 +162,27 @@ setMethod( ) ## Getters ## +#' Getter method of `cdatamoments` class. +#' +#' Returns the `smoments` slot. +#' +#' @param object An `cdatamoments` object. +#' @returns The `smoments` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getSmoments(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getSmoments", "cdatamoments", function(object) { @@ -108,6 +190,27 @@ setMethod( } ) +#' Getter method of `cdatamoments` class. +#' +#' Returns the `higher` slot. +#' +#' @param object An `cdatamoments` object. +#' @returns The `higher` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Use the getter. +#' getHigher(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getHigher", "cdatamoments", function(object) { @@ -115,6 +218,27 @@ setMethod( } ) +#' Getter method of `cdatamoments` class. +#' +#' Returns the `skewness` slot. +#' +#' @param object An `cdatamoments` object. +#' @returns The `skewness` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Use the getter. +#' getSkewness(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getSkewness", "cdatamoments", function(object) { @@ -122,6 +246,27 @@ setMethod( } ) +#' Getter method of `cdatamoments` class. +#' +#' Returns the `kurtosis` slot. +#' +#' @param object An `cdatamoments` object. +#' @returns The `kurtosis` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Use the getter. +#' getKurtosis(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getKurtosis", "cdatamoments", function(object) { @@ -129,6 +274,27 @@ setMethod( } ) +#' Getter method of `cdatamoments` class. +#' +#' Returns the `corr` slot. +#' +#' @param object An `cdatamoments` object. +#' @returns The `corr` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Use the getter. +#' getCorr(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getCorr", "cdatamoments", function(object) { @@ -140,6 +306,18 @@ setMethod( ### Private functions ### These function are not exported +#' Generate data moments for finite mixture data +#' +#' @description +#' Only called implicitly. generates all moments of finite mixture data in a +#' `fdata` object. +#' +#' @param object An `cdatamoments` object to contain all calculated +#' moments. +#' @returns An `cdatamoments` object containing all moments of the +#' inite mixture data. +#' @importFrom stats var cor +#' @noRd ".generateCdatamoments" <- function(object) { ## enforce column-wise ordering ## hasY(object@fdata, verbose = TRUE) diff --git a/R/cmodelmoments.R b/R/cmodelmoments.R index 382d6b9..82eea90 100644 --- a/R/cmodelmoments.R +++ b/R/cmodelmoments.R @@ -15,6 +15,24 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `cmodelmoments` class +#' +#' @description +#' This class defines the general theoretical moments of a finite mixture model +#' with continuous data. +#' +#' @slot higher An array containing the four higher centralized moments of the +#' (in case of multivariate data marginal) finite mixture. +#' @slot skewness A vector containing the skewness(es) of the finite mixture +#' model. +#' @slot kurtosis A vector containing the kurtosis(es) of the finite mixture +#' model. +#' @exportClass cmodelmoments +#' @name cmodelmoments +#' +#' @seealso +#' * [modelmoments] for the base class +#' * [modelmoments()] for the constructor of any `modelmoments` inherited class .cmodelmoments <- setClass("cmodelmoments", representation( higher = "array", @@ -34,14 +52,65 @@ ) ## Getters ## +#' Getter method of `cmodelmoments` class. +#' +#' Returns the `higher` slot. +#' +#' @param object An `cmodelmoments` object. +#' @returns The `higher` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getHigher(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod("getHigher", "cmodelmoments", function(object) { return(object@higher) }) +#' Getter method of `cmodelmoments` class. +#' +#' Returns the `skewness` slot. +#' +#' @param object An `cmodelmoments` object. +#' @returns The `skewness` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getSkewness(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod("getSkewness", "cmodelmoments", function(object) { return(object@skewness) }) +#' Getter method of `cmodelmoments` class. +#' +#' Returns the `kurtosis` slot. +#' +#' @param object An `cmodelmoments` object. +#' @returns The `kurtosis` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getKurtosis(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod("getKurtosis", "cmodelmoments", function(object) { return(object@kurtosis) }) diff --git a/R/csdatamoments.R b/R/csdatamoments.R index e8f23dc..b2c723d 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -15,6 +15,28 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `csdatamoments` class +#' +#' Stores moments for indicators of continuous data. Inherited directly from +#' the [sdatamoments][sdatamoments_class] class. +#' +#' @slot B A vector storing the between-group heterogeneity. +#' @slot W A vector storing the within-group heterogeneity. +#' @slot T A vector storing the total variance. +#' @slot R A numeric storing the coefficient of determination for univariate +#' data. +#' @slot Rdet A numeric storing the coefficient of determination using the +#' trace for multivariate data. +#' @slot Rtr A numeric storing the coefficient of determination using the +#' determinants for multivariate data. +#' @exportClass csdatamoments +#' @name csdatamoments_class +#' @seealso +#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments()] for the constructor of any object of the `datamoments` +#' class family +#' * [sdatamoments][csdatamoments_class] for the corresponding class defining +#' moments for data from a discrete-valued finite mixture .csdatamoments <- setClass("csdatamoments", representation( B = "vector", @@ -39,8 +61,33 @@ ) ) +#' Finmix class union of `csdatamoments` and `NULL` +#' +#' @description +#' Defines a class union such that the object held by a child class can also +#' be `NULL`. +#' +#' @export +#' @noRd setClassUnion("csdatamomentsOrNULL", members = c("csdatamoments", "NULL")) +#' Initializer of the `csdatamoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step the moments for a passed-in `fdata` +#' object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix [fdata][fdata_class] object containing the observations. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "csdatamoments", function(.Object, ..., value = fdata()) { @@ -52,6 +99,15 @@ setMethod( } ) +#' Generate moments for indicators from a mixture with continuous data +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of a +#' finite mixture with continuous data. +#' +#' @param object An `csdatamoments` object. +#' @return An `csdatamoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "csdatamoments", function(object) { @@ -59,6 +115,16 @@ setMethod( } ) +#' Shows a summary of an `csdatamoments` object. +#' +#' Calling [show()] on an `csdatamoments` object gives an overview +#' of the moments of a finite mixture with continuous data. +#' +#' @param object An `csdatamoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn csdatamoments_class setMethod( "show", "csdatamoments", function(object) { @@ -91,6 +157,30 @@ setMethod( ) ## Getters ## +#' Getter method of `csdatamoments` class. +#' +#' Returns the `gmoments` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `gmoments` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getGmoments(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][csdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getGmoments", "csdatamoments", function(object) { @@ -98,6 +188,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `WK` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `WK` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getWK(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getWK", "csdatamoments", function(object) { @@ -105,6 +219,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `var` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `var` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getVar(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getVar", "csdatamoments", function(object) { @@ -112,6 +250,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `B` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `B` slot of the `object`. +#' @describeIn datamoments_class +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getB(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getB", "csdatamoments", function(object) { @@ -119,6 +281,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `W` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `W` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getW(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getW", "csdatamoments", function(object) { @@ -126,6 +312,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `T` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `T` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getT(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getT", "csdatamoments", function(object) { @@ -133,6 +343,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `R` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `R` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getR(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getR", "csdatamoments", function(object) { @@ -140,6 +374,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `Rtr` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `Rtr` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getRtr(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getRtr", "csdatamoments", function(object) { @@ -147,6 +405,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `Rdet` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `Rdet` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getRdet(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getRdet", "csdatamoments", function(object) { @@ -154,6 +436,30 @@ setMethod( } ) +#' Getter method of `csdatamoments` class. +#' +#' Returns the `fdata` slot. +#' +#' @param object An `csdatamoments` object. +#' @returns The `fdata` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getFdata(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [csdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getFdata", "csdatamoments", function(object) { @@ -166,6 +472,17 @@ setMethod( ### Private functions ### These functions are not exported +#' Generate data moments for finite mixture data +#' +#' @description +#' Only called implicitly. generates all moments of finite mixture data in a +#' `fdata` object. +#' +#' @param object A `csdatamoments` object to contain all calculated +#' moments. +#' @returns A `csdatamoments` object containing all moments of the +#' inite mixture data. +#' @noRd ".generateCsdatamoments" <- function(object) { ## enforce column.wise ordering ## datam <- getColY(object@fdata) @@ -187,7 +504,7 @@ setMethod( ## Calculate coefficient of determination ## ## 'Rtr' is an 1 x 1 numeric ## ## 'Rdet' is an 1 x 1 numeric ## - if (object@data@r > 1) { + if (object@fdata@r > 1) { r <- NA object@R <- as.numeric(r) object@Rtr <- 1 - sum(diag(object@W), na.rm = TRUE) / diff --git a/R/dataclass.R b/R/dataclass.R index 2924b87..14a472b 100644 --- a/R/dataclass.R +++ b/R/dataclass.R @@ -15,6 +15,39 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +# CLASSIFICATION OF OBSEVRATIONS USING FULLY SPECIFIED MODEL +#' Finmix `dataclass` class +#' +#' @description +#' Stores objects to classify observations using a fully specified mixture +#' model. If the indicators a finite mixture model is fully specified as then +#' the likelihood can be calculated for each observation depending on the +#' component it stems from. +#' +#' @slot logpy An array containing the logarithmized +#' @slot prob An array storing the probability classification matrix that +#' defines for each observation the probability of belonging to component +#' `k`. Henceforth, each row sums to one. The dimension of this array is +#' `N x K`. +#' @slot mixlik A numeric storing the logarithm of the mixture likelihood +#' evaluated at certain parameters `par` from a finmix `model` object and +#' corresponding `weights`. +#' @slot entropy A numeric storing the entropy of the classification. +#' @slot loglikcd An array storing the logarithm of the conditional likelihood +#' of each component parameter, if indicators have not been simulated. The +#' array has dimension `1 x K`. +#' @slot postS A numeric storing the posterior probability of the indicators +#' `S` in the data, if indicators have been simulated. +#' @exportClass dataclass +#' @name dataclass_class +#' +#' @seealso +#' * [fdata][fdata_class] for the class holding the data +#' * [model][model_class] for the class defining a finite mixture model +#' * [dataclass()] for the constructor of this class +#' +#' @references +#' Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" .dataclass <- setClass("dataclass", representation( logpy = "array", @@ -38,6 +71,28 @@ ) ) +#' Finmix `dataclass` constructor +#' +#' Calling [dataclass()] classifies data using a fully specified mixture model. +#' Henceforth, the finite mixture model `model` must be fully specified, i.e. +#' containing parameters in slot `@@par`, weights in slot `@@weight` and +#' indicators in slot `@@S` of the corresponding `fdata` object. +#' +#' @param fdata An `fdata` object containing observations in slot `@@y` and +#' indicators in slot `@@S`. +#' @param model A `model` object containing parameters in slot `@@par` and +#' and weights in slot `@@weight`. +#' @param simS A logical defining, if the indicators `S` should be simulated. +#' @return A `dataclass` object containing the classification matrix, +#' model log-likelihood, entropy and indicators, if the latter have been +#' simulated. +#' @export +#' +#' @seealso +#' * [dataclass][dataclass_class] for the class definition +#' +#' #' @references +#' Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" "dataclass" <- function(fdata = NULL, model = NULL, simS = FALSE) { .check.fdata.model.Dataclass(fdata, model) .check.model.Dataclass(model) @@ -67,6 +122,16 @@ } } +#' Shows a summary of a `dataclass` object. +#' +#' Calling [show()] on a `dataclass` object gives an overview +#' of the slots of this class. +#' +#' @param object A `dataclass` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn dataclass_class setMethod( "show", "dataclass", function(object) { @@ -105,36 +170,163 @@ setMethod( ) ## Getters ## +#' Getter method of `dataclass` class. +#' +#' Returns the `logpy` slot. +#' +#' @param object An `dataclass` object. +#' @returns The `logpy` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Classify observations +#' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +#' getLogpy(f_datamoms) +#' +#' @seealso +#' * [dataclass][dataclass_class] for the base class +#' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getLogpy", "dataclass", function(object) { return(object@logpy) } ) + +#' Getter method of `dataclass` class. +#' +#' Returns the `prob` slot. +#' +#' @param object An `dataclass` object. +#' @returns The `prob` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Classify observations +#' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +#' getProb(f_datamoms) +#' +#' @seealso +#' * [dataclass][dataclass_class] for the base class +#' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getProb", "dataclass", function(object) { return(object@prob) } ) + +#' Getter method of `dataclass` class. +#' +#' Returns the `mixlik` slot. +#' +#' @param object An `dataclass` object. +#' @returns The `mixlik` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Classify observations +#' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +#' getMixlik(f_datamoms) +#' +#' @seealso +#' * [dataclass][dataclass_class] for the base class +#' * [dataclass()] for the constructor of the `dataclass` class< setMethod( "getMixlik", "dataclass", function(object) { return(object@mixlik) } ) + +#' Getter method of `dataclass` class. +#' +#' Returns the `entropy` slot. +#' +#' @param object An `dataclass` object. +#' @returns The `entropy` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Classify observations +#' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +#' getEntropy(f_datamoms) +#' +#' @seealso +#' * [dataclass][dataclass_class] for the base class +#' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getEntropy", "dataclass", function(object) { return(object@entropy) } ) + +#' Getter method of `dataclass` class. +#' +#' Returns the `loglikcd` slot. Note that this slot is only non-null, if the +#' indicators have not been simulated. +#' +#' @param object An `dataclass` object. +#' @returns The `loglikcd` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Classify observations +#' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +#' getLoglikcd(f_datamoms) +#' +#' @seealso +#' * [dataclass][dataclass_class] for the base class +#' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getLoglikcd", "dataclass", function(object) { return(object@loglikcd) } ) + +#' Getter method of `dataclass` class. +#' +#' Returns the `postS` slot. Note that this slot is only non-null, if the +#' indicators have been simulated. +#' +#' @param object An `dataclass` object. +#' @returns The `postS` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Classify observations +#' f_dataclass <- dataclass(f_data, f_model, simS = TRUE)[[1]] +#' getPostS(f_datamoms) +#' +#' @seealso +#' * [dataclass][dataclass_class] for the base class +#' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getPostS", "dataclass", function(object) { @@ -142,7 +334,7 @@ setMethod( } ) -## No setters as users are not intended to mnaipulate ## +## No setters as users are not intended to manipulate ## ## this object. ## ### Private functions @@ -155,6 +347,26 @@ setMethod( ### object must be consistent to each other, i.e. the 'model' ### object must have defined a distribution in @dist that ### conforms with the dimension @r of the #fdata' object. +#' Checking `fdata` object and `model` object for `dataclass` +#' +#' For internal usage only. This function checks an `fdata` object and a +#' `model` object in regard to consistency. First of all the data dimensions +#' must fit between the two object, meaning that if `@@r>1` in the `fdata` +#' object the model object must possess a `@@dist` slot with an appropriate +#' distribution for multivariate data. The `fdata` object must contain data in +#' its slot `@@y`. As a first safeguard this function checks if the first +#' argument is indeed an `fdata` object. +#' +#' @param fdata.obj An `fdata` object. +#' @param model.obj A `model` object containing a specified distribution, +#' parameters and weigths. +#' @return None. If the checks do not run through, an error is thrown. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".check.fdata.model.Dataclass" <- function(fdata.obj, model.obj) { if (class(fdata.obj) != "fdata") { stop(paste("Wrong argument in 'dataclass()'. First ", @@ -169,6 +381,21 @@ setMethod( ### Check model: 'model' must be an object of class 'model'. ### Furthermore, it must be valid and contain specified ### parameters in @par and weights in @weight. +#' Checking `model` object for `dataclass` constructor +#' +#' For internal usage only. This function checks if the `model` object passed +#' in by the user is first of all indeed a finmix `model` object. Furthermore, +#' it is checked if the model is fully specified meaning that parameters are +#' defined in slot `@@par` and weights in slot `@@weight`. +#' +#' @param model.obj A `model` object. Must be fully specified. +#' @return None. If the checks do not pass, an error is thrown. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".check.model.Dataclass" <- function(model.obj) { if (class(model.obj) != "model") { stop(paste("Wrong argument in 'dataclass()'. Second ", @@ -184,6 +411,23 @@ setMethod( ### Check indicators: Indicators must have as many different factors ### as @K in the 'model' object. Further, values must be out of the ### sequence 1, ..., K. +#' Checking indicators for `dataclass` constructor +#' +#' For internal usage only. This function checks if the indicators stored in +#' the `fdata` object are correctly specified meaning if the indicator values +#' are indeed from as many components as specifed in the slot `@@K` of the +#' corresponding model object. +#' +#' @param fdata.obj An `fdata` object containing the indicators in its slot +#' `@@S`. +#' @param model.obj A `model` object. Must be fully specified. +#' @return None. If the checks do not pass, an error is thrown. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".check.S.Dataclass" <- function(fdata.obj, model.obj) { values <- levels(as.factor(fdata.obj@S)) if (!identical(range(fdata.obj@S), range(seq(1, model.obj@K)))) { @@ -195,9 +439,31 @@ setMethod( } } +#' Checking Student-t and normal `model` objects for `dataclass` constructor +#' +#' For internal usage only. Thiss function checks if the `model` object passed +#' in by the user is correctly specified in case the slot `@@dist` is one of +#' `normult` or `studmult`. Correctly specified for data classification means +#' that the slots `@@sigmainv` and `@@logdet` are non-null. `@@sigmainv` is the +#' inverse of the variance-covariance matrix of a multivariate normal or +#' Student-t distribution. Slot `@@logdet` defines the logarithm of the +#' determinant of the inverse of the variance-covariance matrix. If these slots +#' are not specified this function specifies these slots for the user. +#' +#' @param model.obj A `model` object. Must be fully specified. +#' @return The passed-in `model` object by the user possibly enriched by slots +#' `@@sigmainv` and `@@logdet`. If the checks do not pass, an error is thrown. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".check.Logdet.Norstud" <- function(model.obj) { has.sigmainv <- "sigmainv" %in% names(model.obj@par) - has.logdet <- "logdet" %in% names(model.obj@par) + has.logdet <- "logdet" %in% names(model.obj@par) + r <- model.obj@r + K <- model.obj@K if (has.sigmainv && has.logdet) { return(model.obj) } else { @@ -218,8 +484,24 @@ setMethod( ### Compute the likelihood l(y_i|theta_k) for all i and k ### lik.list is a 'list' object containing ## ### 'lh' exp(llh - maxl), an N x K 'matrix' -### 'maxl' the maximum likelihood, an 1 x K 'vector' +### 'maxl' the maximum likelihood, an N x 1 'vector' ### 'llh' the likelihood, a N x K 'matrix' +#' Computes the log-likelihood for data classification +#' +#' @description +#' For internal usage only. This function calls the appropriate function for +#' each finite mixture model specified in `model.obj`. +#' +#' @param fdata.obj An `fdata` object with non-empty slot `@@y`. +#' @param model.obj A `model` object. Must be fully specified. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".liklist.Dataclass" <- function(fdata.obj, model.obj) { K <- model.obj@K N <- fdata.obj@N @@ -275,6 +557,26 @@ setMethod( } } +#' Data classification for a multinomial indicator model +#' +#' @description +#' For internal usage only. This function constructs the `dataclass` object +#' and, if specified, simulates indicators `S`. A corresponding classification +#' for a Markov indicator model is not (yet) implemented. +#' +#' @param fdata.obj An `fdata` object with non-empty slot `@@y`. +#' @param model.obj A `model` object. Must be fully specified. +#' @param lik.list A list containing the likelihood, maximum likelihood and +#' log-likelihood for the data using the specified model. +#' @param A logical specifying, if indicators should be simulated. +#' @return A `dataclass` object containing the classifications of the data, if +#' `simS` was set to `TRUE`, and the likelihood values. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".multinomial.Dataclass" <- function(fdata.obj, model.obj, lik.list, simS) { N <- fdata.obj@N @@ -328,6 +630,29 @@ setMethod( } } +#' Computes the mixture likelihood for data classification +#' +#' @description +#' For internal usage only. This function computes the mixture likelihood for +#' the finite mixture model specified in `model.obj` using the likelihoods +#' of each single component and the weights specified in slot `@@weight` of the +#' `model` object. +#' +#' @param model.obj A `model` object. Must be fully specified. +#' @param lik.list A list containing the likelihood, maximum likelihood and the +#' log-likelihood of the data for each component of the finite mixture. +#' @param prob A logical indicating, if the probability classification matrix +#' should be computed. +#' @return A matrix of dimensions `N x 1` containing the mixture likelihood +#' for each observation. If `prob` ws set to `TRUE`, a list is returned +#' containing the mixture likelihood and in addition the probability +#' classification matrix of dimension `N x K`. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".mixlik.Dataclass" <- function(model.obj, lik.list, prob = FALSE) { ## p is an N x K matrix ## p <- t(apply(lik.list$lh, 1, "*", model.obj@weight)) @@ -345,6 +670,26 @@ setMethod( } } +#' Simulate classification for a finite mixture model +#' +#' @description +#' For internal usage only. This function simulates the indicators for a finite +#' mixture model using the probability classification matrix. +#' +#' @param p A matrix containing the classification probabilities for each +#' component `K` of the finite mixture and each observation. Dimension is +#' `N x K`. +#' @param K A numeric specifying the value range for the simulated indicators. +#' Corresponds to the number of components in the finite mixture model. +#' @param N A numeric specifying the number of indicators to be simulated. +#' @return A list containing the simulated indicators together with the +#' posterior log-likelihood of the simulated indicators. +#' @noRd +#' @importFrom stats runif +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".simulate.S.Dataclass" <- function(p, K, N) { ## Simulate classifications from classification probability ## matrix @@ -361,6 +706,25 @@ setMethod( return(sim.S) } +#' Classification with fixed indicators +#' +#' @description +#' For internal usage only. This function classifies data from a finite +#' mixture model with fixed indicators. +#' +#' @param fdata.obj An `fdata` object with non-empty slot `@@y`. +#' @param model.obj A `model` object. Must be fully specified. The slot +#' `@@indicfix` must be `TRUE`. +#' @param lik.list A list containing the likelihood, maximum likelihood, and +#' log-likelihood for the data in the `fdata` object. +#' @return An object of class `dataclass` containing the likelihood values for +#' the finite mixture model and the the data +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the calling function ".indicfix.Dataclass" <- function(fdata.obj, model.obj, lik.list) { K <- model.obj@K mixlik <- .mixlik.Dataclass(model.obj, lik.list) diff --git a/R/datamoments.R b/R/datamoments.R index 42b8706..bf1cd14 100644 --- a/R/datamoments.R +++ b/R/datamoments.R @@ -17,6 +17,22 @@ ## 'datamoments' is a virtual class from which the corresponding ## datamoments for 'continuous' and 'discrete' inherit + +#' Finmix `datamoments` class +#' +#' Stores moments of a corresponding `fdata` object. +#' +#' @slot mean A numeric storing the mean of the slot `y` in the `fdata` object. +#' @slot var A matrix storing the variance(s and covariances) of the `y` slot +#' in the `fdata` object. +#' @slot VIRTUAL Virtual class containing further data moments. +#' @exportClass datamoments +#' @name datamoments_class +#' @seealso +#' * [cdatamoments] for data moments of continuous data +#' * [ddatamoments] for data moments of discrete data +#' * [sdatamoments] for data moments of the indicators +#' .datamoments <- setClass( "datamoments", representation( @@ -27,7 +43,32 @@ ) ) + ## mutual constructor for all type of datamoments ## +#' Constructor for `datamoments` classes +#' +#' @description +#' Calling [datamoments()] generates the datamoments for an `fdata` object. +#' Depending on the type of data either an `cdatamoments` or `ddatamoments` +#' object is generated. If in addition the `fdata` object containes fixed +#' indicators, these `datamoments` object also hold an `sdatamoments` class to +#' store the data moments of these indicators. +#' +#' @param value An `fdata` object with at least slot `y` non-empty. +#' @returns An `datamoments` object containing the data moments for slot `y` +#' and if available slot `S`. +#' @export +#' +#' @examples +#' # Create an fdata class with Poisson data. +#' f_data <- fdata(rpois(100, 312), sim=TRUE) +#' # Compute the data moments. +#' datamoments(f_data) +#' +#' @seealso +#' * [datamoments] class for all slots of this class +#' * [cdatamoments] for the class for continuous data +#' * [ddatamoments] for the class for discrete data "datamoments" <- function(value = fdata()) { hasY(value, verbose = TRUE) if (value@type == "continuous") { diff --git a/R/ddatamoments.R b/R/ddatamoments.R index 2e61d98..8cf640a 100644 --- a/R/ddatamoments.R +++ b/R/ddatamoments.R @@ -14,7 +14,27 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `ddatamoments` class +#' +#' Stores moments of an [fdata][fdata_class] object containing discrete data. +#' The `fdata` object is stored in the parent [datamoments][datamoments_class] +#' class. +#' +#' @slot factorial An array containing the first four factorial moments of the +#' discrete data stored in the `fdata` object. +#' @slot over A vector storing the overdispersion of the discrete data in the +#' corresponding `fdata` object. +#' @slot zero A vector storing the fractions of zeros in the observed data. < +#' @slot smoments An `sdatamoments` object, if the `fdata` object also holds +#' indicators. `NULL`, if no indicators are present in the `fdata` object. +#' @exportClass ddatamoments +#' @name ddatamoments_class +#' @seealso +#' * [datamoments][datamoments_class] for the parent class +#' * [ddatamoments][ddatamoments_class] for the corresponding class for +#' continuous data +#' * [sdatamoments][sdatamoments_class] for the contained class if indicators +#' are present in the `fdata` object .ddatamoments <- setClass("ddatamoments", representation( factorial = "array", @@ -35,6 +55,23 @@ ) ) +#' Initializer of the `ddatamoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step the moments for a passed-in `fdata` +#' object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `fdata` object containing the observations. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "ddatamoments", function(.Object, ..., value = fdata()) { @@ -49,6 +86,15 @@ setMethod( ) ## Generic set in 'groupmoments.R' ## +#' Generate moments for continuous data. +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of a +#' finite mixture with continuous data. +#' +#' @param object An `ddatamoments` object. +#' @return An `ddatamoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "ddatamoments", function(object) { @@ -56,6 +102,16 @@ setMethod( } ) +#' Shows a summary of a `ddatamoments` object. +#' +#' Calling [show()] on a `ddatamoments` object gives an overview +#' of the moments of a finit mixture with continuous data. +#' +#' @param object A `ddatamoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn ddatamoments_class setMethod( "show", "ddatamoments", function(object) { @@ -94,6 +150,27 @@ setMethod( ) ## Getters ## +#' Getter method of `ddatamoments` class. +#' +#' Returns the `smoments` slot. +#' +#' @param object An `ddatamoments` object. +#' @returns The `smoments` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getSmoments(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getSmoments", "ddatamoments", function(object) { @@ -101,6 +178,27 @@ setMethod( } ) +#' Getter method of `ddatamoments` class. +#' +#' Returns the `smoments` slot. +#' +#' @param object An `ddatamoments` object. +#' @returns The `smoments` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getFactorial(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getFactorial", "ddatamoments", function(object) { @@ -108,6 +206,27 @@ setMethod( } ) +#' Getter method of `ddatamoments` class. +#' +#' Returns the `smoments` slot. +#' +#' @param object An `ddatamoments` object. +#' @returns The `smoments` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getOver(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getOver", "ddatamoments", function(object) { @@ -115,6 +234,27 @@ setMethod( } ) +#' Getter method of `ddatamoments` class. +#' +#' Returns the `smoments` slot. +#' +#' @param object An `ddatamoments` object. +#' @returns The `smoments` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_datamoms <- datamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getZero(f_datamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getZero", "ddatamoments", function(object) { @@ -127,6 +267,17 @@ setMethod( ### Private functions ### These functions are not exported +#' Generate data moments for finite mixture data +#' +#' @description +#' Only called implicitly. generates all moments of finite mixture data in a +#' `fdata` object. +#' +#' @param object A `ddatamoments` object to contain all calculated +#' moments. +#' @returns A `ddatamoments` object containing all moments of the +#' inite mixture data. +#' @noRd ".generateDdatamoments" <- function(object) { ## enforce column-wise ordering ## hasY(object@fdata, verbose = TRUE) diff --git a/R/distributions.R b/R/distributions.R index b4a5d2a..6134826 100644 --- a/R/distributions.R +++ b/R/distributions.R @@ -15,8 +15,20 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Density function of a Student-t distribution +#' +#' @description +#' Unused at this moment. +#' +#' @param x A vector of valued for which the density should be calculated. +#' @param mu A vector containing the mean of the distribution. +#' @param sigma A vector containing the standard deviation of the distribution. +#' @param df A vector containing the degrees of freedom of the distribution. +#' @return The density of the Student-t distribution for the values of `x`. +#' @keywords internal "dstud" <- function(x, mu, sigma, df) { - fun <- gamma((df + 1) / 2) / (gamma(df / 2) * sqrt(df * pi * sigma)) * (1 + (x - mu)^2 / (df * sigma))^(-(df + 1) / 2) + fun <- gamma((df + 1) / 2) / (gamma(df / 2) * sqrt(df * pi * sigma)) * + (1 + (x - mu)^2 / (df * sigma))^(-(df + 1) / 2) return(fun) } diff --git a/R/dmodelmoments.R b/R/dmodelmoments.R index 234e9b8..e69ff25 100644 --- a/R/dmodelmoments.R +++ b/R/dmodelmoments.R @@ -14,7 +14,21 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `dmodelmoments` class +#' +#' @description +#' This class defines the general theoretical moments of a finite mixture model +#' with discrete data. +#' +#' @slot over A numeric containing the over-dispersion. +#' @slot factorial An array containing the first four factorial moments. +#' @slot zero An numeric cotaining the excess zeros. +#' @exportClass dmodelmoments +#' @name dmodelmoments +#' +#' @seealso +#' * [modelmoments] for the base class +#' * [modelmoments()] for the constructor of any `modelmoments` inherited class .dmodelmoments <- setClass("dmodelmoments", representation( over = "numeric", @@ -34,14 +48,65 @@ ) ## Getters ## +#' Getter method of `dmodelmoments` class. +#' +#' Returns the `higher` slot. +#' +#' @param object An `dmodelmoments` object. +#' @returns The `higher` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getHigher(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod("getOver", "dmodelmoments", function(object) { return(object@over) }) +#' Getter method of `dmodelmoments` class. +#' +#' Returns the `skewness` slot. +#' +#' @param object An `dmodelmoments` object. +#' @returns The `skewness` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getSkewness(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod("getFactorial", "dmodelmoments", function(object) { return(object@factorial) }) +#' Getter method of `dmodelmoments` class. +#' +#' Returns the `kurtosis` slot. +#' +#' @param object An `dmodelmoments` object. +#' @returns The `kurtosis` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getKurtosis(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod("getZero", "dmodelmoments", function(object) { return(object@zero) }) diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index 0089054..ebfd60c 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -14,7 +14,22 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `exponentialmodelmoments` class +#' +#' @description +#' Defines a class that holds modelmoments for a finite mixture of exponential +#' distributions. Note that this class is not directly used, but indirectly +#' when calling the `modelmoments` constructor [modelmoments()]. +#' +#' @slot B A numeric defining the between-group heterogeneity. +#' @slot W A numeric defining the within-group heterogeneity. +#' @slot R A numeric defining the coefficient of determination. +#' @exportClass exponentialmodelmoments +#' @name exponentialmodelmoments +#' +#' @seealso +#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes .exponentialmodelmoments <- setClass("exponentialmodelmoments", representation( B = "numeric", @@ -33,6 +48,24 @@ ) ) +#' Initializer of the `exponentialmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object_ see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "exponentialmodelmoments", function(.Object, ..., model) { @@ -41,6 +74,15 @@ setMethod( } ) +#' Generate moments for exponential mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' exponential mixture distribution. +#' +#' @param object An `exponentialmodelmoments` object. +#' @return An `exponentialmodelmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "exponentialmodelmoments", function(object) { @@ -48,6 +90,15 @@ setMethod( } ) +#' Shows a summary of an `exponentialmodelmoments` object. +#' +#' Calling [show()] on an `exponentialmodelmoments` object gives an overview +#' of the moments of an exponential finite mixture. +#' +#' @param object An `exponentialmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @describeIn exponentialmodelmoments setMethod( "show", "exponentialmodelmoments", function(object) { @@ -77,6 +128,23 @@ setMethod( } ) +#' Getter method of `exponentialmodelmoments` class. +#' +#' Returns the `B` slot. +#' +#' @param object An `exponentialmodelmoments` object. +#' @returns The `B` slot of the `object`. +#' @describeIn modelmoments Getter method for slot `B` +#' +#' @examples +#' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getB(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getB", "exponentialmodelmoments", function(object) { @@ -84,6 +152,23 @@ setMethod( } ) +#' Getter method of `exponentialmodelmoments` class. +#' +#' Returns the `W` slot. +#' +#' @param object An `exponentialmodelmoments` object. +#' @returns The `W` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getW(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getW", "exponentialmodelmoments", function(object) { @@ -91,6 +176,23 @@ setMethod( } ) +#' Getter method of `exponentialmodelmoments` class. +#' +#' Returns the `R` slot. +#' +#' @param object An `exponentialmodelmoments` object. +#' @returns The `R` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getR(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getR", "exponentialmodelmoments", function(object) { @@ -103,6 +205,17 @@ setMethod( ### Private functions ### These functions are not exported +#' Generate model moments for an exponential mixture +#' +#' @description +#' Only called implicitly. generates all moments of an exponential mixture +#' distribution. +#' +#' @param object An `exponentialmodelmoments` object to contain all calculated +#' moments. +#' @returns An `exponentialmodelmoments` object containing all moments of the +#' exponential mixture distributions. +#' @noRd ".generateMomentsExponential" <- function(object) { lambda <- object@model@par$lambda weight <- object@model@weight diff --git a/R/fdata.R b/R/fdata.R index caca1fc..848c674 100644 --- a/R/fdata.R +++ b/R/fdata.R @@ -15,6 +15,31 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix fdata class +#' +#' The [fdata] class holds the data for finite mixture distributions. +#' +#' @slot y A matrix containing the observations for finite mixture estimation. +#' Can be by column or row depending on the slot `bycolumn`. +#' @slot N An integer holding the number of observations. +#' @slot r An integer defining the dimension of the data. Only for multivariate +#' distributions like `normult` or `studmult` the dimension is +#' larger one. +#' @slot S A matrix containing the indicators of the data. If the `fdata` class +#' contains indicators estimation is performed with a fixed indicator +#' approach. +#' @slot bycolumn A logical indicating if the data in `y` and `S` is sorted by +#' by column (`TRUE`) or row (`FALSE`). +#' @slot name A character specifying a name for the data. Optional. +#' @slot type A character specifying the data type: either `discrete` for +#' discrete data or `continuous` for continuous data. The two data types are +#' treated differently when calculating data moments. +#' @slot sim A logical indicating, if the data was simulated. +#' @slot exp A matrix containing the *exposures* of Poisson data. +#' @slot T A matrix containing the (optional) repetitions of binomial or Poisson +#' data. Must be of type integer. +#' @exportClass fdata +#' @name fdata_class .fdata <- setClass("fdata", representation( y = "matrix", @@ -48,6 +73,42 @@ ) ## Constructor for the data class ## +#' Constructs an `fdata` object +#' +#' @description +#' Calling [fdata()] constructs an `fdata` object. Can be called without +#' arguments. +#' +#' @param y A matrix containing the observations for finite mixture estimation. +#' Can be by column or row depending on the slot `bycolumn`. +#' @param N An integer holding the number of observations. +#' @param r An integer defining the dimension of the data. Only for multivariate +#' distributions like `normult` or `studmult` the dimension is +#' larger one. +#' @param S A matrix containing the indicators of the data. If the `fdata` class +#' contains indicators estimation is performed with a fixed indicator +#' approach. +#' @param bycolumn A logical indicating if the data in `y` and `S` is sorted by +#' by column (`TRUE`) or row (`FALSE`). +#' @param name A character specifying a name for the data. Optional. +#' @param type A character specifying the data type: either `discrete` for +#' discrete data or `continuous` for continuous data. The two data types are +#' treated differently when calculating data moments. +#' @param sim A logical indicating, if the data was simulated. +#' @param exp A matrix containing the *exposures* of Poisson data. +#' @param T A matrix containing the (optional) repetitions of binomial or Poisson +#' data. Must be of type integer. +#' @export +#' +#' @examples +#' # Call the constructor without arguments. +#' f_data <- fdata() +#' +#' # Create simulated data. +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' +#' @seealso [fdata] class that describes the slots and the getters, setters and +#' and checkers "fdata" <- function(y = matrix(), N = 1, r = 1, S = matrix(), bycolumn = TRUE, name = character(), type = "discrete", sim = FALSE, @@ -91,6 +152,27 @@ ) } +#' Plots the data +#' +#' @description +#' [plot()] plots the data in an [fdata] object by either a histogram in case of +#' continuous data or a barplot in case of discrete data. +#' +#' @param x An `fdata` object. Cannot be empty. +#' @param y Unused. +#' @param dev A logical indicating if the plot should be output via a graphical +#' device. +#' @param ... Further arguments passed to the plotting functions `hist` or +#' `barplot`. +#' @exportMethod plot +#' @describeIn fdata_class +#' +#' @examples +#' # Generate Poisson data and plot it. +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' plot(f_data) +#' +#' @seealso [fdata] class setMethod( "plot", signature( x = "fdata", @@ -109,6 +191,23 @@ setMethod( } ) +#' Shows a summary of an `fdata` object. +#' +#' Calling [show()] on an `fdata` object gives an overview of the different +#' slots and dimensions. +#' +#' @param object An `fdata` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn fdata_class +#' +#' @examples +#' # Generate some Poisson data and show the `fdata` object +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' show(f_data) +#' +#' @seealso [fdata] class for an overview of the slots setMethod( "show", "fdata", function(object) { @@ -152,6 +251,25 @@ setMethod( ### TRUE if it is not NA and FALSE if it is NA. ### If argument 'verbose' is set to TRUE, an error is thrown, if ### the 'fdata' object has not the questioned slot filled. +#' Checker method for `y` slot of an `fdata` object. +#' +#' @description +#' [hasY()] checks, if the object contains `y` data. +#' +#' @param object An `fdata` object. +#' @param verbose A logical indicating, if the function should print out +#' messages. +#' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `y` slot is +#' empty or filled or a message, if `verbose` is `TRUE`. +#' @exportMethod hasY +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' hasY(f_data) +#' +#' @seealso [fdata] class for an overview of its slots setMethod( "hasY", "fdata", function(object, verbose = FALSE) { @@ -170,6 +288,24 @@ setMethod( } ) +#' Checker method for `S` slot of an `fdata` object. +#' +#' @description +#' [hasY()] checks, if the object contains `S` data. +#' +#' @param object An `fdata` object. +#' @param verbose A logical indicating, if the function should print out +#' messages. +#' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `S` slot is +#' empty or filled or a message, if `verbose` is `TRUE`. +#' @describeIn fdata_class +#' @exportMethod hasS +#' @examples +#' # Generate an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' hasS(f_data) +#' +#' @seealso [fdata] class for an overview of its slots setMethod( "hasS", "fdata", function(object, verbose = FALSE) { @@ -188,6 +324,25 @@ setMethod( } ) +#' Checker method for `exp` slot of an `fdata` object. +#' +#' @description +#' [hasY()] checks, if the object contains `exp` data. +#' +#' @param object An `fdata` object. +#' @param verbose A logical indicating, if the function should print out +#' messages. +#' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `exp` slot is +#' empty or filled or a message, if `verbose` is `TRUE`. +#' @exportMethod hasExp +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' hasExp(f_data) +#' +#' @seealso [fdata] class for an overview of its slots setMethod( "hasExp", "fdata", function(object, verbose = FALSE) { @@ -206,6 +361,25 @@ setMethod( } ) +#' Checker method for `T` slot of an `fdata` object. +#' +#' @description +#' [hasY()] checks, if the object contains `T` data. +#' +#' @param object An `fdata` object. +#' @param verbose A logical indicating, if the function should print out +#' messages. +#' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `T` slot is +#' empty or filled or a message, if `verbose` is `TRUE`. +#' @exportMethod hasT +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' hasT(f_data) +#' +#' @seealso [fdata] class for an overview of its slots setMethod( "hasT", "fdata", function(object, verbose = FALSE) { @@ -225,7 +399,22 @@ setMethod( ) ### getCol/getRow: These methods return the data in the slots @y, -### @S, @exp and @T either as column-ordered or ro-ordered matrix. +### @S, @exp and @T either as column-ordered or row-ordered matrix. +#' Getter method of `fdata` class. +#' +#' Returns the `y` slot as a column-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `y` slot of the `object` as a column-ordered matrix. +#' @exportMethod getColY +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getColY(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getColY", "fdata", function(object) { @@ -237,6 +426,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `y` slot as a row-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `y` slot of the `object` as a row-ordered matrix. +#' @exportMethod getRowY +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getRowY(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getRowY", "fdata", function(object) { @@ -248,6 +452,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `S` slot as a column-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `S` slot of the `object` as a column-ordered matrix. +#' @exportMethod getColS +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getColS(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getColS", "fdata", function(object) { @@ -259,6 +478,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `S` slot as a row-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `S` slot of the `object` as a row-ordered matrix. +#' @exportMethod getRowS +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getRowS(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getRowS", "fdata", function(object) { @@ -270,6 +504,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `exp` slot as a column-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `exp` slot of the `object` as a column-ordered matrix. +#' @exportMethod getColExp +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getColExp(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getColExp", "fdata", function(object) { @@ -281,6 +530,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `exp` slot as a row-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `exp` slot of the `object` as a row-ordered matrix. +#' @exportMethod getRowExp +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getRowExp(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getRowExp", "fdata", function(object) { @@ -292,6 +556,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `T` slot as a column-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `T` slot of the `object` as a column-ordered matrix. +#' @exportMethod getColT +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getColT(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getColT", "fdata", function(object) { @@ -303,6 +582,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `T` slot as a row-ordered matrix. +#' +#' @param object An `fdata` object. +#' @returns The `T` slot of the `object` as a row-ordered matrix. +#' @exportMethod getRowT +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getRowT(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getRowT", "fdata", function(object) { @@ -316,6 +610,21 @@ setMethod( ## Setters and Getters as a user interface to manipulate the slots ## Combined Getter and Setter +#' Getter method of `fdata` class. +#' +#' Returns the `y` slot in the order defined by the slot `bycolumn`. +#' +#' @param object An `fdata` object. +#' @returns The `y` slot of the `object` in the order defined `bycolumn`. +#' @exportMethod getY +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getY(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getY", "fdata", function(object) { @@ -323,6 +632,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `N` slot of an `fdata` object. +#' +#' @param object An `fdata` object. +#' @returns The `N` slot of the `object`. +#' @exportMethod getN +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getN(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getN", "fdata", function(object) { @@ -330,6 +654,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `r` slot of an `fdata` object. +#' +#' @param object An `fdata` object. +#' @returns The `r` slot of the `object`. +#' @exportMethod getR +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getR(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getR", "fdata", function(object) { @@ -337,6 +676,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `S` slot in the order defined by the slot `bycolumn`. +#' +#' @param object An `fdata` object. +#' @returns The `S` slot of the `object` in the order defined `bycolumn`. +#' @exportMethod getS +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getS(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getS", "fdata", function(object) { @@ -344,6 +698,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `bycolumn` slot of an `fdata` object. +#' +#' @param object An `fdata` object. +#' @returns The `bycolumn` slot of the `object`. +#' @exportMethod getBycolumn +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getBycolumn(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getBycolumn", "fdata", function(object) { @@ -351,6 +720,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `name` slot of an `fdata` object. +#' +#' @param object An `fdata` object. +#' @returns The `name` slot of the `object`. +#' @exportMethod getName +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getName(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getName", "fdata", function(object) { @@ -358,6 +742,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `type` slot of an `fdata` object. +#' +#' @param object An `fdata` object. +#' @returns The `type` slot of the `object`. +#' @exportMethod getType +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getType(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getType", "fdata", function(object) { @@ -365,6 +764,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `sim` slot of an `fdata` object. +#' +#' @param object An `fdata` object. +#' @returns The `sim` slot of the `object`. +#' @exportMethod getSim +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getSim(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getSim", "fdata", function(object) { @@ -372,6 +786,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `exp` slot in the order defined by the slot `bycolumn`. +#' +#' @param object An `fdata` object. +#' @returns The `exp` slot of the `object` in the order defined `bycolumn`. +#' @exportMethod getExp +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getExp(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getExp", "fdata", function(object) { @@ -379,6 +808,21 @@ setMethod( } ) +#' Getter method of `fdata` class. +#' +#' Returns the `T` slot in the order defined by the slot `bycolumn`. +#' +#' @param object An `fdata` object. +#' @returns The `T` slot of the `object` in the order defined `bycolumn`. +#' @exportMethod getT +#' @describeIn fdata_class +#' +#' @examples +#' # Create an fdata object with Poisson data +#' f_data <- fdata(y = rpois(100, 312), sim = TRUE) +#' getT(f_data) +#' +#' @seealso [fdata] for all slots of the `fdata` class setMethod( "getT", "fdata", function(object) { @@ -387,6 +831,24 @@ setMethod( ) ## Setters ## +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `y` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `y` should be set. +#' @param value A matrix that should be set as `y` slot of the `fdata` object. +#' @returns The `fdata` object with slot `y` set to `value` or an error message +#' if the `value` cannot be set as slot `y`. +#' @exportMethod setY<- +#' @describeIn fdata_class +#' +#' @examples +#' f_data <- fdata() +#' setY(f_data) <- rpois(100, 312) +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setY", "fdata", function(object, value) { @@ -409,15 +871,51 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `N` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `N` should be set. +#' @param value An integer that should be set as `N` slot of the `fdata` object. +#' @returns The `fdata` object with slot `N` set to `value` or an error message +#' if the `value` cannot be set as slot `N`. +#' @exportMethod setN<- +#' @describeIn fdata_class +#' +#' @examples +#' f_data <- fdata() +#' setN(f_data) <- as.integer(100) +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setN", "fdata", function(object, value) { object@N <- as.integer(value) - init.valid.Fdata(object) + .init.valid.Fdata(object) return(object) } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `R` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `R` should be set. +#' @param value An integer that should be set as `R` slot of the `fdata` object. +#' @returns The `fdata` object with slot `R` set to `value` or an error message +#' if the `value` cannot be set as slot `R`. +#' @exportMethod setR<- +#' @describeIn fdata_class +#' +#' @examples +#' f_data <- fdata() +#' setR(f_data) <- as.integer(2) +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setR", "fdata", function(object, value) { @@ -427,6 +925,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `S` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `S` should be set. +#' @param value A matrix that should be set as `S` slot of the `fdata` object. +#' Has to be of type integer. +#' @returns The `fdata` object with slot `S` set to `value` or an error message +#' if the `value` cannot be set as slot `S`. +#' @exportMethod setS<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setS(f_data) <- matrix(sample.int(4, 100, replace = TRUE)) +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setS", "fdata", function(object, value) { @@ -441,6 +959,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `bycolumn` of an `fdata` object and validates the slot data +#' before setting. +#' +#' @param object An `fdata` objects, whose slot `bycolumn` should be set. +#' @param value A logical that should be set as `bycolumn` slot of the `fdata` +#' object. +#' @returns The `fdata` object with slot `bycolumn` set to `value` or an error message +#' if the `value` cannot be set as slot `bycolumn`. +#' @exportMethod setBycolumn<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setBycolumn(f_data) <- TRUE +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setBycolumn", "fdata", function(object, value) { @@ -466,6 +1004,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `name` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `name` should be set. +#' @param value A matrix that should be set as `name` slot of the `fdata` object. +#' Has to be of type integer. +#' @returns The `fdata` object with slot `name` set to `value` or an error message +#' if the `value` cannot be set as slot `name`. +#' @exportMethod setName<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setName(f_data) <- "poisson_data" +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setName", "fdata", function(object, value) { @@ -474,6 +1032,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `type` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `type` should be set. +#' @param value A character that should be set as `type` slot of the `fdata` object. +#' Has to be of type integer. +#' @returns The `fdata` object with slot `type` set to `value` or an error message +#' if the `value` cannot be set as slot `type`. +#' @exportMethod setType<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setType(f_data) <- "discrete" +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setType", "fdata", function(object, value) { @@ -483,6 +1061,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `sim` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `sim` should be set. +#' @param value A logical that should be set as `sim` slot of the `fdata` object. +#' Has to be of type integer. +#' @returns The `fdata` object with slot `sim` set to `value` or an error message +#' if the `value` cannot be set as slot `sim`. +#' @exportMethod setSim<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setSim(f_data) <- TRUE +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setSim", "fdata", function(object, value) { @@ -492,6 +1090,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `exp` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `exp` should be set. +#' @param value A matrix that should be set as `exp` slot of the `fdata` object. +#' Has to be of type integer. +#' @returns The `fdata` object with slot `exp` set to `value` or an error message +#' if the `value` cannot be set as slot `exp`. +#' @exportMethod setExp<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setExp(f_data) <- matrix(rep(100, 100)) +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setExp", "fdata", function(object, value) { @@ -507,6 +1125,26 @@ setReplaceMethod( } ) +#' Setter method of `fdata` class +#' +#' @description +#' Sets the slot `T` of an `fdata` object and validates the slot data before +#' setting. +#' +#' @param object An `fdata` objects, whose slot `T` should be set. +#' @param value A matrix that should be set as `T` slot of the `fdata` object. +#' Has to be of type integer. +#' @returns The `fdata` object with slot `T` set to `value` or an error message +#' if the `value` cannot be set as slot `T`. +#' @exportMethod setT<- +#' @describeIn fdata_class +#' +#' @examples +#' # Generate an empty fdata object. +#' f_data <- fdata() +#' setT(f_data) <- matrix(rep(100, 100)) +#' +#' @seealso [fdata] for all slots of the `fdata` class setReplaceMethod( "setT", "fdata", function(object, value) { @@ -528,6 +1166,17 @@ setReplaceMethod( ### Checking. ### Check data: The data @y has to either of type 'integer' ### or of type 'numeric'. +#' Checks validity of slot `y` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setY()] the setter of the slot `y`. ".check.y.Fdata" <- function(y) { if (!all(is.na(y))) { ## Only data of type 'numeric' or @@ -546,6 +1195,17 @@ setReplaceMethod( ### is set to 'discrete', else 'continuous'. ### If @y is NA for all entries, the type is the default: ### 'discrete'. +#' Checks validity of slot `type` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setType()] the setter of the slot `type`. ".check.type.Fdata" <- function(y) { if (!all(is.na(y))) { if (is.integer(y)) { @@ -567,6 +1227,17 @@ setReplaceMethod( ### If the data in @y is empty, it is checked in the same way if ### bycolumn can be derived from @S, @exp or @T. If any data slot is ### emtpy the default is used: TRUE. +#' Checks validity of slot `bycolumn` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setBycolumn()] the setter of the slot `bycolumn`. ".check.bycolumn.Fdata" <- function(y, S, exp, T) { if (!all(is.na(y))) { if (NROW(y) > NCOL(y)) { @@ -607,6 +1278,17 @@ setReplaceMethod( ### set after @bycolumn. So, if @bycolumn is TRUE, the rows are ### assumed to be the number of observations. Otherwise, columns ### of @y are assumed to define @N. +#' Checks validity of slot `N` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setN()] the setter of the slot `N`. ".check.N.Fdata" <- function(y, S, exp, T, bycolumn) { if (!all(is.na(y))) { if (bycolumn) { @@ -647,6 +1329,17 @@ setReplaceMethod( ### after @bycolumn. So, if @bycolum is TRUE, the columns are assumed ### to determine the number of variables. Otherwise, rows of @y are ### assumed to define @r. +#' Checks validity of slot `r` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setR()] the setter of the slot `r`. ".check.r.Fdata" <- function(y, bycolumn) { if (!all(is.na(y))) { if (bycolumn) { @@ -662,6 +1355,17 @@ setReplaceMethod( ### Check S: Indicators must be of type 'integer'. If this is the case ### the indicators are turned into a matrix object with storage mode ### 'integer'. +#' Checks validity of slot `S` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setS()] the setter of the slot `S`. ".check.S.Fdata" <- function(S) { if (!all(is.na(S))) { if (!is.numeric(S)) { @@ -682,6 +1386,17 @@ setReplaceMethod( ### Check T: Repetitions must be of type 'integer'. If this is the case ### the repetitions are turned into a matrix object with storage mode ### 'integer'. +#' Checks validity of slot `T` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setT()] the setter of the slot `T`. ".check.T.Fdata" <- function(T) { if (!all(is.na(T))) { if (!is.numeric(T)) { @@ -699,6 +1414,17 @@ setReplaceMethod( ### Check exp: Exposures must be of of type 'numeric'. If this is ### the case exposures are turned into a matrix. +#' Checks validity of slot `exp` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setY()] the setter of the slot `exp`. ".check.exp.Fdata" <- function(exp) { if (!all(is.na(exp))) { if (!is.numeric(exp)) { @@ -715,6 +1441,17 @@ setReplaceMethod( ### Check bycolumn: @bycolumn has to be of type 'logical'. If this is not ### the case an error is thrown. +#' Checks validity of slot `bycolumn` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setBycolumn()] the setter of the slot `bycolumn`. ".check.setBycolumn.Fdata" <- function(value) { if (!is.logical(value)) { stop(paste("Wrong specification of value for slot 'bycolumn' ", @@ -727,6 +1464,17 @@ setReplaceMethod( ### Check sim: @sim has to be of type 'logical'. If this is not ### the case an error is thrown. +#' Checks validity of slot `sim` +#' +#' @param y An object passed in by the user. +#' @returns None. Checks for validity and if validity is not ensured throws an +#' error. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [setSim()] the setter of the slot `sim`. ".check.setSim.Fdata" <- function(value) { if (!is.logical(value)) { stop(paste("Wrong specification of value for slot 'sim' ", @@ -742,11 +1490,23 @@ setReplaceMethod( ### is implemented. The functions plots a barplot. ### If the data in @y has names given, these names ### are used in the plot. +#' Plots discrete data of an `fdata` object +#' +#' @param obj An `fdata` object. Must contain data. +#' @returns A barplot. +#' +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [plot()] the plot function of the `fdata` class. +#' * [barplot()] the default plotting function for bar plots in R. ".plot.discrete.Fdata" <- function(obj) { - if (has.Y(obj, verbose = TRUE)) { + if (hasY(obj, verbose = TRUE)) { datam <- getColY(obj) } - if (has.Exp(obj)) { + if (hasExp(obj)) { exp <- getColExp(obj) datam <- datam * exp } @@ -778,11 +1538,33 @@ setReplaceMethod( ### returns histograms for all variables in @y and a pairs ### diagram: a matrix containing scatter plots for all ### variables' combinations. +#' Plots discrete data of an `fdata` object +#' +#' @description +#' Continuous data: Either the data is one-dimensional or multi-dimensional. In +#' the one-dimensional case a histogram of the data is plotted. In the +#' two-dimensional case a bivariate kernel density estimation is used to return +#' a contour plot and a perspective plot of the density. In the case of +#' higher-dimensional data, the functions returns histograms for all variables +#' in `@@y` and a pairs diagram: a matrix containing scatter plots for all +#' variables' combinations. +#' +#' @param obj An `fdata` object. Must contain data. +#' @returns A histogram. +#' @importFrom KernSmooth bkde2D +#' @importFrom stats sd +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata()] the constructor of the `fdata` class. +#' * [plot()] the plot function of the `fdata` class. +#' * [hist()] the default plotting function for histogram plots in R. ".plot.continuous.Fdata" <- function(obj, dev) { datam <- getColY(obj) if (obj@r == 1) { .symmetric.Hist(datam, colnames(datam)) - } else if (x@r == 2) { ## 2-dimensional + } else if (obj@r == 2) { ## 2-dimensional .symmetric.Hist(datam, colnames(datam)) if (.check.grDevice() && dev) { dev.new(title = "Contour plot") @@ -858,6 +1640,22 @@ setReplaceMethod( ### the user may define the slots step by step. ### 'fdata()'. To avoid cumbersome behavior of slot setting, ### only warnings are thrown. +#' Checks consistency of `fdata` object +#' +#' @description +#' Checks the consistency of `fdata` object when the constructor or a setter is +#' called. The different slots are strongly related and it has to be checked if +#' the setting of one slot does not interfere with the definition of another +#' one. Is called during initialization of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [fdata()] for the constructor and the conditions for slots. ".init.valid.Fdata" <- function(obj) { .init.valid.y.Fdata(obj) .init.valid.S.Fdata(obj) @@ -872,6 +1670,22 @@ setReplaceMethod( ### errors thrown in case of inconsistency of slots. ### Furthermore, the validity check during initialisation relies on fully ### specified 'fdata' objects and checks consistency of slots strongly. +#' Checks consistency of `fdata` object +#' +#' @description +#' Checks the consistency of `fdata` object when the constructor or a setter is +#' called. The different slots are strongly related and it has to be checked if +#' the setting of one slot does not interfere with the definition of another +#' one. Is called during by setters of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [fdata()] for the constructor and the conditions for slots. ".valid.Fdata" <- function(obj) { .valid.y.Fdata(obj) .valid.S.Fdata(obj) @@ -883,6 +1697,22 @@ setReplaceMethod( ### Valid y: Data in @y must be of type 'integer' or 'numeric'. Further, ### the number of observations @N, the dimension of observations @r ### and the ordering @bycolumn must be group-consistent. +#' Checks consistency of slot `y` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `y` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called during initialization of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [fdata()] for the constructor and the conditions for slots. ".init.valid.y.Fdata" <- function(obj) { if (!all(is.na(obj@y))) { if (!is.numeric(obj@y) && !is.integer(obj@y)) { @@ -925,6 +1755,22 @@ setReplaceMethod( } } +#' Checks consistency of slot `y` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `y` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called from the setter of slot `y` of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [setY()] for the constructor and the conditions for slots. ".valid.y.Fdata" <- function(obj) { if (!all(is.na(obj@y))) { if (!is.numeric(obj@y) && !is.integer(obj@y)) { @@ -973,6 +1819,22 @@ setReplaceMethod( ### @bycolumn. ### Indicators must be positive integers. If any element of @S ### is smaller than one, an error is thrown. +#' Checks consistency of slot `S` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `S` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called during initialization of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [fdata()] for the constructor and the conditions for slots. ".init.valid.S.Fdata" <- function(obj) { if (!all(is.na(obj@S))) { if (!is.integer(obj@S)) { @@ -1026,6 +1888,22 @@ setReplaceMethod( } } +#' Checks consistency of slot `S` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `S` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called from the setter of slot `S` of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [setS()] for the constructor and the conditions for slots. ".valid.S.Fdata" <- function(obj) { if (!all(is.na(obj@S))) { if (!is.integer(obj@S)) { @@ -1083,6 +1961,22 @@ setReplaceMethod( ### Furthermore dimensions must be conform with dimensions of data in @y. ### Exposures can only be one-dimensional and must be positive. If not ### an error is thrown. +#' Checks consistency of slot `exp` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `exp` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called during initialization of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [fdata()] for the constructor and the conditions for slots. ".init.valid.exp.Fdata" <- function(obj) { if (!all(is.na(obj@exp))) { if (!is.numeric(obj@exp) && !is.integer(obj@exp)) { @@ -1135,6 +2029,22 @@ setReplaceMethod( } } +#' Checks consistency of slot `exp` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `exp` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called from the setter of slot `exp` of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [setExp()] for the constructor and the conditions for slots. ".valid.exp.Fdata" <- function(obj) { if (!all(is.na(obj@exp))) { if (!is.numeric(obj@exp)) { @@ -1191,6 +2101,22 @@ setReplaceMethod( ### dimensions of @T must be consistent with @y in regard to the ### ordering in @bycolumn. ### If any element in @T is smaller than one, an error is thrown. +#' Checks consistency of slot `T` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `T` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called during initialization of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [fdata()] for the constructor and the conditions for slots. ".init.valid.T.Fdata" <- function(obj) { if (!all(is.na(obj@T))) { if (!is.integer(obj@T)) { @@ -1243,6 +2169,22 @@ setReplaceMethod( } } +#' Checks consistency of slot `T` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `T` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called from the setter of slot `T` of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [setT()] for the constructor and the conditions for slots. ".valid.T.Fdata" <- function(obj) { if (!all(is.na(obj@T))) { if (!is.integer(obj@T)) { @@ -1298,6 +2240,22 @@ setReplaceMethod( ### Valid type: The description of data type in @type must be either ### 'discrete' or 'continuous' with no exclusion. Any other choice ### throws an error. +#' Checks consistency of slot `type` of an `fdata` object +#' +#' @description +#' Checks the consistency of slot `type` of an `fdata` object when the constructor +#' or a setter is called. The different slots are strongly related and it has to +#' be checked if the setting of one slot does not interfere with the definition +#' of another one. Is called from the setter of slot `type` of an `fdata` object. +#' +#' @param obj An `fdata` object to be checked. +#' @returns None. Throws an error, if a certain condition is not true. +#' @describeIn fdata_class +#' @noRd +#' +#' @seealso +#' * [fdata] for all slots and setters of the `fdata` class. +#' * [setType()] for the constructor and the conditions for slots. ".valid.type.Fdata" <- function(obj) { if (!(obj@type %in% c("discrete", "continuous"))) { stop(paste("Wrong choice for slot 'type'. Data can be only ", diff --git a/R/graphic_func.R b/R/graphic_func.R index 07a2839..8079d2c 100644 --- a/R/graphic_func.R +++ b/R/graphic_func.R @@ -22,6 +22,13 @@ ### This function checks, if an option 'title' for the ### graphical device used by R is available. If the answer ### is TRUE, the title can be set by a 'plot()' function. +#' Checks if graphical device has `title` option +#' +#' @description +#' For internal use only. +#' +#' @returns `TRUE` if `title` option exists. +#' @name graphic_funs ".check.grDevice" <- function() { ## title argument ## any(names(formals(getOption("device"))) @@ -32,6 +39,17 @@ ### This functions checks the dimension of a dataset 'y' ### an distributes histograms for each variable in the ### dataset symmetrically around the graphical grid. +#' Layout historams symmetrically along grid +#' +#' @description +#' For internal use only. +#' +#' @param y A matrix containing data from a finite mixture. Can be univariate +#' or multivariate. +#' @param lab.names A vector of characters describing the axis names. +#' @return A plot containing the histograms of each of `y`'s dimensions. +#' @describeIn graphical_funs +#' @noRd ".symmetric.Hist" <- function(y, lab.names) { r <- NCOL(y) if (r == 1) { @@ -136,6 +154,17 @@ ### This functions checks the dimension of a dataset 'y' ### an distributes Kernel densities for each variable in the ### dataset symmetrically around the graphical grid. +#' Layout density plots symmetrically along grid +#' +#' @description +#' For internal use only. +#' +#' @param y A matrix containing data from a finite mixture. Can be univariate +#' or multivariate. +#' @param lab.names A vector of characters describing the axis names. +#' @return A plot containing the densities of each of `y`'s dimensions. +#' @describeIn graphical_funs +#' @noRd ".symmetric.Dens" <- function(y, lab.names) { r <- NCOL(y) if (r == 1) { @@ -240,6 +269,19 @@ ### This function plots a histogram with 'finmix' specific ### settings. In addition it uses 'rug()' to plot the data ### points. +#' Plots histogram with `finmix`-specific settings +#' +#' @description +#' For internal use only. +#' +#' @param y A matrix containing data from a finite mixture. Only univariate +#' data is allowed. +#' @param lab.name A vector of characters describing the axis names. +#' @return A plot containing the histogram of the data stored in `y` together +#' with rug representation of the data. +#' @describeIn graphical_funs +#' @import graphics +#' @noRd ".comb.Hist" <- function(y, lab.name) { hist(y, col = "gray65", @@ -257,6 +299,19 @@ ### This function plots a Kernel density with 'finmix' specific ### settings. In addition it uses 'rug()' to plot the data ### points. +#' Plots density with `finmix`-specific settings +#' +#' @description +#' For internal use only. +#' +#' @param y A matrix containing data from a finite mixture. Only univariate +#' data is allowed. +#' @param lab.name A vector of characters describing the axis names. +#' @return A plot containing the density of the data stored in `y` together +#' with rug representation of the data. +#' @describeIn graphical_funs +#' @importFrom KernSmooth bkde +#' @noRd ".comb.Dens" <- function(y, lab.name) { dens <- bkde(y) plot(dens$x, dens$y, diff --git a/R/groupmoments.R b/R/groupmoments.R index 6440982..c76a390 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -15,6 +15,29 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `groupmoments` class +#' +#' Stores moments for finite mixture component distributions. These are only +#' available, if the data contains in addition to observations also indicators +#' defining to which component a certain observation belongs. These indicators +#' are stored in an [fdata][fdata_class] object in the slot `S`. +#' +#' @slot NK An array containing the group sizes for each component. +#' @slot mean A matrix containing the group averages for each component. +#' @slot WK An array containing the within-group variability. For multivariate +#' data this is an array of dimension `K x r x r` and for univariate +#' data this is simply an array of dimension `1 x K`. +#' @slot var An array containing the within-group (co)variance. For multivariate +#' data this is an array of dimension `K x r x r` and for univariate +#' data this is simply an array of dimension `1 x K`. +#' @slot fdata An [fdata][fdata_class] object containing the data. +#' @exportClass groupmoments +#' @name groupmoments_class +#' @seealso +#' * [groupmoments()] for the class constructor +#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments()] for the constructor of any object of the `datamoments` +#' class family .groupmoments <- setClass("groupmoments", representation( NK = "array", @@ -36,6 +59,36 @@ ) ) +#' Finmix `groupmoments` class constructor +#' +#' @description +#' Calling [groupmoments()] creates an object holding various +#' component-specific moments. These moments can only constructed if the +#' [fdata][fdata_class] object contains in addition to observations also +#' indicators defining from which component a certain observation stems. +#' +#' @param value An `fdata` object containing observations in slot `y` and +#' indicators in slot `S`. +#' @return A `groupmoments` object containing component-specific moments of the +#' `fdata` object. +#' @export +#' @name groupmoments +#' +#' @example +#' # Define a mixture model with exponential components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Create group moments of the data. +#' groupmoments(f_data) +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' class +#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments()] for the constructor of any object of the `datamoments` +#' class family "groupmoments" <- function(value = fdata()) { hasY(value, verbose = TRUE) hasS(value, verbose = TRUE) @@ -44,6 +97,23 @@ ## initializes by immediately calling method ## ## 'generateMoments' ## +#' Initializer of the `groupmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' object. to generate in the initialization step the moments for a passed-in +#' `fdata` object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix [fdata][fdata_class] object containing the observations. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "groupmoments", function(.Object, ..., value) { @@ -52,6 +122,15 @@ setMethod( } ) +#' Generate moments +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of a +#' finite mixture with continuous data. +#' +#' @param object A `groupmoments` object. +#' @return An `groupmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "groupmoments", function(object) { @@ -60,6 +139,16 @@ setMethod( ) ## R usual 'show' function ## +#' Shows a summary of a `groupmoments` object. +#' +#' Calling [show()] on a `groupmoments` object gives an overview +#' of the moments of a finit mixture with continuous data. +#' +#' @param object A `groupmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn groupmoments_class setMethod( "show", "groupmoments", function(object) { @@ -88,6 +177,28 @@ setMethod( ) ## R usual Getters ## +#' Getter method of `groupmoments` class. +#' +#' Returns the `NK` slot. +#' +#' @param object An `groupmoments` object. +#' @returns The `NK` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_gmoments <- groupmoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getNK(f_gmoments) +#' +#' @seealso +#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' class +#' * [groupmoments()] for the class constructor setMethod( "getNK", "groupmoments", function(object) { @@ -95,6 +206,28 @@ setMethod( } ) +#' Getter method of `groupmoments` class. +#' +#' Returns the `mean` slot. +#' +#' @param object An `groupmoments` object. +#' @returns The `mean` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_gmoments <- groupmoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getMean(f_gmoments) +#' +#' @seealso +#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' class +#' * [groupmoments()] for the class constructor setMethod( "getMean", "groupmoments", function(object) { @@ -102,6 +235,28 @@ setMethod( } ) +#' Getter method of `groupmoments` class. +#' +#' Returns the `WK` slot. +#' +#' @param object An `groupmoments` object. +#' @returns The `WK` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_gmoments <- groupmoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getWK(f_gmoments) +#' +#' @seealso +#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' class +#' * [groupmoments()] for the class constructor setMethod( "getWK", "groupmoments", function(object) { @@ -109,6 +264,28 @@ setMethod( } ) +#' Getter method of `groupmoments` class. +#' +#' Returns the `Var` slot. +#' +#' @param object An `groupmoments` object. +#' @returns The `Var` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_gmoments <- groupmoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getVar(f_gmoments) +#' +#' @seealso +#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' class +#' * [groupmoments()] for the class constructor setMethod( "getVar", "groupmoments", function(object) { @@ -127,6 +304,17 @@ setMethod( ### Private functions ### These functions are not exported +#' Generate data moments for finite mixture data +#' +#' @description +#' Only called implicitly. generates all moments of finite mixture data in a +#' `fdata` object. +#' +#' @param object A `groupmoments` object to contain all calculated +#' moments. +#' @returns A `groupmoments` object containing all moments of the +#' finite mixture data. +#' @noRd ".generateGroupMoments" <- function(object) { if (!hasS(object@fdata)) { return(object) diff --git a/R/likelihood.R b/R/likelihood.R index 558dd40..93c6620 100644 --- a/R/likelihood.R +++ b/R/likelihood.R @@ -15,6 +15,26 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Computes the log-likelihood for normal mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param mu A vector containing the means of the normal mixture components. +#' @param sigma A vector containing the standard deviations of the normal +#' mixture components. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.normal" <- function(y, mu, sigma) { N <- nrow(y) K <- ncol(mu) @@ -36,6 +56,28 @@ return(result) } +#' Computes the log-likelihood for student mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param mu A vector containing the means of the student mixture components. +#' @param sigma A vector containing the standard deviations of the student +#' mixture components. +#' @param df A vector containing the degrees of freedom of the student mixture +#' components. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.student" <- function(y, mu, sigma, df) { N <- nrow(y) K <- ncol(mu) @@ -60,6 +102,25 @@ return(result) } +#' Computes the log-likelihood for exponential mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param lambda A vector containing the rates of the exponential mixture +#' components. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.exponential" <- function(y, lambda) { N <- nrow(y) K <- ncol(lambda) @@ -77,6 +138,25 @@ return(result) } +#' Computes the log-likelihood for Poisson mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param lambda A vector containing the rates of the Poisson mixture +#' components. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.poisson" <- function(y, lambda) { N <- nrow(y) K <- ncol(lambda) @@ -99,6 +179,25 @@ return(result) } +#' Computes the log-likelihood for Binomial mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param lambda A vector containing the probabilities of the Binomial mixture +#' components. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.binomial" <- function(y, T, p) { N <- nrow(y) K <- length(p) @@ -118,6 +217,29 @@ return(result) } +#' Computes the log-likelihood for multivariate normal mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param mu A matrix containing the means for each mixture component. Of +#' dimension `rxK` +#' @param sigmainv An array containing the inverse variance-covariance matrices +#' for each mixture component. Of dimension `rxrxK`. +#' @param logdet A vector containing the logarithmized determinants of the +#' variance-covariance matrices for each component. Of dimension `1xK`. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.normult" <- function(y, mu, sigmainv, logdet) { N <- nrow(y) r <- ncol(y) @@ -137,6 +259,29 @@ return(results) } +#' Computes the log-likelihood for multivariate Student-t mixture components +#' +#' @description +#' For internal usage only. This function calculates the likelihood of each +#' mixture component for the data. In addition the maximum likelihood along all +#' mixture components and the log-likelihood is calculated. +#' +#' @param y A matrix containing the data. Of dimension `Nx1` for +#' univariate models and `Nxr` for multivariate models. +#' @param mu A matrix containing the means for each mixture component. Of +#' dimension `rxK` +#' @param sigmainv An array containing the inverse variance-covariance matrices +#' for each mixture component. Of dimension `rxrxK`. +#' @param logdet A vector containing the logarithmized determinants of the +#' variance-covariance matrices for each component. Of dimension `1xK`. +#' @return A list containing the likelihood, the maximum likelihood and the +#' log-likelihood. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.studmult" <- function(y, mu, sigmainv, logdet, df) { N <- nrow(y) K <- ncol(mu) diff --git a/R/mcmc.R b/R/mcmc.R index 323f5f8..9a72c84 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -14,7 +14,36 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `mcmc` class +#' +#' @description +#' This class defines hyper-parameters for the MCMC procedure. This is a main +#' class of the `finmix` package that must be defined for estimating a finite +#' mixture model. +#' +#' @slot burnin An integer defining the number of steps in the burn-in phase of +#' Gibbs-sampling. +#' @slot M An integer defining the number of steps in Gibbs-sampling to be +#' stored. +#' @slot startpar A logical indicating, if starting by sampling the +#' parameters. If `FALSE` sampling starts by sampling the indicators `S`. +#' @slot storeS An integer specifying how many of the last sampled indicators +#' should be stored in the output. +#' @slot storepost A logical indicating if the posterior probabilities should +#' be stored. This becomes for example important for specific relabeling +#' algorithms, but also for analysis. +#' @slot ranperm A logical indicating, if random permutation should be used. If +#' `TRUE` the parameters are permutated randomly between the number of +#' components after each sampling step in MCMC. +#' @slot storeinv A logical indicating if the inverse variance-covariance +#' matrices for multivariate normal or Student-t mixtures should be stored. +#' @exportClass mcmc +#' @name mcmc_class +#' +#' @seealso +#' * [mcmc()] for the class constructor +#' * [mcmcstart()] for completion of slots +#' * [mixturemcmc()] for further information about the MCMC sampling .mcmc <- setClass("mcmc", representation( burnin = "integer", @@ -41,6 +70,42 @@ ) ) +#' Constructor for `mcmc` class +#' +#' @description +#' Calling [mcmc()] constructs an object of class `mcmc` that specifies the +#' hyper-parameters for the MCMC procedure. Each MCMC sampling needs an `mcmc` +#' object that specifies the way, how MCMC sampling should be performed and +#' what kind and how much of data should be stored. +#' +#' @param burnin An integer defining the number of steps in the burn-in phase of +#' Gibbs-sampling. +#' @param M An integer defining the number of steps in Gibbs-sampling to be +#' stored. +#' @param startpar A logical indicating, if starting by sampling the +#' parameters. If `FALSE` sampling starts by sampling the indicators `S`. +#' @param storeS An integer specifying how many of the last sampled indicators +#' should be stored in the output. +#' @param storepost A logical indicating if the posterior probabilities should +#' be stored. This becomes for example important for specific relabeling +#' algorithms, but also for analysis. +#' @param ranperm A logical indicating, if random permutation should be used. If +#' `TRUE` the parameters are permutated randomly between the number of +#' components after each sampling step in MCMC. +#' @param storeinv A logical indicating if the inverse variance-covariance +#' matrices for multivariate normal or Student-t mixtures should be stored. +#' @return An object of class `mcmc` containing all hyper-parameters for MCMC +#' sampling. +#' @export +#' @name mcmc +#' +#' @examples +#' f_mcmc <- mcmc() +#' +#' @seealso +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmcstart()] for setting up all objects for MCMC sampling +#' * [mixturemcmc()] for running MCMC sampling for finite mixture models "mcmc" <- function(burnin = 0, M = 5000, startpar = TRUE, storeS = 1000, storepost = TRUE, ranperm = TRUE, @@ -53,6 +118,16 @@ ) } +#' Shows a summary of an `mcmc` object. +#' +#' Calling [show()] on an `mcmc` object gives an overview +#' of the `mcmc` object. +#' +#' @param object A `mcmc` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmc_class setMethod( "show", "mcmc", function(object) { @@ -69,6 +144,23 @@ setMethod( ) ## Getters ## +#' Getter method of `mcmc` class. +#' +#' Returns the `burnin` slot. +#' +#' @param object An `mcmc` object. +#' @returns The `burnin` slot of the `object`. +#' @noRd +#' @export +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Get the slot +#' getBurnin(f_mcmc) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getBurnin", "mcmc", function(object) { @@ -76,6 +168,23 @@ setMethod( } ) +#' Getter method of `mcmc` class. +#' +#' Returns the `M` slot. +#' +#' @param object An `mcmc` object. +#' @returns The `M` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Get the slot +#' getM(f_mcmc) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getM", "mcmc", function(object) { @@ -83,6 +192,23 @@ setMethod( } ) +#' Getter method of `mcmc` class. +#' +#' Returns the `startpar` slot. +#' +#' @param object An `mcmc` object. +#' @returns The `startpar` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Get the slot +#' getStartpar(f_mcmc) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getStartpar", "mcmc", function(object) { @@ -90,6 +216,23 @@ setMethod( } ) +#' Getter method of `mcmc` class. +#' +#' Returns the `storeS` slot. +#' +#' @param object An `mcmc` object. +#' @returns The `storeS` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Get the slot +#' getStoreS(f_mcmc) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getStoreS", "mcmc", function(object) { @@ -97,6 +240,23 @@ setMethod( } ) +#' Getter method of `mcmc` class. +#' +#' Returns the `storepost` slot. +#' +#' @param object An `mcmc` object. +#' @returns The `storepost` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Get the slot +#' getStorepost(f_mcmc) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getStorepost", "mcmc", function(object) { @@ -104,6 +264,23 @@ setMethod( } ) +#' Getter method of `mcmc` class. +#' +#' Returns the `ranperm` slot. +#' +#' @param object An `mcmc` object. +#' @returns The `ranperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Get the slot +#' getRanperm(f_mcmc) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getRanperm", "mcmc", function(object) { @@ -112,6 +289,24 @@ setMethod( ) ## Setters ## +#' Setter method of `mcmc` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `mcmc` object. +#' @param value An integer defining the new value for the `@@burnin` slot. +#' @returns None. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Set the slot +#' setBurnin(f_mcmc) <- as.integer(2000) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setBurnin", "mcmc", function(object, value) { @@ -121,6 +316,24 @@ setReplaceMethod( } ) +#' Setter method of `mcmc` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `mcmc` object. +#' @param value An integer defining the new value for the `@@M` slot. +#' @returns None. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Set the slot +#' setM(f_mcmc) <- as.integer(20000) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setM", "mcmc", function(object, value) { @@ -130,6 +343,24 @@ setReplaceMethod( } ) +#' Setter method of `mcmc` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `mcmc` object. +#' @param value An integer defining the new value for the `@@startpar` slot. +#' @returns None. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Set the slot +#' setStartpar(f_mcmc) <- FALSE +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setStartpar", "mcmc", function(object, value) { @@ -139,6 +370,24 @@ setReplaceMethod( } ) +#' Setter method of `mcmc` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `mcmc` object. +#' @param value An integer defining the new value for the `@@storeS` slot. +#' @returns None. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Set the slot +#' setStoreS(f_mcmc) <- as.integer(500) +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setStoreS", "mcmc", function(object, value) { @@ -148,6 +397,25 @@ setReplaceMethod( } ) +#' Setter method of `mcmc` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `mcmc` object. +#' @param value An integer defining the new value for the `@@storepost` slot. +#' @returns None. +#' @exportMethod setStorepost<- +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Set the slot +#' setStorepost(f_mcmc) <- FALSE +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setStorepost", "mcmc", function(object, value) { @@ -157,6 +425,24 @@ setReplaceMethod( } ) +#' Setter method of `mcmc` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `mcmc` object. +#' @param value An integer defining the new value for the `@@ranperm` slot. +#' @returns None. +#' @noRd +#' +#' @examples +#' # Generate an mcmc object +#' f_mcmc <- mcmc() +#' # Set the slot +#' setRanperm(f_mcmc) <- FALSE +#' +#' @seealso +#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setRanperm", "mcmc", function(object, value) { @@ -172,6 +458,19 @@ setReplaceMethod( ### Valid mcmc: The number of burnins @burnin and the number of ### last indicator vectors to store @storeS must be non-negative ### 'integers'. The number of MCMC draws @M must be a positive 'integer'. +#' Check validity of an `mcmc` object +#' +#' @description +#' For internal usage only. This function checks if the different slots of the +#' `mcmc` object are valid. It checks if slots `@@burnin`, `@@M`, and +#' `@@storeS` are set to non-negative values and if slot `@@storeS` does not +#' call for more indicators to store than iterations in the MCMC sampling. +#' +#' @param object An `mcmc` object to be checked. +#' @return None. If checks do not pass an error is thrown. +#' @noRd +#' @seealso +#' * [mcmc()] for the calling function ".valid.MCMC" <- function(object) { if (object@burnin < as.integer(0)) { stop(paste("Number of Burn-In draws in slot 'burnin' must be ", diff --git a/R/mcmcestfix.R b/R/mcmcestfix.R index 6106d89..e2d0089 100644 --- a/R/mcmcestfix.R +++ b/R/mcmcestfix.R @@ -15,6 +15,47 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcestfix` class +#' +#' @description +#' This class stores the point estimators for component parameters and weights +#' as well as corresponding information from MCMC sampling. Three point +#' estimators are calculated: the maximum a posterior (MAP), the Bayesian +#' maximum likelihood (BML) and the Identified ergodic average (IEAVG). See +#' Fr\"uhwirth-Schnatter (2006) for detailed information about how these +#' estimators are defined. +#' +#' @slot dist A character specifying the distribution family of the mixture +#' model used in MCMC sampling. +#' @slot K An integer specifying the number of components in the mixture model. +#' @slot indicmod A character specifying the indicator model. At this moment +#' only a multinomial model can be chosen. +#' @slot burnin An integer specifying the number of iterations in the burn-in +#' phase of MCMC sampling. +#' @slot M An integer specifying the number of iterations to store in MCMC +#' sampling. +#' @slot ranperm A logical specifying, if random permutation has been used +#' during MCMC sampling. +#' @slot relabel A character specifying the re-labeling algorithm used during +#' parameter estimation for the identified ergodic average. +#' @slot map A named list containing the parameter estimates of the MAP. The +#' element `par` is a named list and contains the component parameters and +#' the element `weight` contains the weights. +#' @slot bml A named list containing the parameter estimates of the BML. The +#' element `par` is a named list and contains the component parameters and +#' the element `weight` contains the weights. +#' @slot A named list containing the parameter estimates of the IEAVG. The +#' element `par` is a named list and contains the component parameters and +#' the element `weight` contains the weights. +#' @slot sdpost A named list containing the standard deviations of the +#' parameter estimates from the posterior distributions. +#' @exportClass mcmcestfix +#' @name mcmcest_class +#' +#' @seealso +#' * [mcmcestind][mcmcest_class] for the equivalent class for models with +#' unknown indicators +#' * [mcmcestimate()] to calculate point estimates .mcmcestfix <- setClass("mcmcestfix", representation( dist = "character", @@ -48,6 +89,16 @@ ) ) +#' Shows a summary of an `mcmcestfix` object. +#' +#' Calling [show()] on an `mcmcestfix` object gives an overview +#' of the `mcmcestfix` object. +#' +#' @param object An `mcmcestfix` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcest_class setMethod( "show", "mcmcestfix", function(object) { @@ -81,6 +132,19 @@ setMethod( } ) +#' Shows an advanced summary of an `mcmcestfix` object. +#' +#' Calling [show()] on an `mcmcestfix` object gives an advanced overview +#' of the `mcmcestfix` object. +#' +#' Note, this method is so far only implemented for mixtures of Poisson +#' distributions. +#' +#' @param object An `mcmcestfix` object. +#' @returns A console output listing the formatted slots and summary +#' information about each of them. +#' @exportMethod Summary +#' @describeIn mcmcest_class setMethod( "Summary", "mcmcestfix", function(x, ..., na.rm = FALSE) { @@ -136,6 +200,34 @@ setMethod( ) ## Getters ## +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `dist` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `dist` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getDist(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getDist", "mcmcestfix", function(object) { @@ -143,6 +235,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `K` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `K` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getK(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getK", "mcmcestfix", function(object) { @@ -150,6 +270,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `indicmod` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `indicmod` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getIndicmod(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getIndicmod", "mcmcestfix", function(object) { @@ -157,6 +305,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `burnin` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `burnin` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getBurnin(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getBurnin", "mcmcestfix", function(object) { @@ -164,6 +340,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `M` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `M` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getM(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getM", "mcmcestfix", function(object) { @@ -171,6 +375,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `ranperm` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `ranperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getRanperm(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getRanperm", "mcmcestfix", function(object) { @@ -178,6 +410,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `relabel` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `relabel` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getRelabel(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getRelabel", "mcmcestfix", function(object) { @@ -185,6 +445,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `map` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `map` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getMap(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getMap", "mcmcestfix", function(object) { @@ -192,6 +480,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `bml` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `bml` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getBml(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getBml", "mcmcestfix", function(object) { @@ -199,6 +515,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `ieavg` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `ieavg` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getIeavg(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getIeavg", "mcmcestfix", function(object) { @@ -206,6 +550,34 @@ setMethod( } ) +#' Getter method of `mcmcestfix` class. +#' +#' Returns the `ieavg` slot. +#' +#' @param object An `mcmcestfix` object. +#' @returns The `ieavg` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getIeavg(f_output) +#' +#' @seealso +#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' with unknown indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getSdpost", "mcmcestfix", function(object) { @@ -220,16 +592,42 @@ setMethod( ### These functions are not exported. ### Summary -### Summary Map estimates: Creates a matrix with Map -### estimates. + +#' Summarize MAP estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' MAP estimates. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the MAP. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.map.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .pars.map.poisson.Mcmcestfix(obj) } } -### Summary Map estimates Poisson: Creates a matrix -### with Map estimates for Poisson parameters. +#' Summarize MAP estimates form Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' MAP estimates of Poisson mixture models. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the MAP. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.map.poisson.Mcmcestfix" <- function(obj) { parout <- matrix(0, nrow = obj@K, ncol = 2) for (k in seq(1, obj@K)) { @@ -239,16 +637,41 @@ setMethod( return(parout) } -### Summary Bml estimates: Creates a matrix with Bml -### estimates. +#' Summarize BML estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' BML estimates. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the BML. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.bml.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .pars.bml.poisson.Mcmcestfix(obj) } } -### Summary Bml estimates Poisson: Creates a matrix -### with Bml estimates for Poisson parameters. +#' Summarize BML estimates for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' BML estimates. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the BML. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.bml.poisson.Mcmcestfix" <- function(obj) { parout <- matrix(0, nrow = obj@K, ncol = 2) for (k in seq(1, obj@K)) { @@ -258,16 +681,41 @@ setMethod( return(parout) } -### Summary Ieavg estimates: Creates a matrix with Ieavg -### estimates. +#' Summarize IEAVG estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' IEAVG estimates. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the IEAVG. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.ieavg.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .pars.ieavg.poisson.Mcmcestfix(obj) } } -### Summary Bml estimates Poisson: Creates a matrix -### with Bml estimates for Poisson parameters. +#' Summarize IEAVG estimates for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' IEAVG estimates. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the IEAVG. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.ieavg.poisson.Mcmcestfix" <- function(obj) { parout <- matrix(0, nrow = obj@K, ncol = 2) for (k in seq(1, obj@K)) { @@ -277,15 +725,40 @@ setMethod( return(parout) } -### Summary rownames: Creates rownames for the summary. +#' Create summary row names +#' +#' @description +#' For internal usage only. This function generates row names for the explicit +#' summaries. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A vector with the row names for the advanced summary. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".rownames.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .rownames.poisson.Mcmcestfix(obj) } } -### Summary rownames Poisson: Creates the row names -### for the summary of Poisson estimates. +#' Create summary row names for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates row names for the explicit +#' summaries. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A vector with the row names for the advanced summary over estimates +#' for a Poisson mixture model. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".rownames.poisson.Mcmcestfix" <- function(obj) { rnames <- rep("", obj@K) for (k in seq(1, obj@K)) { @@ -294,11 +767,25 @@ setMethod( return(rnames) } -### Summary parameter names: Creates parameter -### names for the components. +#' Create parameter names for components +#' +#' @description +#' For internal usage only. This function generates parameter names to be used +#' in the advanced summary. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestfix` object containing the parameter estimates. +#' @return A vector with the names of the component parameters to be used in +#' the advanced summary. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".parnames.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { parnames <- c("lambda") } return(parnames) -} +} \ No newline at end of file diff --git a/R/mcmcestimate.R b/R/mcmcestimate.R index 37853c9..aedcb41 100644 --- a/R/mcmcestimate.R +++ b/R/mcmcestimate.R @@ -15,6 +15,53 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Calculate point estimators from MCMC samples +#' +#' @description +#' Calling [mcmcestimate()] calculates the following point estimates from the +#' MCMC samples: +#' * MAP: The maximum a posterior estimates are defined as the mode of the +#' (joint) posterior density. +#' * BML: The Bayesian maximum likelihood estimator is based on the mixture +#' log-likelihood function and defines the mode of this function. +#' * EAVG: The ergodic average is calculated as an average over the MCMC traces +#' of component parameters and weights (in case of unknown parameters). +#' * IEAVG: The identified ergodic average is defined similar to the EAVG, +#' however, in contrast to the latter it is based on re-labeled MCMC traces. +#' This is especially important in case of random permutation during MCMC +#' sampling as component parameters then have to be re-assigned to their +#' (probably) correct component. +#' +#' For a more detailed outlay of point estimators from Bayesian mixture model +#' estimation, see Fr\"uhwirth-Schnatter (2006). +#' +#' @param mcmcout An `mcmcoutput` object containing the sampled parameters and +#' informaiton about the finite mixture model. +#' @param method A character defining the re-labeling method in case of a model +#' with unknown indicators. For most distributions there exists only a single +#' choice, namely "kmeans". For Poisson and Binomial distributions the +#' re-labeling algorithms "Stephens1997a" and "Stephens1997b" can be chosen. +#' @param fdata An `fdata` model containing the observations. Optional. +#' @param permOut A logical indicating, if the permuted MCMC samples should be +#' returned as well. Optional. +#' @param opt_ctrl A list with an element `max_iter` controlling the number of +#' iterations in case the "Stephens1997a" re-labeling algorithm is chosen. +#' @return An `mcmcest` object cotnaining the point estimates together with +#' additional information about the underlying finite mixture model, MCMC +#' sampling hyper-parameters and the data. In case `permOut` is set to +#' `TRUE`, the output of this function is a named list with an `mcmcest` +#' object containing parameter estimates and in addition an `mcmcoutputperm` +#' object containing the permuted (re-labeled) MCMC samples. +#' @export +#' @name mcmcestimate +#' +#' @seealso +#' * [mcmcestfix][mcmcest_class] for object storing the parameter estimates in +#' case of fixed indicators +#' * [mcmcestfix][mcmcest_class] for object storing the parameter estimates in +#' case of unknown indicators +#' * [mcmcoutputperm][mcmcoutputperm_class] for classes storing re-labeled +#' MCMC samples "mcmcestimate" <- function(mcmcout, method = "kmeans", fdata = NULL, permOut = FALSE, opt_ctrl = list(max_iter = 200L)) { ## Check input ## @@ -155,19 +202,33 @@ } ## New 'mcmcestimate' object. - ## In case the permOut = TRUE the mcmcout object is + ## In case the permOut = TRUE the mcmcoutperm object is ## returned as well in a list } ### Private functions ### These functions are not exported. -### Checking -### Check arguments: The 'mcmcout' object must inherit from -### 'mcmcoutput' or 'mcmcoutputperm'. Argument 2 must match one -### of three permutation algorithms in 'mcmcpermute()'. -### Argument 3 must be of type logical. If any case is not true -### an error is thrown. +#' Check arguments for [mcmcestimate()] +#' +#' @description +#' For internal usage only. This function checks the arguments to the +#' [mcmcestimate()] function and throws an error, if the checks do not pass. +#' More specifically it checks for the classes of objects and the choices in +#' case of a character argument. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing MCMC +#' samples. +#' @param arg2 The second argument to the `mcmcestimate()` function. +#' @param arg3 The second argument to the `mcmcestimate()` function. +#' @param arg4 The second argument to the `mcmcestimate()` function. +#' @param arg5 The second argument to the `mcmcestimate()` function. +#' @return None. If checks do not pass, an error is thrown with a user-friendly +#' message. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".check.args.Mcmcestimate" <- function(obj, arg2, arg3, arg4, arg5) { if (!inherits(obj, c("mcmcoutput", "mcmcoutputperm"))) { stop(paste("Wrong argument: Argument 1 must be an object ", @@ -203,6 +264,19 @@ } } +#' Calculates the MAP +#' +#' @description +#' For internal usage only. This function calculates the MAP estimates from the +#' MCMC samples. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object storing the MCMC +#' samples. +#' @return An integer specifying the index of the parameter values that lead +#' to the highest posterior log likelihood. +#' @noRd +#' @seealso +#' * [mcmcestimate()] for the calling function ".map.Mcmcestimate" <- function(obj) { ## Take the value with the highest posterior log ## likelihood @@ -212,6 +286,20 @@ return(as.integer(map.index)) } +#' Calculates the BML +#' +#' @description +#' For internal usage only. This function calculates the BML estimates from the +#' MCMC samples. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object storing the MCMC +#' samples. +#' @return An integer specifying the index of the parameter values that lead +#' to the highest mixture log-likelihood. +#' @noRd +#' @importFrom utils tail +#' @seealso +#' * [mcmcestimate()] for the calling function ".bml.Mcmcestimate" <- function(obj) { ## Take the value with the highest log likelihood mixlik <- obj@log$mixlik @@ -220,6 +308,22 @@ return(bml.index) } +#' Extract estimates from MCMC samples +#' +#' @description +#' For internal usage only. This function extracts a row of MCMC samples by +#' index. The index in this case are the indices at which the log-likelihood +#' functions have their empirical mode. +#' +#' @param obj An `mcmcoutput` object containing the MCMC samples. +#' @param m An integer defining the index at which index parameters and +#' log-likelihood function values should be extracted. +#' @return A named list with elements `par` containing the extracted +#' parameters and `log` containing the log-likelihood values. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".extract.Mcmcestimate" <- function(obj, m) { ## Extract the 'm'th row in each slot of an mcmcout ## object @@ -267,6 +371,22 @@ return(est.list) } +#' Calculate the EAVG +#' +#' @description +#' For internal usage only. This function calculates the identified ergodic +#' average from the (re-labeled) MCMC traces. In the case of permuted MCMC +#' samples the ergodic average is the so-called identified ergodic average. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing MCMC +#' samples. +#' @return A list containing the ergodic average estimates for the component +#' parameters in element `par` and the corresponding weight estimates in +#' element `weigth`. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".eavg.Mcmcestimate" <- function(obj) { ## Check arguments ## dist <- obj@model@dist @@ -444,6 +564,21 @@ } } +#' Calculate the standard deviation of the posterior +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.Mcmcestimate" <- function(obj, perm) { dist <- obj@model@dist if (dist %in% c("poisson", "cond.poisson", "exponential")) { @@ -461,6 +596,22 @@ } } +# TODO: Throws error that weights are not available, if `indicfix=TRUE` +#' Calculate the standard deviation of the posterior from Poisson mixtures +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.poisson.Mcmcestimate" <- function(obj, perm) { if (perm) { sdpar <- apply(obj@parperm$lambda, 2, sd, na.rm = TRUE) @@ -488,6 +639,21 @@ return(sdlist) } +#' Calculate the standard deviation of the posterior from Binomial mixtures +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.binomial.Mcmcestimate" <- function(obj, perm) { if (perm) { sdpar <- apply(obj@parperm$p, 2, sd, na.rm = TRUE) @@ -518,6 +684,21 @@ return(sdlist) } +#' Calculate the standard deviation of the posterior from Normal mixtures +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.normal.Mcmcestimate" <- function(obj, perm) { if (perm) { sdmu <- apply(obj@parperm$mu, 2, sd, na.rm = TRUE) @@ -551,6 +732,21 @@ return(sdlist) } +#' Calculate the standard deviation of the posterior from Student-t mixtures +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.student.Mcmcestimate" <- function(obj, perm) { if (perm) { sdmu <- apply(obj@parperm$mu, 2, sd, na.rm = TRUE) @@ -596,6 +792,21 @@ return(sdlist) } +#' Calculate the std. dev. of the posterior from multivariate Normal mixtures +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' @importFrom stats cov +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.normult.Mcmcestimate" <- function(obj, perm) { r <- obj@model@r K <- obj@model@K @@ -672,6 +883,21 @@ return(sdlist) } +#' Calculate the std. dev. of the posterior from multivariate Student-t mixtures +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @param perm A logical indicating, if the samples have been re-labeled. +#' @return A list containing the standard deviations of the posterior +#' densities. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.studmult.Mcmcestimate" <- function(obj, perm) { r <- obj@model@r K <- obj@model@K @@ -754,10 +980,40 @@ return(sdlist) } +#' Calculate the std. dev. for unidentified MCMC samples +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution in case that no re-labeling has been +#' performed. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @return A list containing the standard deviations of the posterior +#' densities in case of samples that are not re-labeled. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.unidentified.Mcmcestimate" <- function(obj) { .sdpost.unidentified.poisson.Mcmcestimate(obj) } +#' Calculate the std. dev. for unidentified Poisson MCMC samples +#' +#' @description +#' For internal usage only. This function calculates the standard deviations of +#' the posterior parameter distribution in case that no re-labeling has been +#' performed. +#' +#' @param obj An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sampled parameter values. +#' @return A list containing the standard deviations of the posterior +#' densities in case of samples that are not re-labeled. +#' @noRd +#' +#' @seealso +#' * [mcmcestimate()] for the calling function ".sdpost.unidentified.poisson.Mcmcestimate" <- function(obj) { sdpar <- apply(obj@par$lambda, 2, sd) sdweight <- apply(obj@weight, 2, sd) @@ -767,4 +1023,4 @@ ) sdlist <- list(unidentified = unidentified) return(sdlist) -} +} \ No newline at end of file diff --git a/R/mcmcestind.R b/R/mcmcestind.R index fb8e18c..29e8d4a 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -15,6 +15,29 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcestfix` class +#' +#' @description +#' This class stores the point estimators for component parameters and weights +#' as well as corresponding information from MCMC sampling. Three point +#' estimators are calculated: the maximum a posterior (MAP), the Bayesian +#' maximum likelihood (BML) and the Identified ergodic average (IEAVG). See +#' Fr\"uhwirth-Schnatter (2006) for detailed information about how these +#' estimators are defined. +#' +#' Note that this class inherits almost all of its slots from the `mcmcestfix` +#' class, the corresponding class for fixed indicators. +#' +#' @slot eavg A named list containing the estimates of the ergodic average. The +#' element `par` is a list and contains the component parameter estimates and +#' `weight` contains the weight estimates. The difference between the EAVG +#' and the IEAVG is that the IEAVG is based on re-labeled samples. +#' @exportClass mcmcestind +#' @describeIn mcmcest_class Finmix `mcmcestind` class +#' +#' @seealso +#' * [mcmcestfix][mcmcest_class] for the parent class with fixed indicators +#' * [mcmcestimate()] to calculate point estimates .mcmcestind <- setClass("mcmcestind", representation(eavg = "list"), contains = c("mcmcestfix"), @@ -25,6 +48,14 @@ prototype(eavg = list()) ) +#' Finmix `mcmcest` class union +#' +#' @description +#' This class union includes all classes that define objects for storing the +#' parameter estimates and is used to dispatch methods for `mcmcest` objects. +#' +#' @exportClass mcmcest +#' @noRd setClassUnion( "mcmcest", c( @@ -33,6 +64,16 @@ setClassUnion( ) ) +#' Shows a summary of an `mcmcestind` object. +#' +#' Calling [show()] on an `mcmcestind` object gives an overview +#' of the `mcmcestind` object. +#' +#' @param object An `mcmcestind` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcest_class setMethod( "show", "mcmcestind", function(object) { @@ -70,6 +111,20 @@ setMethod( } ) +# TODO: The Std. Error is the same for both components. +#' Shows an advanced summary of an `mcmcestind` object. +#' +#' Calling [show()] on an `mcmcestind` object gives an advanced overview +#' of the `mcmcestind` object. +#' +#' Note, this method is so far only implemented for mixtures of Poisson +#' distributions. +#' +#' @param object An `mcmcestind` object. +#' @returns A console output listing the formatted slots and summary +#' information about each of them. +#' @exportMethod Summary +#' @describeIn mcmcest_class setMethod( "Summary", "mcmcestind", function(x, ..., na.rm = FALSE) { @@ -141,6 +196,32 @@ setMethod( ) ## Getters ## +#' Getter method of `mcmcestind` class. +#' +#' Returns the `eavg` slot. +#' +#' @param object An `mcmcestind` object. +#' @returns The `eavg` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_est <- mcmcestimate(f_output) +#' # Get the slot. +#' getEavg(f_output) +#' +#' @seealso +#' * [mcmcestfix][mcmcoutput_class] for the parent class with fixed indicators +#' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getEavg", "mcmcestind", function(object) { @@ -155,16 +236,41 @@ setMethod( ### These functions are not exported. ### Summary -### Summary Map estimates: Creates a matrix with Map -### estimates. + +#' Summarize MAP estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' MAP estimates of models with unknown indicators. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the MAP. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.map.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.map.poisson.Mcmcestind(obj) } } -### Summary Map estimates Poisson: Creates a matrix -### with Map estimates for Poisson parameters. +#' Summarize MAP estimates form Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' MAP estimates of Poisson mixture models when indicators are unknown. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the MAP. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.map.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -179,16 +285,41 @@ setMethod( return(parout) } -### Summary Bml estimates: Creates a matrix with Bml -### estimates. +#' Summarize BML estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' BML estimates. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the BML. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.bml.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.bml.poisson.Mcmcestind(obj) } } -### Summary Bml estimates Poisson: Creates a matrix -### with Bml estimates for Poisson parameters. +#' Summarize BML estimates for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' BML estimates. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the BML. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.bml.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -203,16 +334,41 @@ setMethod( return(parout) } -### Summary Ieavg estimates: Creates a matrix with Ieavg -### estimates. +#' Summarize IEAVG estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' IEAVG estimates. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the IEAVG. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.ieavg.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.ieavg.poisson.Mcmcestind(obj) } } -### Summary Bml estimates Poisson: Creates a matrix -### with Bml estimates for Poisson parameters. +#' Summarize IEAVG estimates for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' IEAVG estimates. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the IEAVG. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.ieavg.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -227,16 +383,42 @@ setMethod( return(parout) } -### Summary Eavg estimates: Creates a matrix with Eavg -### estimates. +#' Summarize IEAVG estimates +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' EAVG estimates. The difference between the EAVG and the IEAVG is that the +#' IEAVG is based on re-labeled samples. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the EAVG. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.eavg.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.eavg.poisson.Mcmcestind(obj) } } -### Summary Bml estimates Poisson: Creates a matrix -### with Bml estimates for Poisson parameters. +#' Summarize EAVG estimates for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates explicit summaries for the +#' EAVG estimates. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A matrix with parameter estimates from the EAVG. In addition the +#' standard deviations of the posterior density are presented. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".pars.eavg.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -252,16 +434,40 @@ setMethod( return(parout) } -### Summary rownames: Creates row names for all -### parameters. +#' Create summary row names +#' +#' @description +#' For internal usage only. This function generates row names for the explicit +#' summaries. +#' +#' Note that at this time advanced summaries are only available for Poisson +#' mixture models. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A vector with the row names for the advanced summary. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".rownames.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .rownames.poisson.Mcmcestind(obj) } } -### Summary rownames: Creates row names for -### each model. +#' Create summary row names for Poisson mixture models +#' +#' @description +#' For internal usage only. This function generates row names for the explicit +#' summaries. +#' +#' @param obj An `mcmcestind` object containing the parameter estimates. +#' @return A vector with the row names for the advanced summary over estimates +#' for a Poisson mixture model. +#' @noRd +#' +#' @seealso +#' * [summary][mcmcest_class] for the calling function ".rownames.poisson.Mcmcestind" <- function(obj) { rnames <- rep("", 2 * obj@K) for (k in seq(1, obj@K)) { @@ -271,4 +477,4 @@ setMethod( rnames[k] <- paste("eta ", k - obj@K, sep = "") } return(rnames) -} +} \ No newline at end of file diff --git a/R/mcmcextract.R b/R/mcmcextract.R index 7360343..a7ee9a8 100644 --- a/R/mcmcextract.R +++ b/R/mcmcextract.R @@ -1,3 +1,20 @@ +#' Finmix `mcmcextract` class +#' +#' @desfription +#' This is a leight-weighted class containing the major results from MCMC +#' sampling to calculate model moments from MCMC samples. Note that momentarily +#' only methods for the multivariate Normal mixture are implemented. +#' +#' @slot dist A character defining the finite mixture model that has been used +#' in MCMC sampling. +#' @slot K An integer specifying the number of components of the mixture model. +#' @slot r An integer specifying the number of dimensions of the mixture model. +#' @slot par A list storing the sample component parameters from MCMC sampling. +#' @slot weight A n array storing the sample weight parameters from MCMC +#' sampling. +#' +#' @exportClass mcmcextract +#' @noRd .mcmcextract <- setClass("mcmcextract", representation( dist = "character", @@ -19,6 +36,22 @@ ) ) +#' Calculate the model moments of MCMC samples +#' +#' @description +#' For internal usage only. This function calculates the finite mixture moments +#' of a mixture model from the MCMC samples. Note that this function is +#' momentarily only implemented for a mixture of multivariate Normal +#' distributions. +#' +#' @param obj An `mcmcextract` object containing the parameters and weights +#' from MCMC sampling. +#' @return A list containing the model moments calculated from MCMC samples. +#' @exportMethod moments +#' @noRd +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the results from MCMC sampling +#' * [extract()][mcmcoutput_class] for the calling method setMethod( "moments", signature(object = "mcmcextract"), function(object) { @@ -29,9 +62,19 @@ setMethod( } ) -### -------------------------------------------------------------- -### Moments -### -------------------------------------------------------------- +#' Calculate the model moments of multivariate Normal MCMC samples +#' +#' @description +#' For internal usage only. This function calculates the finite mixture moments +#' of a multivariate Normal mixture model from the MCMC samples. +#' +#' @param obj An `mcmcextract` object containing the parameters and weights +#' from MCMC sampling. +#' @return A list containing the model moments calculated from MCMC samples. +#' @noRd +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the results from MCMC sampling +#' * [extract()][mcmcoutput_class] for the calling method ".moments.Normult.Mcmcextract" <- function(obj) { K <- obj@K r <- obj@r diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index ee87dbf..f89e18a 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -9,12 +9,39 @@ # # finmix is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +# TODO: CHange examples to storepost = FALSE + +#' Finmix `mcmcoutput` base class for unknown indicators +#' +#' @description +#' This class defines the basic slots for the MCMC sampling output when +#' indicators are not known. It inherits from the +#' [mcmcoutfix][mcmcoutput_class]. +#' +#' @slot weight An `array` of dimension `M x K` containing the sampled +#' weights. +#' @slot entropy An `array` of dimension `M x 1` containing the entropy +#' for each MCMC draw. +#' @slot ST An `array` of dimension `M x 1` containing all MCMC states, +#' for the last observation in slot `@@y` of the `fdata` object passed in to +#' [mixturemcmc()] where a state is defined for non-Markov models as the +#' last indicator of this observation. +#' @slot S An `array` of dimension `N x storeS` containing the last +#' `storeS` indicators sampled. `storeS` is defined in the slot `@@storeS` of +#' the `mcmc` object passed into [mixturemcmc()]. +#' @slot NK An `array` of dimension `M x K` containing the number of +#' observations assigned to each component for each MCMC draw. +#' @slot clust An `array` of dimension `N x 1` containing the recent +#' indicators defining the last "clustering" of observations into the +#' mixture components. +#' @exportClass mcmcoutputbase +#' @describeIn mcmcoutput_class .mcmcoutputbase <- setClass("mcmcoutputbase", representation( weight = "array", @@ -39,6 +66,16 @@ ) ) +#' Shows a summary of an `mcmcoutputbase` object. +#' +#' Calling [show()] on an `mcmcoutputbase` object gives an overview +#' of the `mcmcoutputbase` object. +#' +#' @param object An `mcmcoutputbase` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class setMethod( "show", "mcmcoutputbase", function(object) { @@ -55,6 +92,10 @@ setMethod( " log : List of", length(object@log), "\n" ) + cat( + " entropy : ", + paste(dim(object@entropy), collapse = "x"), "\n" + ) cat( " ST :", paste(dim(object@ST), collapse = "x"), "\n" @@ -84,6 +125,51 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `0`. +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputbase", @@ -121,6 +207,43 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputbase", @@ -136,6 +259,43 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputbase", @@ -151,6 +311,42 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point processes of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputbase", @@ -162,6 +358,42 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representations of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputbase", @@ -173,7 +405,42 @@ setMethod( } ) - +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputbase", @@ -185,6 +452,19 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' @param object An `mcmcoutput` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputbase", @@ -198,6 +478,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutput` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputbase", @@ -214,6 +503,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `weight` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `weight` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getWeight(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getWeight", "mcmcoutputbase", function(object) { @@ -221,6 +537,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `entropy` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `entropy` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getEntropy(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getEntropy", "mcmcoutputbase", function(object) { @@ -228,6 +571,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `ST` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `ST` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getST(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getST", "mcmcoutputbase", function(object) { @@ -235,6 +605,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `S` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `S` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getS(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getS", "mcmcoutputbase", function(object) { @@ -242,6 +639,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `NK` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `NK` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getNK(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getNK", "mcmcoutputbase", function(object) { @@ -249,6 +673,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `clust` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `clust` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getClust(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getClust", "mcmcoutputbase", function(object) { @@ -264,8 +715,21 @@ setMethod( ### Plot ### Plot traces -### Plot traces Poisson: Plots the traces for the sampled -### Poisson parameters and the weights. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Poisson.Base" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 - 1 @@ -304,6 +768,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of Binomial mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Binomial mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Binomial.Base" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 - 1 @@ -322,7 +800,7 @@ setMethod( ) axis(2, las = 2, cex.axis = .7) mtext( - sid = 2, las = 2, bquote(p[k = .(k)]), + side = 2, las = 2, bquote(p[k = .(k)]), cex = .6, line = 3 ) } @@ -342,6 +820,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of exponential mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a exponential mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Exponential.Base" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 - 1 @@ -380,6 +872,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of weights from any mixture model +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from any mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Weights.Base" <- function(x, dev, col) { weight <- x@weight K <- x@model@K @@ -416,22 +922,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### ----------------------------------------------------------------- -### .traces.Log.Base -### @description Plots the log likelihoods for a finite mixture -### model with sampled indicators -### @par x an mcmcoutput object -### dev a logical -### col a logical -### @return a graphical device with the traceplots of the -### mixture likelihood, the prior likelihood and -### the complete data likelihood -### @detail If 'dev' is FALSE, the output can be sent to a -### file. If 'col' is TRUE the output is given in -### rainbow colors, otherwise gray.colors is used. -### @see ?plotTraces, ?rainbow, ?gray.colors -### @author Lars Simon Zehnder -### ------------------------------------------------------------------ +#' Plots traces of log-likelihood samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from any mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Log.Base" <- function(x, dev, col = FALSE) { if (.check.grDevice() && dev) { dev.new(title = "Log Likelihood Traceplots") @@ -480,8 +984,21 @@ setMethod( } ### Histograms -### Histograms Poisson: Plots the histograms for the Poisson -### parameters and the weights. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Poisson.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -500,6 +1017,20 @@ setMethod( .symmetric.Hist(vars, lab.names) } +#' Plot histograms of Binomial samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Binomial +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Binomial.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -518,6 +1049,20 @@ setMethod( .symmetric.Hist(vars, lab.names) } +#' Plot histograms of exponential samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' exponential parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Exponential.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -536,7 +1081,22 @@ setMethod( .symmetric.Hist(vars, lab.names) } +#' Plot histograms of normal samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled normal +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Normal.Base" <- function(x, dev) { + K <- x@model@K .hist.Normal(x, dev) if (K > 1) { weight <- x@weight @@ -553,7 +1113,22 @@ setMethod( } } +#' Plot histograms of Student-t samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Student-t +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Student.Base" <- function(x, dev) { + K <- x@model@K .hist.Student(x, dev) if (K > 1) { weight <- x@weight @@ -568,7 +1143,22 @@ setMethod( } } +#' Plot histograms of multivariate normal samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' multivariate normal parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Normult.Base" <- function(x, dev) { + K <- x@model@K .hist.Normult(x, dev) if (K > 1) { weight <- x@weight @@ -583,7 +1173,22 @@ setMethod( } } +#' Plot histograms of multivariate Student-t samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' multivariate Student-t parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Studmult.Base" <- function(x, dev) { + K <- x@model@K .hist.Studmult(x, dev) if (K > 1) { weight <- x@weight @@ -598,6 +1203,20 @@ setMethod( ### Densities ### Densities Poisson: Plots Kernel densities for the Poisson ### parameters and the weights. +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Poisson.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -616,6 +1235,20 @@ setMethod( .symmetric.Dens(vars, lab.names) } +#' Plot densities of Binomial samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Binomial +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' @importFrom grDevices dev.new +#' @seealso +#' * [plotDens()] for the calling function ".dens.Binomial.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -634,6 +1267,20 @@ setMethod( .symmetric.Dens(vars, lab.names) } +#' Plot densities of exponential samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' exponential parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Exponential.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -652,7 +1299,22 @@ setMethod( .symmetric.Dens(vars, lab.names) } +#' Plot densities of normal samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled normal +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Normal.Base" <- function(x, dev) { + K <- x@model@K .dens.Normal(x, dev) if (K > 1) { weight <- x@weight @@ -669,7 +1331,22 @@ setMethod( } } +#' Plot densities of Student-t samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Student-t +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Student.Base" <- function(x, dev) { + K <- x@model@K .dens.Student(x, dev) if (K > 1) { weight <- x@weight @@ -684,8 +1361,23 @@ setMethod( } } +#' Plot densities of multivariate normal samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' multivariate normal parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Normult.Base" <- function(x, dev) { - .dnes.Normult(x, dev) + K <- x@model@K + .dens.Normult(x, dev) if (K > 1) { weight <- x@weight weight.lab.names <- vector("list", K) @@ -699,7 +1391,22 @@ setMethod( } } +#' Plot densities of multivariate Student-t samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' multivariate Student-t parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Studmult.Base" <- function(x, dev) { + K <- x@model@K .dens.Studmult(x, dev) if (K > 1) { weight <- x@weight @@ -715,6 +1422,21 @@ setMethod( } ### Subseq: Creates a subsequence of an MCMC sample. +#' Generates sub-chains from MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from any +#' `mcmcoutput` object by defining an `index` array specifying how extraction +#' of sub-samples should be performed. Has errors for some `mcmcoutput` +#' sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Base" <- function(obj, index) { M <- dim(obj@weight)[1] K <- dim(obj@weight)[2] @@ -745,8 +1467,19 @@ setMethod( return(obj) } -### swapElements: Permutes the elements in an MCMC sample -### for each row. +#' Swaps elements in MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with MCMC samples. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Base" <- function(obj, index) { ## Rcpp::export 'swap_cc()' obj@weight <- swap_cc(obj@weight, index) diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index 581f261..95365c9 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -15,6 +15,30 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +# TODO: Change to non-hierarchical prior in examples + +#' Finmix `mcmcoutput` base class for fixed indicators +#' +#' @description +#' This class defines the basic slots for the MCMC sampling output for a +#' fixed indicator model. +#' +#' @slot M An integer defining the number of iterations in MCMC sampling. +#' @slot burnin An integer defining the number of iterations in the burn-in +#' phase of MCMC sampling. These number of sampling steps are not stored +#' in the output. +#' @slot ranperm A logical indicating, if MCMC sampling has been performed +#' with random permutations of components. +#' @slot par A named list containing the sampled component parameters. +#' @slot log A named list containing the values of the mixture log-likelihood, +#' mixture prior log-likelihood, and the complete data posterior +#' log-likelihood. +#' @slot model The `model` object that specifies the finite mixture model for +#' whcih MCMC sampling has been performed. +#' @slot prior The `prior` object defining the prior distributions for the +#' component parameters that has been used in MCMC sampling. +#' @exportClass mcmcoutputfix +#' @name mcmcoutput_class .mcmcoutputfix <- setClass("mcmcoutputfix", representation( M = "integer", @@ -40,6 +64,17 @@ ) ) +#' Shows a summary of an `mcmcoutputfix` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputfix` object gives an overview +#' of the `mcmcoutputfix` object. +#' +#' @param object An `mcmcoutputfix` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class setMethod( "show", "mcmcoutputfix", function(object) { @@ -67,6 +102,52 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputfix", @@ -100,6 +181,43 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputfix", @@ -125,6 +243,44 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputfix", @@ -150,6 +306,43 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputfix", @@ -165,6 +358,41 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputfix", @@ -180,6 +408,41 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputfix", @@ -195,6 +458,19 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' @param object An `mcmcoutput` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputfix", @@ -212,7 +488,7 @@ setMethod( } else if (dist == "binomial") { .subseq.Binomial(object, index) } else if (dist == "exponential") { - .subseq.Exponential(object, index) + .subseq.Poisson(object, index) } else if (dist == "normal") { .subseq.Normal(object, index) } else if (dist == "student") { @@ -225,6 +501,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutput` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputfix", @@ -255,6 +540,18 @@ setMethod( } ) +#' Extracts samples from `mcmcoutput` object of a multivariate Normal mixture +#' +#' @ðescription +#' This function extracts samples from a multivariate Normal mixture output. +#' +#' @param object An `mcmcoutput` object from MCMC sampling of a multivariate +#' Normal mixture model. +#' @param index An numeric indicating which dimension of the multivariate +#' mixture should be extracted. +#' @return An object class `mcmcextract` containing all samples of an extracted +#' dimension. +#' @describeIn mcmcoutput_class setMethod( "extract", signature( object = "mcmcoutputfix", @@ -268,16 +565,55 @@ setMethod( } ) +# TODO: Check the return values. It appears that this function does not +# return anything. +#' Computes multivariate Normal sample moments +#' +#' @description +#' Calling [moments()] calculates the sample moments for the samples of a +#' multivariate Normal mixture model. +#' +#' @param object An `mcmcoutputfix` object containing all data from MCMC +#' sampling. +#' @return The moments on the samples of a multivariate Normal mixture. +#' @describeIn mcmcoutput_class setMethod( "moments", signature(object = "mcmcoutputfix"), function(object) { - dist <- objject@model@dist + dist <- object@model@dist if (dist == "normult") { .moments.Normult.Mcmcoutput(object) } } ) + ## Getters ## +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `M` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `M` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getM(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getM", "mcmcoutputfix", function(object) { @@ -285,6 +621,32 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `burnin` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `burnin` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getBurnin(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getBurnin", "mcmcoutputfix", function(object) { @@ -292,6 +654,32 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `ranperm` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `ranperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getRanperm(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getRanperm", "mcmcoutputfix", function(object) { @@ -299,6 +687,32 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `par` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `par` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getPar(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPar", "mcmcoutputfix", function(object) { @@ -306,6 +720,32 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `log` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `log` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getLog(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getLog", "mcmcoutputfix", function(object) { @@ -313,6 +753,33 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `model` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `model` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getModel(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getModel", "mcmcoutputfix", function(object) { @@ -320,6 +787,32 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `prior` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `prior` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getPrior(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPrior", "mcmcoutputfix", function(object) { @@ -327,17 +820,28 @@ setMethod( } ) -## No setters as users are not intended to manipulate ## -## this object ##i +## No setters as users are not intended to manipulate +## this object ### Private functions ### These functions are not exported ### Plot -### Traces Poisson: Plots the traces of MCMC samples -### for Poisson mixture. If dev = FALSE, no graphical -### device is started, instead it is assumed that the -### user wants to save the graphic to a file. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Poisson" <- function(x, dev) { K <- x@model@K trace.n <- K @@ -364,6 +868,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of Binomial mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Binomial mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Binomial" <- function(x, dev) { K <- x@model@K trace.n <- K @@ -390,18 +908,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .traces.Exponential -### @description Plots traces for parameters of Exponential mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Exponential mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of exponential mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a exponential mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Exponential" <- function(x, dev) { K <- x@model@K trace.n <- K @@ -428,19 +948,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .traces.Normal -### @description Plots traces for parameters of a univariate Normal -### mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Normal mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a normal mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Normal" <- function(x, dev) { K <- x@model@K trace.n <- 2 * K @@ -479,19 +1000,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .traces.Student -### @description Plots traces for parameters of a univariate Student -### mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Student-t mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Student" <- function(x, dev) { K <- x@model@K trace.n <- 3 * K @@ -542,19 +1064,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### ------------------------------------------------------------------------- -### .traces.Normult -### @description Plots the traces of parameters and moments of a multi- -### variate Normal distribution. -### @par x an mcmcoutputfix object -### dev a logical -### col a logical -### @return a graphical device -### @detail If dev = FALSE, the plot can be sent to a file. In case -### col = TRUE, rainbow colors are used. -### @see ?plotTraces -### @author Lars Simon Zehnder -### ------------------------------------------------------------------------- +#' Plots traces of multivariate normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate normal mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' @importFrom grDevices rainbow gray.colors +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Normult" <- function(x, dev, col) { K <- x@model@K r <- x@model@r @@ -710,19 +1233,20 @@ setMethod( } } -### ------------------------------------------------------------------------- -### .traces.Studmult -### @description Plots the traces of parameters and moments of a multi- -### variate Student-t distribution. -### @par x an mcmcoutputfix object -### dev a logical -### col a logical -### @return a graphical device -### @detail If dev = FALSE, the plot can be sent to a file. In case -### col = TRUE, rainbow colors are used. -### @see ?plotTraces -### @author Lars Simon Zehnder -### ------------------------------------------------------------------------- +#' Plots traces of multivariate Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate Student-t mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Studmult" <- function(x, dev, col) { K <- x@model@K r <- x@model@r @@ -900,10 +1424,20 @@ setMethod( } } -### Traces Poisson: Plots the traces of MCMC samples -### for the log-likelihoods. If dev = FALSE, no graphical -### device is started, instead it is assumed that the -### user wants to save the graphic to a file. +#' Plots traces of log-likelihood samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from any mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Log" <- function(x, dev, col) { if (.check.grDevice() && dev) { dev.new(title = "Log Likelihood Traceplots") @@ -942,8 +1476,21 @@ setMethod( } ### Plot Histogramms -### Plot Hist Poisson: Plots Histograms for each component -### parameter. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Poisson" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -961,6 +1508,20 @@ setMethod( } } +#' Plot histograms of Binomial samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Binomial +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Binomial" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -978,6 +1539,20 @@ setMethod( } } +#' Plot histograms of exponential samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' exponential parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Exponential" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -995,6 +1570,20 @@ setMethod( } } +#' Plot histograms of normal samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled normal +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Normal" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -1026,6 +1615,20 @@ setMethod( } } +#' Plot histograms of Student-t samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Student-t +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Student" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -1068,6 +1671,20 @@ setMethod( } } +#' Plot histograms of multivariate normal samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' multivariate normal parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Normult" <- function(x, dev) { K <- x@model@K r <- x@model@r @@ -1114,6 +1731,20 @@ setMethod( } } +#' Plot histograms of multivariate Student-t samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' multivariate Student-t parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Studmult" <- function(x, dev) { K <- x@model@K r <- x@model@r @@ -1183,8 +1814,21 @@ setMethod( } ### Plot Densities -### Plot Dens Poisson: Plots Kernel densities for each -### component parameter. + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Poisson" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -1202,6 +1846,20 @@ setMethod( } } +#' Plot densities of Binomial samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Binomial +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Binomial" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -1219,6 +1877,20 @@ setMethod( } } +#' Plot densities of exponential samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' exponential parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Exponential" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -1236,6 +1908,20 @@ setMethod( } } +#' Plot densities of normal samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled normal +#' parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Normal" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -1267,7 +1953,21 @@ setMethod( } } -".dens.Student.Hier" <- function(x, dev) { +#' Plot densities of Student-t samples with hierarchical priors +#' +#' @description +#' For internal usage only. This function plots densities of sampled Student-t +#' parameters and weights when a hierarchical prior had been used. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function +".dens.Student" <- function(x, dev) { K <- x@model@K mu <- x@par$mu sigma <- x@par$sigma @@ -1309,6 +2009,20 @@ setMethod( } } +#' Plot densities of multivariate normal samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' multivariate normal parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Normult" <- function(x, dev) { K <- x@model@K r <- x@model@r @@ -1358,6 +2072,20 @@ setMethod( } } +#' Plot densities of multivariate Student-t samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' multivariate Student-t parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Studmult" <- function(x, dev) { K <- x@model@K r <- x@model@r @@ -1421,9 +2149,21 @@ setMethod( } ### Plot Point Processes -### Plot Point Process Poisson: Plots the point process -### for the MCMC draws for lambda. The values are plotted -### against a random normal sample. + +#' Plot point processes of Poisson samples +#' +#' @description +#' For internal usage only. This function plots the point process of sampled +#' Poisson parameters and weights against a random normal sample. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the point process for the sampled parameters and weights. +#' @noRd +#' @importFrom stats median +#' @seealso +#' * [plotPointProc()] for the calling function ".pointproc.Poisson" <- function(x, dev) { K <- x@model@K M <- x@M @@ -1462,6 +2202,20 @@ setMethod( ) } +#' Plot point processes of Binomial samples +#' +#' @description +#' For internal usage only. This function plots the point process of sampled +#' Binomial parameters and weights against a random normal sample. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the point process for the sampled parameters and weights. +#' @noRd +#' @importFrom stats rnorm +#' @seealso +#' * [plotPointProc()] for the calling method ".pointproc.Binomial" <- function(x, dev) { K <- x@model@K M <- x@M @@ -1497,9 +2251,23 @@ setMethod( } ### Plot sampling representation -### Plot sampling representation Poisson: Plots the sampling -### representation for Poisson parameters. Each parameter sample -### is combined with the other samples. + +#' Plot sampling representation of Poisson samples +#' +#' @description +#' For internal usage only. This function plots the sampling representation of +#' sampled Poisson parameters and weights. Each parameter sample is plotted +#' against its permuted counterpart. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the sampling representation for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotSampRep()] for the calling function ".samprep.Poisson" <- function(x, dev) { K <- x@model@K if (K == 1) { @@ -1536,6 +2304,22 @@ setMethod( ) } +#' Plot sampling representation of Binomial samples +#' +#' @description +#' For internal usage only. This function plots the sampling representation of +#' sampled Binomial parameters and weights. Each parameter sample is plotted +#' against its permuted counterpart. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the sampling representation for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotSampRep()] for the calling function ".samprep.Binomial" <- function(x, dev) { K <- x@model@K if (K == 1) { @@ -1573,8 +2357,22 @@ setMethod( } ### Posterior Density -### Posterior Density Poisson: Plots a contour plot of the -### posterior density of the sampled parameters for K = 2. + +#' Plot posterior density of Poisson samples +#' +#' @description +#' For internal usage only. This function plots the posterior density of +#' sampled Poisson parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the posterior density for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotPostdens()] for the calling function ".postdens.Poisson" <- function(x, dev) { K <- x@model@K if (K != 2) { @@ -1620,6 +2418,21 @@ setMethod( } } +#' Plot posterior density of Binomial samples +#' +#' @description +#' For internal usage only. This function plots the posterior density of +#' sampled Binomial parameters and weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the posterior density for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotPostDens()] for the calling function ".postdens.Binomial" <- function(x, dev) { K <- x@model@K if (K != 2) { @@ -1669,6 +2482,21 @@ setMethod( ### Logic subseq: This function is used for each ### distribution type in 'model'. It crreates a subsequence ### for the log-likelihoods. +#' Generates sub-chains from MCMC log-likelihood samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from any +#' `mcmcoutput` object by defining an `index` array specifying how extraction +#' of sub-samples should be performed. Has errors for some `mcmcoutput` +#' sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Log.Fix" <- function(obj, index) { obj@log$mixlik <- matrix(obj@log$mixlik[index], nrow = obj@M, ncol = 1 @@ -1679,8 +2507,21 @@ setMethod( return(obj) } -### Logic subseq Poisson: This function creates a subsequence -### MCMC Poisson parameter samples. +#' Generates sub-chains from Poisson MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Poisson `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Poisson" <- function(obj, index) { if (obj@model@K == 1) { obj@par$lambda <- matrix(obj@par$lambda[index], @@ -1692,8 +2533,21 @@ setMethod( return(obj) } -### - +#' Generates sub-chains from Binomial MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Binomial `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Binomial" <- function(obj, index) { if (obj@model@K == 1) { obj@par$p <- matrix(obj@par$p[index], @@ -1706,8 +2560,21 @@ setMethod( return(obj) } -### - +#' Generates sub-chains from normal MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a normal `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Normal" <- function(obj, index) { if (obj@model@K == 1) { obj@par$mu <- matrix(obj@par$mu[index], @@ -1725,8 +2592,21 @@ setMethod( return(obj) } -### - +#' Generates sub-chains from Student-t MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Student-t `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Student" <- function(obj, index) { if (obj@model@K == 1) { obj@par$mu <- matrix(obj@par$mu[index], @@ -1749,6 +2629,21 @@ setMethod( return(obj) } +#' Generates sub-chains from multivariate Normal MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a multivariate Normal `model` by defining an +#' `index` array specifying how extraction of sub-samples should be performed. +#' Has errors for some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Normult" <- function(obj, index) { if (obj@model@K == 1) { obj@par$mu <- matrix(obj@par$mu[index, ], @@ -1771,6 +2666,21 @@ setMethod( return(obj) } +#' Generates sub-chains from Student-t MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Student-t `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Studmult" <- function(obj, index) { if (obj@model@K == 1) { obj@par$mu <- obj@par$mu[index, ] @@ -1785,30 +2695,81 @@ setMethod( } return(obj) } -### Log swapElements -### Logic swapElements Poisson: This function permutes -### the elements in the MCMC sample for Poisson -### parameters by calling the C++-function 'swap_cc()'. + +#' Swaps elements in Poisson MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Poisson MCMC samples. Calls the C++-function +#' `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Poisson" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@par$lambda <- swap_cc(obj@par$lambda, index) return(obj) } -### - +#' Swaps elements in Binomial MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Binomial MCMC samples. Calls the C++-function +#' `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Binomial" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@par$p <- swap_cc(obj@par$p, index) return(obj) } +#' Swaps elements in Exponential MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with ExponentialMCMC samples. Calls the C++-function +#' `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Exponential" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@par$lambda <- swap_cc(obj@par$lambda, index) return(obj) } +#' Swaps elements in Normal MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Normal MCMC samples. Calls the C++-function +#' `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Normal" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@par$mu <- swap_cc(obj@par$mu, index) @@ -1816,6 +2777,20 @@ setMethod( return(obj) } +#' Swaps elements in Student-t MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Student-t MCMC samples. Calls the C++-function +#' `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Student" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@par$mu <- swap_cc(obj@par$mu, index) @@ -1824,6 +2799,20 @@ setMethod( return(obj) } +#' Swaps elements in multivariate Normal MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with multivariate Normal MCMC samples. Calls the +#' C++-function `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Normult" <- function(obj, index) { ## Rcpp::export 'swap_3d_cc' obj@par$mu <- swap_3d_cc(obj@par$mu, index) @@ -1832,6 +2821,20 @@ setMethod( return(obj) } +#' Swaps elements in multivariate Student-t MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with multivariate Student-t MCMC samples. Calls the C++-function +#' `swap_cc()`. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Studmult" <- function(obj, index) { ## Rcpp::export 'swap_3d_cc' obj@par$mu <- swap_3d_cc(obj@par$mu, index) @@ -1842,8 +2845,25 @@ setMethod( } ### Validity -### Validity subseq: The index given to 'subseq()' must -### have dimension M x 1 and must contain logical values. + +#' Checks arguments to `subseq()` +#' +#' @description +#' For internal usage only. This functions checks the input arguments to the +#' [subseq()] method for validity. More specifically, the `index` argument is +#' checked for the right dimension and type. `index` must be an array of +#' dimension `M x 1` of logicals indicating which samples should be +#' extracted. +#' +#' @param obj An `mcmcoutput` object containing the MCMC sampling that should +#' be sub-chained. +#' @param index An array og logicals indicating which indices should be +#' extracted. +#' @return None. If any check does not pass an error is thrown to explain the +#' user what to change. +#' @noRd +#' @seealso +#' * [subseq()] for the calling method ".subseq.valid.Arg" <- function(obj, index) { if (dim(index)[1] != obj@M) { stop("Argument 'index' has wrong dimension.") @@ -1853,11 +2873,27 @@ setMethod( } } -### Validity swapElements: The index given to 'swapElements()' -### must have dimension M x K. It must be of type 'integer' -### and must be in the range 1, ..., K. + +#' Checks arguments to `subseq()` +#' +#' @description +#' For internal usage only. This functions checks the input arguments to the +#' [swapElements()] method for validity. More specifically, the `index` +#' argument is checked for the right dimension and type. `index` must be an +#' array of dimension `M x K` of integers in the range `1,...,K` indicating +#' how components should be swapped in each row. +#' +#' @param obj An `mcmcoutput` object containing the MCMC sampling that should +#' be sub-chained. +#' @param index An array of indicators indicating how components should be +#' swapped +#' @return None. If any check does not pass an error is thrown to explain the +#' user what to change. +#' @noRd +#' @seealso ".swapElements.valid.Arg" <- function(obj, index) { - if (dim(index)[1] != obj@M || dim(index)[2] != obj@model@K) { + M <- ifelse(inherits(obj, "mcmcoutputperm"), obj@Mperm, obj@M) + if (dim(index)[1] != M || dim(index)[2] != obj@model@K) { stop("Argument 'index' has wrong dimension.") } if (typeof(index) != "integer") { @@ -1871,9 +2907,17 @@ setMethod( } } -### -------------------------------------------------------------- -### Extract -### -------------------------------------------------------------- +#' Extract samples from a multivariate Normal `mcmcoutput` object +#' +#' @description +#' For internal usage only. This function extracts samples from an `mcmcoutput` +#' object of a multivariate Normal mixture. +#' +#' @param obj An `mcmcoutput` object containing the MCMC samples. +#' @param index An array of logicals indicating which samples should be +#' extracted from the MCMC sampling output. +#' @return An `mcmcoutput` object containin the extracted MCMC samples. +#' @noRd ".extract.Normult" <- function(obj, index) { dist <- obj@model@dist r <- obj@model@r @@ -1886,11 +2930,19 @@ setMethod( ) } -### -------------------------------------------------------------- -### Moments -### -------------------------------------------------------------- +#' Moments for each sample of a multivariate Normal mixture +#' +#' @description +#' For internal usage only. This function calculates the moments for extracted +#' samples from a multivariate Normal mixture model. +#' +#' @param obj An `mcmcoutput` object containing the MCMC samples. +#' @return An `mcmcextract` object containing the moments. +#' @noRd +#' @seealso +#' * [mcmcextract][mcmcextract_class] ".moments.Normult.Mcmcoutput" <- function(obj) { - moments <- array(numeric(), dim = c(obj@M, r, )) + moments <- array(numeric(), dim = c(obj@M, obj@fdata@r, obj@fdata@r)) moments <- apply( seq(1, obj@M), 1, function(i) { @@ -1898,4 +2950,4 @@ setMethod( moms <- moments(mm) } ) -} +} \ No newline at end of file diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index 06d1ab0..8099900 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -15,6 +15,19 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutput` class for hierarchical priors +#' +#' @description +#' This class stores in addition to the information from its parent class +#' `mcmcoutputfix` also the sampled parameters from the hierarchical prior. +#' +#' @slot hyper A list storing the sampled parameters from the hierarchical +#' prior. +#' @exportClass mcmcoutputfixhier +#' @describeIn mcmcoutput_class +#' +#' @seealso +#' * [mcmcoutputfix][mcmcoutput_class] for the parent class`` .mcmcoutputfixhier <- setClass("mcmcoutputfixhier", representation(hyper = "list"), contains = c("mcmcoutputfix"), @@ -25,6 +38,16 @@ prototype(hyper = list()) ) +#' Shows a summary of an `mcmcoutputfixhier` object. +#' +#' Calling [show()] on an `mcmcoutputfixhier` object gives an overview +#' of the `mcmcoutputfixhier` object. +#' +#' @param object An `mcmcoutputfixhier` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class setMethod( "show", "mcmcoutputfixhier", function(object) { @@ -62,6 +85,50 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `0`. +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputfixhier", @@ -95,6 +162,42 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputfixhier", @@ -120,6 +223,42 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputfixhier", @@ -145,6 +284,41 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputfixhier", @@ -156,6 +330,41 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputfixhier", @@ -167,6 +376,41 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputfixhier", @@ -178,6 +422,19 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' @param object An `mcmcoutput` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputfixhier", @@ -185,21 +442,28 @@ setMethod( ), function(object, index) { ## Call 'subseq()' from 'mcmcoutputfix' - callNextMethod(object, index) + object <- callNextMethod(object, index) dist <- object@model@dist ## hyper ## if (dist == "poisson") { .subseq.Poisson.Hier(object, index) - } else if (dist == "normal" || dist == "student") { - .subseq.Normal.Hier(object, index) } else if (dist %in% c("normal", "student")) { - .subseq.Norstud.Hier.(object, index) + .subseq.Norstud.Hier(object, index) } else if (dist %in% c("normult", "studmult")) { .subseq.Normultstud.Hier(object, index) } } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutput` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputfixhier", @@ -217,6 +481,32 @@ setMethod( } ) +#' Getter method of `mcmcoutput` class. +#' +#' Returns the `hyper` slot. +#' +#' @param object An `mcmcoutput` object. +#' @returns The `hyper` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getHyper(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getHyper", "mcmcoutputfixhier", function(object) { @@ -224,8 +514,8 @@ setMethod( } ) -## No setters for this object as it is not intended ## -## that users manipulate this object. ## +## No setters for this object as it is not intended +## that users manipulate this object. ### Private functions ### These functions are not exported. @@ -235,10 +525,25 @@ setMethod( ### Plot Traces ### Plot traces Poisson: Plots traces for each component ### parameter of a Poisson mixture and the hyper parameter 'b'. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Poisson.Hier" <- function(x, dev) { K <- x@model@K trace.n <- K + 1 - if (.check.grDevice() && y) { + if (.check.grDevice() && dev) { dev.new(title = "Traceplots") } par( @@ -268,6 +573,20 @@ setMethod( mtext(side = 1, "Iterations", cex = 0.7, line = 3) } +#' Plots traces of normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a normal mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Normal.Hier" <- function(x, dev) { K <- x@model@K trace.n <- 2 * K + 1 @@ -313,19 +632,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .traces.Student.Hier -### @description Plots traces for parameters of a univariate Student -### mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Student-t mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Student.Hier" <- function(x, dev) { K <- x@model@K trace.n <- 3 * K + 1 @@ -386,7 +706,21 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -"traces.Normult.Hier" <- function(x, dev, col) { +#' Plots traces of multivariate normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate normal mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function +".traces.Normult.Hier" <- function(x, dev, col) { .traces.Normult(x, dev, col) r <- x@model@r K <- x@model@K @@ -437,6 +771,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of multivariate Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate Student-t mixture model. +#' +#' @param x An `mcmcoutput` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Studmult.Hier" <- function(x, dev, col) { .traces.Studmult(x, dev, col) r <- x@model@r @@ -489,8 +837,22 @@ setMethod( } ### Plot Histograms -### Plot hist Poisson: Plots histograms for each component -### parameter and the hyper parameter 'b'. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. In addition it plots the histogram of the +#' parameter `b` of the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Poisson.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -512,6 +874,21 @@ setMethod( } } +#' Plot histograms of normal samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled normal +#' parameters and weights. In addition it plots the sampled parameter `C` of +#' the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Normal.Hier" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -548,6 +925,21 @@ setMethod( .symmetric.Hist(C, "C") } +#' Plot histograms of Student-t samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Student-t +#' parameters and weights. In addition it plots the sampled parameter `C` of +#' the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Student.Hier" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -595,6 +987,21 @@ setMethod( .symmetric.Hist(C, "C") } +#' Plot histograms of multivariate normal samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' multivariate normal parameters and weights. In addition it plots the +#' the logarithmised determinant and the trace of the parameter matrix `C`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Normult.Hier" <- function(x, dev) { K <- x@model@K r <- x@model@r @@ -650,6 +1057,21 @@ setMethod( .symmetric.Hist(cbind(logdetC, trC), C.lab.names) } +#' Plot histograms of multivariate Student-t samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled +#' multivariate Student-t parameters and weights. In addition it plots the +#' the logarithmised determinant and the trace of the parameter matrix `C`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Studmult.Hier" <- function(x, dev) { K <- x@model@K r <- x@model@r @@ -728,8 +1150,22 @@ setMethod( } ### Plot Densities -### Plot Dens Poisson Hier: Plots Kernel densities for each -### component parameter and the hyper parameter 'b'. + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. In addition it plots the Kernel densities of the +#' parameter `b` of the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Poisson.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -751,6 +1187,21 @@ setMethod( } } +#' Plot densities of normal samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled normal +#' parameters and weights. In addiiton it plots the Kernel densities of the +#' parameter `C` of the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Normal.Hier" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -787,6 +1238,21 @@ setMethod( .symmetric.Dens(C, "C") } +#' Plot densities of Student-t samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Student-t +#' parameters and weights. In addiiton it plots the Kernel densities of the +#' parameter `C` of the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Student.Hier" <- function(x, dev) { K <- x@model@K mu <- x@par$mu @@ -834,7 +1300,23 @@ setMethod( .symmetric.Dens(C, "C") } -"dens.Normult.Hier" <- function(x, dev) { +#' Plot densities of multivariate normal samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' multivariate normal parameters and weights. In addition it plots Kernel +#' densities of the logarithmized determinant and the trace of the parameter +#' matrix `C` of the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function +".dens.Normult.Hier" <- function(x, dev) { K <- x@model@K r <- x@model@r mu <- x@par$mu @@ -889,7 +1371,23 @@ setMethod( .symmetric.Dens(cbind(logdetC, trC), C.lab.names) } -"dens.Studmult.Hier" <- function(x, dev) { +#' Plot densities of multivariate Student-t samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled +#' multivariate Student-t parameters and weights. In addition it plots Kernel +#' densities of the logarithmized determinant and the trace of the parameter +#' matrix `C` of the hierarchical prior. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function +".dens.Studmult.Hier" <- function(x, dev) { K <- x@model@K r <- x@model@r mu <- x@par$mu @@ -962,7 +1460,23 @@ setMethod( ### Logic ### Logic subseq Hier: Creates a subsequence for the sample -### of the Poisson hyper parameter 'b'. +### of the Poisson hyper parameter 'b'. + +#' Generates sub-chains from Poisson MCMC samples with hierarchical prior +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Poisson `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Poisson.Hier" <- function(obj, index) { obj@hyper$b <- array(obj@hyper$b[index], dim = c(obj@M, 1) @@ -970,6 +1484,22 @@ setMethod( return(obj) } +#' Generates sub-chains from Normal and Student-t MCMC samples with +#' hierarchical prior +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Normal or Student-t `model` by defining an +#' `index` array specifying how extraction of sub-samples should be performed. +#' Has errors for some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Norstud.Hier" <- function(obj, index) { obj@hyper$C <- array(obj@hyper$C[index], dim = c(obj@M, 1) @@ -977,9 +1507,25 @@ setMethod( return(obj) } +#' Generates sub-chains from multivariate Normal and Student-t MCMC samples with +#' hierarchical prior +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a multivariate Normal or Student-t `model` by +#' defining an `index` array specifying how extraction of sub-samples should be +#' performed. Has errors for some `mcmcoutput` sub-classes. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutput` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Normultstud.Hier" <- function(obj, index) { obj@hyper$C <- array(obj@hyper$C[index, ], dim = c(obj@M, obj@model@K) ) return(obj) -} +} \ No newline at end of file diff --git a/R/mcmcoutputfixhierpost.R b/R/mcmcoutputfixhierpost.R index cc69758..e72b9ed 100644 --- a/R/mcmcoutputfixhierpost.R +++ b/R/mcmcoutputfixhierpost.R @@ -15,6 +15,25 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputfixhierpost` class +#' +#' @description +#' This class inherits from the `mcmcoutputfixhier` class and adds posterior +#' density parameters to the MCMC sampling output. The storage of posterior +#' parameters is controlled by the slot `storepost` in the [mcmc][mcmc_class] +#' class. If set to `TRUE` posterior parameters are stored in the output of the +#' MCMC sampling. +#' +#' @slot post A named list containing a named list `par` with arrays for the +#' posterior density parameters. +#' @exportClass mcmcoutputfixhierpost +#' @describeIn mcmcoutput_class +#' +#' @seealso +#' * [mcmcoutputfixhier][mcmcoutput_class] for the parent class +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmc][mcmc_class] for the class defining the MCMC hyper-parameters +#' * [mcmc()] for the `mcmc` class constructor .mcmcoutputfixhierpost <- setClass("mcmcoutputfixhierpost", representation(post = "list"), contains = c("mcmcoutputfixhier"), @@ -25,6 +44,17 @@ prototype(post = list()) ) +#' Shows a summary of an `mcmcoutputfixhierpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputfixhierpost` object gives an overview +#' of the `mcmcoutputfixhierpost` object. +#' +#' @param object An `mcmcoutputfixhierpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class setMethod( "show", "mcmcoutputfixhierpost", function(object) { @@ -60,6 +90,52 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. If `lik` is set to `0` the parameters of the components and the +#' posterior parameters are plotted together with `K-1` weights. +#' +#' Note that this method calls the equivalent method from the parent class +#' `mcmcoutputfixhier`. +#' +#' @param x An `mcmcoutputfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputfixhierpost", @@ -73,6 +149,47 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' Note that this method calls the equivalent method from the parent class +#' `mcmcoutputfixhier`. +#' +#' @param x An `mcmcoutputfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputfixhierpost", @@ -84,6 +201,46 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' Note that this method calls the equivalent method from the parent class +#' `mcmcoutputfixhier`. +#' +#' @param x An `mcmcoutputfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputfixhierpost", @@ -95,6 +252,45 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this methid calls the equivalent method from the parent class +#' `mcmcoutputfixhier`. +#' +#' @param x An `mcmcoutputfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputfixhierpost", @@ -106,6 +302,45 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method calls the equivalent method of the parent class +#' `mcmcoutputfixhier`. +#' +#' @param x An `mcmcoutputfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputfixhierpost", @@ -117,6 +352,45 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method calls the equivalent method of the parent class +#' `mcmcoutputfixhier`. +#' +#' @param x An `mcmcoutputfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputfixhierpost", @@ -128,6 +402,22 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' Note that this method calls the equivalent method from the parent class and +#' adds the sub-chains for the posterior density parameters. +#' +#' @param object An `mcmcoutput` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputfixhierpost", @@ -151,6 +441,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutput` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputfixhierpost", diff --git a/R/mcmcoutputfixpost.R b/R/mcmcoutputfixpost.R index ec2f4e0..9b58a59 100644 --- a/R/mcmcoutputfixpost.R +++ b/R/mcmcoutputfixpost.R @@ -15,6 +15,26 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutput` class for fixed indicators and posterior parameters +#' +#' @description +#' The `mcmcoutputfixpost` class inherits from the `mcmcoutputfix` class and +#' adds a slot to store the parameters of the posterior distribution from which +#' the component parameters are drawn. The storage of posterior parameters is +#' controlled by the slot `storepost` in the [mcmc][mcmc_class] class. If set +#' to `TRUE` posterior parameters are stored in the output of the MCMC sampling. +#' +#' @slot post A named list containing a list `par` that contains the posterior +#' parameters as named arrays. +#' @exportClass mcmcoutputfixpost +#' @describeIn mcmcoutput_class +#' +#' @seealso +#' * [mcmcoutputfix][mcmcoutput_class] for the parent class +#' * [mcmcoutputpost][mcmcoutput_class] for the corresponding class for unknown +#' indicators. +#' * [mcmc][mcmc_class] for the class defining the MCMC hyper-parameters +#' * [mcmc()] for the constructor of the [mcmc][mcmc_class] class .mcmcoutputfixpost <- setClass("mcmcoutputfixpost", representation(post = "list"), contains = c("mcmcoutputfix"), @@ -25,6 +45,17 @@ prototype(post = list()) ) +#' Shows a summary of an `mcmcoutputfixpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputfixpost` object gives an overview +#' of the `mcmcoutputfixpost` object. +#' +#' @param object An `mcmcoutputfixpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class setMethod( "show", "mcmcoutputfixpost", function(object) { @@ -56,6 +87,51 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. If `lik` is set to `0` the parameters of the components and the +#' posterior parameters are plotted together with `K-1` weights. +#' +#' Note that this method calls the equivalent method from the parent class +#' `mcmcoutputfix`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputfixpost", @@ -69,6 +145,46 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' Note that this method calls the equivalent method from the parent class +#' `mcmcoutputfix`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputfixpost", @@ -80,6 +196,45 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' Note that this methid calls the equivalent method from the parent class +#' `mcmcoutputfix`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputfixpost", @@ -91,6 +246,44 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this methid calls the equivalent method from the parent class +#' `mcmcoutputfix`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputfixpost", @@ -102,6 +295,44 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method calls the equivalent method of the parent class +#' `mcmcoutputfix`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputfixpost", @@ -113,6 +344,44 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this methid calls the equivalent method of the parent class +#' `mcmcoutputfix`. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputfixpost", @@ -124,6 +393,22 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' Note that this method calls the equivalent method from the parent class and +#' adds the sub-chains for the posterior density parameters. +#' +#' @param object An `mcmcoutput` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputfixpost", @@ -146,6 +431,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutput` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputfixpost", @@ -171,6 +465,32 @@ setMethod( } ) +#' Getter method of `mcmcoutputfixpost` class. +#' +#' Returns the `post` slot. +#' +#' @param object An `mcmcoutputfixpost` object. +#' @returns The `post` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getPost(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPost", "mcmcoutputfixpost", function(object) { @@ -181,6 +501,24 @@ setMethod( ## No setters as users are not intended to manipulate ## ## this object. ## +#' Generates sub-chains from Poisson MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Poisson `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. Note, this method is only supplementing the +#' method from the parent class by adding the sub-chains for the parameters of +#' the posterior density. +#' +#' +#' @param obj An `mcmcoutputfixpost` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutputfixpost` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Poisson.Post" <- function(obj, index) { if (obj@model@K == 1) { obj@post$par$a <- array(obj@post$par$a[index], @@ -196,6 +534,22 @@ setMethod( return(obj) } +#' Swaps elements in Poisson MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Poisson MCMC samples. Calls the C++-function +#' `swap_cc()`. Note that this function only complements the equivalent +#' functionality of the parent class by also swapping the posterior density +#' parameters. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Poisson.Post" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@post$par$a <- swap_cc(obj@post$par$a, index) @@ -203,6 +557,24 @@ setMethod( return(obj) } +#' Generates sub-chains from Binomial MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Binomial `model` by defining an `index` array +#' specifying how extraction of sub-samples should be performed. Has errors for +#' some `mcmcoutput` sub-classes. Note, this method is only supplementing the +#' method from the parent class by adding the sub-chains for the parameters of +#' the posterior density. +#' +#' +#' @param obj An `mcmcoutputfixpost` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutputfixpost` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Binomial.Mcmcoutputfixpost" <- function(obj, index) { if (obj@model@K == 1) { obj@post$par$a <- array(obj@post$par$a[index], @@ -218,6 +590,22 @@ setMethod( return(obj) } +#' Swaps elements in Binomial MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Binomial MCMC samples. Calls the C++-function +#' `swap_cc()`. Note that this function only complements the equivalent +#' functionality of the parent class by also swapping the posterior density +#' parameters. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Binomial.Mcmcoutputfixpost" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@post$par$a <- swap_cc(obj@post$par$a, index) @@ -225,6 +613,24 @@ setMethod( return(obj) } +#' Generates sub-chains from Normal or Student-t MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a Normal or Student-t `model` by defining an +#' `index` array specifying how extraction of sub-samples should be performed. +#' Has errors for some `mcmcoutput` sub-classes. Note, this method is only +#' supplementing the method from the parent class by adding the sub-chains for +#' the parameters of the posterior density. +#' +#' +#' @param obj An `mcmcoutputfixpost` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutputfixpost` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Norstud.Mcmcoutputfixpost" <- function(obj, index) { if (obj@model@K == 1) { obj@post$par$mu$b <- array(obj@post$par$mu$b[index], @@ -248,6 +654,22 @@ setMethod( return(obj) } +#' Swaps elements in Normal or Student-t MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with Normal or Student-t MCMC samples. Calls the +#' C++-function `swap_cc()`. Note that this function only complements the +#' equivalent functionality of the parent class by also swapping the posterior +#' density parameters. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Norstud.Mcmcoutputfixpost" <- function(obj, index) { ## Rcpp::export 'swap_cc' obj@post$par$mu$b <- swap_cc(obj@post$par$mu$b, index) @@ -257,6 +679,24 @@ setMethod( return(obj) } +#' Generates sub-chains from multivariate Normal or Student-t MCMC samples +#' +#' @description +#' For internal usage only. This function generates sub-chains from an +#' `mcmcoutput` object with a multivariate Normal or Student-t `model` by +#' defining an `index` array specifying how extraction of sub-samples should be +#' performed. Has errors for some `mcmcoutput` sub-classes. Note, this method +#' is only supplementing the method from the parent class by adding the +#' sub-chains for the parameters of the posterior density. +#' +#' +#' @param obj An `mcmcoutputfixpost` object containing all MCMC samples. +#' @param index An array specifying the extraction of sub-samples. +#' @return An `mcmcoutputfixpost` object containing sub-chains. +#' @noRd +#' +#' @seealso +#' * [subseq()] for the calling method ".subseq.Normultstud.Mcmcoutputfixpost" <- function(obj, index) { if (obj@model@K == 1) { obj@post$par$mu$b <- obj@post$par$mu$b[index, ] @@ -272,6 +712,22 @@ setMethod( return(obj) } +#' Swaps elements in multivariate Normal or Student-t MCMC samples. +#' +#' @description +#' For internal usage only. This function swaps elements for each row in an +#' `mcmcoutput` object with multivariate Normal or Student-t MCMC samples. +#' Calls the C++-function `swap_cc()`. Note that this function only complements +#' the equivalent functionality of the parent class by also swapping the +#' posterior density parameters. +#' +#' @param obj An `mcmcoutput` object containing all MCMC samples. +#' @param index An array specifying the element swapping. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd +#' +#' @seealso +#' * [swapElements()] for the calling method ".swapElements.Normultstud.Mcmcoutputfixpost" <- function(obj, index) { ## Rcpp::export 'swap_3d_cc' obj@post$par$mu$b <- swap_cc(obj@post$par$mu$b, index) diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index ad58da0..3cd9f0d 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -15,6 +15,26 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputhier` class +#' +#' @description +#' This class inherits from the `mcmcoutputbase` class and stores draws from +#' MCMC sampling with unknown indicators and an hierarchical prior. It adds to +#' its parent class a slot for storing the parameters of the hierarchical prior. +#' +#' To use an hierarchical prior in MCMC sampling the `prior` object needs to +#' have set slot `@hier` to `TRUE`. +#' +#' @slot hyper A named list containing the arrays with parameters from the +#' hierarchical prior. +#' @exportClass mcmcoutputhier +#' @rdname mcmcoutputhier-class +#' +#' @seealso +#' * [mcmcoutputbase-class] for the parent class +#' * [prior-class] for the class specifying the prior distribution +#' * [prior()] for the `prior` class constructor +#' * [priordefine()] for the advanced `prior` class constructor .mcmcoutputhier <- setClass("mcmcoutputhier", representation(hyper = "list"), contains = c("mcmcoutputbase"), @@ -25,6 +45,17 @@ prototype(hyper = list()) ) +#' Shows a summary of an `mcmcoutputhier` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputhier` object gives an overview +#' of the `mcmcoutputhier` object. +#' +#' @param object An `mcmcoutputhier` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class setMethod( "show", "mcmcoutputhier", function(object) { @@ -74,6 +105,50 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputhier", @@ -111,6 +186,42 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputhier", @@ -126,6 +237,43 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputhier", @@ -141,6 +289,41 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputhier", @@ -152,6 +335,41 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputhier", @@ -163,6 +381,42 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputhier", @@ -174,6 +428,22 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' Note, this method calls the equivalent method of the parent class and then +#' adds to it the sub-chains for the parameters of the hierarchical prior. +#' +#' @param object An `mcmcoutput` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputhier", @@ -193,6 +463,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutput` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputhier", @@ -205,6 +484,31 @@ setMethod( } ) +#' Getter method of `mcmcoutputhier` class. +#' +#' Returns the `hyper` slot. +#' +#' @param object An `mcmcoutputhier` object. +#' @returns The `hyper` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getHyper(f_output) +#' +#' @seealso +#' * [mcmcoutputhier-class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getHyper", "mcmcoutputhier", function(object) { @@ -221,9 +525,21 @@ setMethod( ### Plot ### Plot traces -### Plot traces Poisson: Plots the traces of the MCMC sample -### for the Poisson parameters, the weights and the hyper- -### parameter 'b'. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model. +#' +#' @param x An `mcmcoutputhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".traces.Poisson.Base.Hier" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 @@ -270,9 +586,22 @@ setMethod( } ### Plot Histograms -### Plot Histograms Poisson: Plots histograms for -### the Poisson parameters the weights and the hyper- -### parameter b. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. In addition it plots the histogram of the +#' parameter `b` of the hierarchical prior. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the smapled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".hist.Poisson.Base.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -294,9 +623,22 @@ setMethod( } ### Plot Densities -### Plot Densities Poisson: Plots Kernel densities for -### the Poisson parameters the weights and the hyper- -### parameter b. + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. In addition it plots the Kernel densities of the +#' parameter `b` of the hierarchical prior. +#' +#' @param x An `mcmcoutputhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".dens.Poisson.Base.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index 8adbf15..6f867f6 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -15,6 +15,33 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputhierpost` class +#' +#' @description +#' This class stores samples from bayesian estimation with hierarchical prior +#' and unknown indicators. It inherits from `mcmcoutputhier` and adds to it a +#' slot to store the parameters from the posterior density. For a model with +#' unknown indicators the slot `@@indicfix` in the `model` object specifying +#' the finite mixture model must be set to `FALSE` (default). Sampling with a +#' hierarchical prior is activated by setting the slot `@@hier` in the `prior` +#' object to `TRUE` (default). Finally, to store parameters for the posterior +#' density the hyper-parameter `storepost` in the `mcmc` object must be set to +#' `TRUE` (default). +#' +#' @slot post A named list containing a named list `par` that contains arrays +#' storing the sampled posterior density parameters. +#' @exportClass mcmcoutputhierpost +#' @rdname mcmcoutputhierpost-class +#' +#' @seealso +#' * [mcmcoutputhier-class] for the parent class +#' * [prior-class] for the class specifying the prior distribution +#' * [prior()] for the `prior` class constructor +#' * [priordefine()] for the advanced `prior` class constructor +#' * [mcmc-class] for the class defining the hyper-parameters +#' * [mcmc()] for the `mcmc` class constructor +#' * [model-class] for the `model` class definition +#' * [model()] for the `model` class constructor .mcmcoutputhierpost <- setClass("mcmcoutputhierpost", representation(post = "list"), contains = c("mcmcoutputhier"), @@ -28,6 +55,14 @@ ## Set 'mcmcoutput' to the virtual class inheriting ## ## to each other 'mcmcoutput' class. ## ## This is done to simplify dispatching methods. ## +#' Finmix `mcmcoutput` class union +#' +#' @description +#' This class union is set to dispatch methods for `mcmcoutput` objects from +#' MCMC sampling. +#' +#' @exportClass mcmcoutput +#' @describeIn mcmcoutput_class setClassUnion( "mcmcoutput", c( @@ -42,6 +77,18 @@ setClassUnion( ) ) +#' Shows a summary of an `mcmcoutputhierpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputhierpost` object gives an overview +#' of the `mcmcoutputhierpost` object. +#' +#' @param object An `mcmcoutputhierpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputhierpost-class SHows a short summary of the object's +#' slots setMethod( "show", "mcmcoutputhierpost", function(object) { @@ -99,6 +146,51 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s If `lik` is set to `0` the parameters of the components and the +#' posterior parameters are plotted together with `K-1` weights. +#' +#' Note that this method calls the equivalent method from the parent class. +#' +#' @param x An `mcmcoutputhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputhierpost", @@ -112,6 +204,46 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' Note, this method calls the equivalent method of the parent class. +#' +#' @param x An `mcmcoutputhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputhierpost", @@ -123,6 +255,46 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' Note that this method calls the equivalent method of the parent class. +#' +#' @param x An `mcmcoutputhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputhierpost", @@ -134,6 +306,43 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method calls the equivalent method of the parent class. +#' +#' @param x An `mcmcoutputhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputhierpost", @@ -145,6 +354,43 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method calls the equivalent method from the parent class. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputhierpost", @@ -156,6 +402,44 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method calls the equivalent method of the parent class. +#' +#' @param x An `mcmcoutputhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputhierpost", @@ -167,6 +451,23 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description +#' Calling [subseq()] constructs an MCMC sub-chain from the samples in the +#' passed-in `mcmcoutput` object specfied by the index `array` in `index`. This +#' can be advantageous, if chains are non-stationary. For successful MCMC +#' sampling the chain must be converged to the target distribution, the true +#' distribution of parameters, weights and indicators. +#' +#' Note, this method calls the equivalent method of the parent class and then +#' adds to it the sub-chains for the parameters of the posterior density by +#' calling a function from the `mcmcoutputfixpost` class. +#' +#' @param object An `mcmcoutputhierpost` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutputhierpost` object containing the values from the sub-chain. +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputhierpost", @@ -189,6 +490,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutputhierpost` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutputhierpost` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputhierpost", @@ -205,16 +515,41 @@ setMethod( if (dist == "poisson") { .swapElements.Poisson.Post(object, index) } else if (dist == "binomial") { - .swapElements.binomial.Mcmcoutputfixpost(object, index) + .swapElements.Binomial.Mcmcoutputfixpost(object, index) } else if (dist %in% c("normal", "student")) { .swapElements.Norstud.Mcmcoutputfixpost(object, index) } else if (dist %in% c("normult", "studmult")) { - .swapElements.Normultstud(object, index) + .swapElements.Normultstud.Mcmcoutputfixpost(object, index) } } } ) +#' Getter method of `mcmcoutputhierpost` class. +#' +#' Returns the `post` slot. +#' +#' @param object An `mcmcoutputhierpost` object. +#' @returns The `post` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getPost(f_output) +#' +#' @seealso +#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPost", "mcmcoutputhierpost", function(object) { diff --git a/R/mcmcoutputpermbase.R b/R/mcmcoutputpermbase.R index 8e21d90..0f01441 100644 --- a/R/mcmcoutputpermbase.R +++ b/R/mcmcoutputpermbase.R @@ -15,6 +15,28 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermbase` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note that this class inherits all of its slots from the parent classes. +#' +#' @exportClass mcmcoutputpermbase +#' @describeIn mcmcoutputperm_class +#' @seealso +#' * [mcmcoutputbase][mcmcoutput_class] for the parent class +#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermbase <- setClass("mcmcoutputpermbase", contains = c( "mcmcpermind", @@ -26,6 +48,42 @@ } ) +#' Initializer of the `mcmcoutputpermbase` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param relabel A character specifying the relabeling algorithm used for +#' permuting the MCMC samples. +#' @param weightperm An array of dimension `Mperm x K` containing the +#' relabeled weight parameters. +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param entropyperm An `array` of dimension `Mperm x 1` containing the +#' entropy for each MCMC permuted draw. +#' @param STperm An `array` of dimension `Mperm x 1` containing all permuted +#' MCMC states, for the last observation in slot `@@y` of the `fdata` object +#' passed in to [mixturemcmc()] where a state is defined for non-Markov +#' models as the last indicator of this observation. +#' @param Sperm An `array` of dimension `N x storeS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' of the `mcmc` object passed into [mixturemcmc()]. +#' @param NKperm +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermbase", function(.Object, mcmcoutput, Mperm = integer(), @@ -34,7 +92,7 @@ setMethod( entropyperm = array(), STperm = array(), Sperm = array(), NKperm = array()) { .Object@M <- mcmcoutput@M - .Object@burnin <- mcmcout@burnin + .Object@burnin <- mcmcoutput@burnin .Object@ranperm <- mcmcoutput@ranperm .Object@par <- mcmcoutput@par .Object@weight <- mcmcoutput@weight @@ -58,6 +116,17 @@ setMethod( } ) +#' Shows a summary of an `mcmcoutputpermbase` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermbase` object gives an overview +#' of the `mcmcoutputpermbase` object. +#' +#' @param object An `mcmcoutputpermbase` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermbase", function(object) { @@ -135,6 +204,53 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermbase", @@ -172,6 +288,47 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling. +#' +#' Note, this method is so far only implemented for mictures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermbase", @@ -187,6 +344,44 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermbase", @@ -202,6 +397,47 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermbase", @@ -217,6 +453,47 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermbase", @@ -232,6 +509,47 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson or Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermbase", @@ -252,8 +570,21 @@ setMethod( ### Plot ### Traces -### Traces Poisson: Plots traces for all Poisson parameters -### and the weights. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model. +#' +#' @param x An `mcmcoutputpermbase` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Poisson.Base" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 - 1 @@ -292,6 +623,20 @@ setMethod( mtext(side = 1, "Iterations", cex = 0.7, line = 3) } +#' Plots traces of Binomial mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Binomial mixture model. +#' +#' @param x An `mcmcoutputpermbase` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Binomial.Base" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 - 1 @@ -330,6 +675,20 @@ setMethod( mtext(side = 1, "Iterations", cex = 0.7, line = 3) } +#' Plots traces of exponential mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a exponential mixture model. +#' +#' @param x An `mcmcoutputpermbase` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Exponential.Base" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 - 1 @@ -368,6 +727,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of sampled weights +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' of the weights for any mixture model. +#' +#' @param x An `mcmcoutputpermbase` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Weights.Base" <- function(x, dev, col) { weight <- x@weightperm K <- x@model@K @@ -405,6 +778,20 @@ setMethod( } ### Traces log-likelihoods: Plots traces for the log-likelihoods. +#' Plots traces of log-likelihood samples +#' +#' @description +#' For internal usage only. This function plots the traces for the +#' log-likelihoods of sampled values from any mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Log.Base" <- function(x, dev) { if (.check.grDevice() && dev) { dev.new(title = "Log Likelihood Traceplots (permuted)") @@ -453,8 +840,21 @@ setMethod( } ### Histograms -### Histograms Poisson: Plots histograms for all Poisson -### parameters and the weights. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".permhist.Poisson.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -473,6 +873,20 @@ setMethod( .symmetric.Hist(vars, lab.names) } +#' Plot histograms of Binomial samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Binomial +#' parameters and weights. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".permhist.Binomial.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -492,8 +906,21 @@ setMethod( } ### Densities -### Densities Poisson: Plots Kernel densities for all Poisson -### parameters and weights. + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".permdens.Poisson.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -512,6 +939,20 @@ setMethod( .symmetric.Dens(vars, lab.names) } +#' Plot densities of Binomial samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Binomial +#' parameters and weights. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".permdens.Binomial.Base" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -528,4 +969,4 @@ setMethod( lab.names[[k]] <- bquote(eta[.(k - K)]) } .symmetric.Dens(vars, lab.names) -} +} \ No newline at end of file diff --git a/R/mcmcoutputpermfix.R b/R/mcmcoutputpermfix.R index d9fe158..708b290 100644 --- a/R/mcmcoutputpermfix.R +++ b/R/mcmcoutputpermfix.R @@ -15,6 +15,28 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermfix` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note that this class inherits all of its slots from the parent classes. +#' +#' @exportClass mcmcoutputpermfix +#' @describeIn mcmcoutputperm_class +#' @seealso +#' * [mcmcoutputfix][mcmcoutput_class] for the parent class +#' * [mcmcpermfix][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermfix <- setClass("mcmcoutputpermfix", contains = c("mcmcpermfix", "mcmcoutputfix"), validity = function(object) { @@ -23,6 +45,28 @@ } ) +#' Initializer of the `mcmcoutputpermfix` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermfix", function(.Object, mcmcoutput, Mperm = integer(), @@ -41,6 +85,17 @@ setMethod( } ) +#' Shows a summary of an `mcmcoutputpermfix` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermfix` object gives an overview +#' of the `mcmcoutputpermfix` object. +#' +#' @param object An `mcmcoutputpermfix` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermfix", function(object) { @@ -77,6 +132,54 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermfix", @@ -110,6 +213,45 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled component parameters +#' from MCMC sampling. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermfix", @@ -125,6 +267,45 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled component parameters +#' from MCMC sampling. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermfix", @@ -140,6 +321,45 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermfix", @@ -155,6 +375,45 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling represetnation of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermfix", @@ -170,6 +429,45 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermfix", @@ -189,7 +487,20 @@ setMethod( ### These functions are not exported. ### Traces -### Traces Poisson: Plots the traces of the Poisson parameter. +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Poisson" <- function(x, dev) { K <- x@model@K trace.n <- K @@ -216,6 +527,20 @@ setMethod( mtext(side = 1, "Iterations", cex = 0.7, line = 3) } +#' Plots traces of Binomial mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Binomial mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Binomial" <- function(x, dev) { K <- x@model@K trace.n <- K @@ -242,18 +567,20 @@ setMethod( mtext(side = 1, "Iterations", cex = 0.7, line = 3) } -### -------------------------------------------------------------------- -### .permtraces.Exponential -### @description Plots traces for parameters of Exponential mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Exponential mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of exponential mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a exponential mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Exponential" <- function(x, dev) { K <- x@model@K trace.n <- K @@ -280,19 +607,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .permtraces.Normal -### @description Plots traces for parameters of a univariate Normal -### mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Normal mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of Normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Normal mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Normal" <- function(x, dev) { K <- x@model@K trace.n <- 2 * K @@ -331,19 +659,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .permtraces.Student -### @description Plots traces for parameters of a univariate Student -### mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Student-t mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Student" <- function(x, dev) { K <- x@model@K trace.n <- 3 * K @@ -394,19 +723,20 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### ------------------------------------------------------------------------- -### .permtraces.Normult -### @description Plots the traces of parameters and moments of a multi- -### variate Normal distribution. -### @par x an mcmcoutputfix object -### dev a logical -### col a logical -### @return a graphical device -### @detail If dev = FALSE, the plot can be sent to a file. In case -### col = TRUE, rainbow colors are used. -### @see ?plotTraces -### @author Lars Simon Zehnder -### ------------------------------------------------------------------------- +#' Plots traces of multivariate normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate normal mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Normult" <- function(x, dev, col) { K <- x@model@K r <- x@model@r @@ -562,19 +892,20 @@ setMethod( } } -### ------------------------------------------------------------------------- -### .permtraces.Studmult -### @description Plots the traces of parameters and moments of a multi- -### variate Student-t distribution. -### @par x an mcmcoutputfix object -### dev a logical -### col a logical -### @return a graphical device -### @detail If dev = FALSE, the plot can be sent to a file. In case -### col = TRUE, rainbow colors are used. -### @see ?plotTraces -### @author Lars Simon Zehnder -### ------------------------------------------------------------------------- +#' Plots traces of multivariate Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate Student-t mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Studmult" <- function(x, dev, col) { K <- x@model@K r <- x@model@r @@ -752,8 +1083,20 @@ setMethod( } } -### Traces log-likelihood: Plots the traces of the log- -### likelihoods. +#' Plots traces of log-likelihood samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from any mixture model. +#' +#' @param x An `mcmcoutputpermfix` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Log" <- function(x, dev, col) { if (.check.grDevice() && dev) { dev.new(title = "Log Likelihood Traceplots") @@ -792,8 +1135,21 @@ setMethod( } ### Histograms -### Histograms Poisson: Plots histograms for all Poisson -### parameters. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".permhist.Poisson" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -807,6 +1163,20 @@ setMethod( .symmetric.Hist(lambda, lab.names) } +#' Plot histograms of Binomial samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Binomial +#' parameters. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".permhist.Binomial" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -820,8 +1190,21 @@ setMethod( .symmetric.Hist(p, lab.names) } ### Densities -### Densities Poisson: Plots densities for all Poisson -### parameters. + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".permdens.Poisson" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -835,6 +1218,20 @@ setMethod( .symmetric.Dens(lambda, lab.names) } +#' Plot densities of Binomial samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Binomial +#' parameters. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".permdens.Binomial" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -849,15 +1246,28 @@ setMethod( } ### Plot Point Processes -### Plot Point Process Poisson: Plots the point process -### for the MCMC draws for lambda. The values are plotted -### against a random normal sample. + +#' Plot point processes of Poisson samples +#' +#' @description +#' For internal usage only. This function plots the point process of sampled +#' Poisson parameters and weights against a random normal sample. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the point process for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotPointProc()] for the calling function ".permpointproc.Poisson" <- function(x, dev) { K <- x@model@K - M <- x@M + M <- x@Mperm if (.check.grDevice() && dev) { dev.new("Point Process Representation (MCMC permuted)") } + # Produces an M x K grid y.grid <- replicate(K, rnorm(M)) if (median(x@parperm$lambda) < 1) { lambda <- log(x@parperm$lambda) @@ -890,6 +1300,20 @@ setMethod( ) } +#' Plot point processes of Binomial samples +#' +#' @description +#' For internal usage only. This function plots the point process of sampled +#' Binomial parameters and weights against a random normal sample. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the point process for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotPointProc()] for the calling method ".permpointproc.Binomial" <- function(x, dev) { K <- x@model@K M <- x@M @@ -925,9 +1349,23 @@ setMethod( } ### Plot sampling representation -### Plot sampling representation Poisson: Plots the sampling -### representation for Poisson parameters. Each parameter sample -### is combined with the other samples. + +#' Plot sampling representation of Poisson samples +#' +#' @description +#' For internal usage only. This function plots the sampling representation of +#' sampled Poisson parameters and weights. Each parameter sample is plotted +#' against its permuted counterpart. +#' +#' @param x An `mcmcoutput` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the sampling representation for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotSampRep()] for the calling function ".permsamprep.Poisson" <- function(x, dev) { K <- x@model@K if (K == 1) { @@ -938,8 +1376,8 @@ setMethod( )) return(FALSE) } - M <- x@M - n <- min(2000, x@M) + M <- x@Mperm + n <- min(2000, x@Mperm) n.perm <- choose(K, 2) * factorial(2) lambda <- x@parperm$lambda if (.check.grDevice() && dev) { @@ -964,6 +1402,22 @@ setMethod( ) } +#' Plot sampling representation of Binomial samples +#' +#' @description +#' For internal usage only. This function plots the sampling representation of +#' sampled Binomial parameters and weights. Each parameter sample is plotted +#' against its permuted counterpart. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the sampling representation for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotSampRep()] for the calling function ".permsamprep.Binomial" <- function(x, dev) { K <- x@model@K if (K == 1) { @@ -1001,8 +1455,22 @@ setMethod( } ### Posterior Density -### Posterior Density Poisson: Plots a contour plot of the -### posterior density of the sampled parameters for K = 2. + +#' Plot posterior density of Poisson samples +#' +#' @description +#' For internal usage only. This function plots the posterior density of +#' sampled Poisson parameters and weights. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the posterior density for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotPostdens()] for the calling function ".permpostdens.Poisson" <- function(x, dev) { K <- x@model@K if (K != 2) { @@ -1048,6 +1516,21 @@ setMethod( } } +#' Plot posterior density of Binomial samples +#' +#' @description +#' For internal usage only. This function plots the posterior density of +#' sampled Binomial parameters and weights. +#' +#' @param x An `mcmcoutputpermfix` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with the posterior density for the sampled parameters +#' and weights. +#' @noRd +#' +#' @seealso +#' * [plotPostDens()] for the calling function ".permpostdens.Binomial" <- function(x, dev) { K <- x@model@K if (K != 2) { @@ -1091,4 +1574,4 @@ setMethod( "Density", xlab = "k = 1", ylab = "k = 2" ) } -} +} \ No newline at end of file diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index 9741461..5d01d25 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -15,18 +15,64 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermfixhier` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note this class inherits all slots from its parent classes. +#' +#' @exportClass mcmcoutputpermfixhier +#' @describeIn mcmcoutputperm_class +#' @seealso +#' * [mcmcoutputpermfix][mcmcoutputperm_class] for the parent class +#' * [mcmcpermfix][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermfixhier <- setClass("mcmcoutputpermfixhier", - contains = c("mcmcpermfix", "mcmcoutputfixhier"), + contains = c("mcmcpermfixhier", "mcmcoutputfixhier"), validity = function(object) { ## else: OK TRUE } ) +#' Initializer of the `mcmcoutputpermfixhier` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param hyperperm A named list containing the permuted parameters of the +#' hierarchical prior. +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermfixhier", function(.Object, mcmcoutput, Mperm = integer(), - parperm = list(), logperm = list()) { + parperm = list(), logperm = list(), hyperperm = list()) { .Object@M <- mcmcoutput@M .Object@burnin <- mcmcoutput@burnin .Object@ranperm <- mcmcoutput@ranperm @@ -38,10 +84,22 @@ setMethod( .Object@Mperm <- Mperm .Object@parperm <- parperm .Object@logperm <- logperm + .Object@hyperperm <- hyperperm .Object } ) +#' Shows a summary of an `mcmcoutputpermfixhier` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermfixhier` object gives an overview +#' of the `mcmcoutputpermfixhier` object. +#' +#' @param object An `mcmcoutputpermfixhier` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermfixhier", function(object) { @@ -71,6 +129,10 @@ setMethod( " logperm : List of", length(object@logperm), "\n" ) + cat( + " hyperperm : List of", + length(object@hyperperm), "\n" + ) cat( " model : Object of class", class(object@model), "\n" @@ -82,6 +144,52 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermfixhier", @@ -115,6 +223,47 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' Note, this method is so far only implemented for Poisson and Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermfixhier", @@ -130,6 +279,47 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' Note, this method is so far only implemented for mixtures of Poisson or +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermfixhier", @@ -145,6 +335,47 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is so far only implemented for mixture models of Poisson +#' or Binomial distributons. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermfixhier", @@ -160,6 +391,44 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermfixhier", @@ -175,6 +444,46 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson and Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermfixhier", @@ -194,8 +503,23 @@ setMethod( ### These functions are not exported. ### Traces -### Traces Poisson: Plots the traces of Poisson parameters -### and the hyper-parameter 'b'. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model, if an hierarchical prior has been used in +#' sampling. The hyperparameter `b` of the hierarchical Gamma distribution is +#' plotted next to the component parameter traces. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Poisson.Hier" <- function(x, dev) { K <- x@model@K trace.n <- K + 1 @@ -218,7 +542,7 @@ setMethod( cex = 0.6, line = 3 ) } - b <- x@hyper$b + b <- x@hyperperm$b plot(b, type = "l", axes = F, col = "gray68", xlab = "", ylab = "" @@ -229,6 +553,21 @@ setMethod( mtext(side = 1, "Iterations", cex = 0.7, line = 3) } +#' Plots traces of Normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Normal mixture model. The parameters of the hierarchical prior are +#' plotted together with the component parameters. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Normal.Hier" <- function(x, dev) { K <- x@model@K trace.n <- 2 * K + 1 @@ -263,7 +602,7 @@ setMethod( cex = .6, line = 3 ) } - C <- x@hyper$C + C <- x@hyperperm$C plot(c, type = "l", axes = F, col = "gray68", xlab = "", ylab = "" @@ -274,19 +613,21 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -### -------------------------------------------------------------------- -### .permtraces.Student.Hier -### @description Plots traces for parameters of a univariate Student -### mixture. -### @par x an object of class mcmcoutputfix -### dev an object of class 'logical' -### @detail Plots the traces for each component parameter of an -### Student mixture. If 'dev' is set to FALSE -### (TRUE is default) no device is created, instead -### the graphic can be stored to a file. -### @see ?mcmcoutput, ?plotTraces -### @author Lars Simon Zehnder -### -------------------------------------------------------------------- +#' Plots traces of Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Student-t mixture model. The parameters of the hierarchical prior +#' are plotted together with the component parameters. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Student.Hier" <- function(x, dev) { K <- x@model@K trace.n <- 3 * K + 1 @@ -333,7 +674,7 @@ setMethod( cex = .6, line = 3 ) } - C <- x@hyper$C + C <- x@hyperperm$C plot(C, type = "l", axes = F, col = "gray68", xlab = "", ylab = "" @@ -347,11 +688,26 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } -"permtraces.Normult.Hier" <- function(x, dev, col) { +#' Plots traces of multivariate normal mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate normal mixture model. The parameters of the hierarchical +#' prior are plotted alongside the component parameters. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a grapical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function +".permtraces.Normult.Hier" <- function(x, dev, col) { .permtraces.Normult(x, dev, col) r <- x@model@r K <- x@model@K - C <- x@hyper$C + C <- x@hyperperm$C C.trace <- sapply( seq(1, x@M), function(i) sum(diag(qinmatr(C[i, ]))) @@ -398,11 +754,26 @@ setMethod( mtext(side = 1, "Iterations", cex = .7, line = 3) } +#' Plots traces of multivariate Student-t mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a multivariate Student-t mixture model. The parameters of the +#' hierarchical prior are plotted alongside the component parameters. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Studmult.Hier" <- function(x, dev, col) { .permtraces.Studmult(x, dev, col) r <- x@model@r K <- x@model@K - C <- x@hyper$C + C <- x@hyperperm$C C.trace <- sapply( seq(1, x@M), function(i) sum(diag(qinmatr(C[i, ]))) @@ -452,13 +823,28 @@ setMethod( ### Histograms ### Histograms Poisson: Plots histograms for all Poisson ### parameters and the hyper-parameter 'b'. -".permhist.Poisson.Hier." <- function(x, dev) { +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. In addition the parameters of the hierarchical prior +#' `b` are plotted. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function +".permhist.Poisson.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { dev.new(title = "Histograms (permuted)") } lambda <- x@parperm$lambda - b <- x@hyper$b + b <- x@hyperperm$b vars <- cbind(lambda, b) lab.names <- vector("list", K + 1) for (k in 1:K) { @@ -469,15 +855,29 @@ setMethod( } ### Densities -### Densities Poisson: Plots densities for all Poisson -### parameters and the hyper-parameter 'b'. -".permdens.Poisson.Hier." <- function(x, dev) { + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. In addition the parameters of the hierarchical prior +#' are plotted. +#' +#' @param x An `mcmcoutputpermfixhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function +".permdens.Poisson.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { dev.new(title = "Histograms (permuted)") } lambda <- x@parperm$lambda - b <- x@hyper$b + b <- x@hyperperm$b vars <- cbind(lambda, b) lab.names <- vector("list", K + 1) for (k in 1:K) { @@ -485,4 +885,4 @@ setMethod( } lab.names[[K + 1]] <- "b" .symmetric.Dens(vars, lab.names) -} +} \ No newline at end of file diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index 0c764eb..d3f10f5 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -15,8 +15,31 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermfixhierpost` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note this class inherits all slots from its parent classes. +#' +#' @exportClass mcmcoutputpermfixhierpost +#' @describeIn mcmcoutputperm_class +#' @seealso +#' * [mcmcoutputfixhierpost][mcmcoutput_class] for the parent class +#' * [mcmcpermfix][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermfixhierpost <- setClass("mcmcoutputpermfixhierpost", contains = c( + "mcmcpermfixhier", "mcmcpermfixpost", "mcmcoutputfixhierpost" ), @@ -26,11 +49,37 @@ } ) +#' Initializer of the `mcmcoutputpermfixhier` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param hyperperm A named list containing the (permuted) parameters of the +#' hierarchical prior. +#' @param postperm A named list containing a named list `par` with array(s) of +#' parameters from the posterior density. +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermfixhierpost", function(.Object, mcmcoutput, Mperm = integer(), parperm = list(), logperm = list(), - postperm = list()) { + hyperperm = list(), postperm = list()) { .Object@M <- mcmcoutput@M .Object@burnin <- mcmcoutput@burnin .Object@ranperm <- mcmcoutput@ranperm @@ -43,11 +92,23 @@ setMethod( .Object@Mperm <- Mperm .Object@parperm <- parperm .Object@logperm <- logperm + .Object@hyperperm <- hyperperm .Object@postperm <- postperm .Object } ) +#' Shows a summary of an `mcmcoutputpermfixhierpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermfixhierpost` object gives an overview +#' of the `mcmcoutputpermfixhierpost` object. +#' +#' @param object An `mcmcoutputpermfixhierpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermfixhierpost", function(object) { @@ -85,6 +146,10 @@ setMethod( " postperm : List of", length(object@postperm), "\n" ) + cat( + " hyperperm : List of", + length(object@hyperperm), "\n" + ) cat( " model : Object of class", class(object@model), "\n" @@ -96,6 +161,54 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. If a hierarchical prior +#' has been used in sampling its parameters are plotted alongside the other +#' parameters. +#' +#' @param x An `mcmcoutputpermfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermfixhierpost", @@ -129,6 +242,47 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' Note, this method is so far only implemented for Poisson and Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermfixhierpost", @@ -144,6 +298,47 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' Note, this method is so far only implemented for mixtures of Poisson or +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermfixhierpost", @@ -159,6 +354,46 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is so far only implemented for mixtures of Poisson or +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermfixhierpost", @@ -174,6 +409,46 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method is so far only implemented for mixtures of Poisson or +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampliing representations of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermfixhierpost", @@ -189,6 +464,46 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson and Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermfixhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermfixhierpost", @@ -202,4 +517,4 @@ setMethod( .permpostdens.Binomial(x, dev) } } -) +) \ No newline at end of file diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index f0d8ca1..5ef29c3 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -15,6 +15,14 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutput` class for fixed indicators and posterior parameters +#' +#' @description +#' This class defines the storage of parameters of the posterior distribution. +#' It inherits from the +#' +#' @exportClass mcmcoutputpermfixpost +#' @describeIn mcmcoutputperm_class .mcmcoutputpermfixpost <- setClass("mcmcoutputpermfixpost", contains = c( "mcmcpermfixpost", diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index f7903ee..aadab49 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -15,6 +15,28 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermhier` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note that this class inherits all of its slots from the parent classes. +#' +#' @exportClass mcmcoutputpermhier +#' @describeIn mcmcoutputperm_class +#' @seealso +#' * [mcmcoutputbase][mcmcoutput_class] for the parent class +#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermhier <- setClass("mcmcoutputpermhier", contains = c( "mcmcpermind", @@ -26,6 +48,43 @@ } ) +#' Initializer of the `mcmcoutputpermhier` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param relabel A character specifying the relabeling algorithm used for +#' permuting the MCMC samples. +#' @param weightperm An array of dimension `Mperm\ x K` containing the +#' relabeled weight parameters. +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param entropyperm An `array` of dimension `Mperm\ x 1` containing the +#' entropy for each MCMC permuted draw. +#' @param STperm An `array` of dimension `Mperm\ x 1` containing all permuted +#' MCMC states, for the last observation in slot `@@y` of the `fdata` object +#' passed in to [mixturemcmc()] where a state is defined for non-Markov +#' models as the last indicator of this observation. +#' @param An `array` of dimension `N\ x storeS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' of the `mcmc` object passed into [mixturemcmc()]. +#' @param NKperm An `array` of dimension `Mperm\ x K` containing the numbers +#' of observations assigned to each component. +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermhier", function(.Object, mcmcoutput, Mperm = integer(), @@ -59,6 +118,17 @@ setMethod( } ) +#' Shows a summary of an `mcmcoutputpermhier` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermhier` object gives an overview +#' of the `mcmcoutputpermhier` object. +#' +#' @param object An `mcmcoutputpermhier` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermhier", function(object) { @@ -111,6 +181,10 @@ setMethod( " logperm : List of", length(object@logperm), "\n" ) + cat( + " hyperperm : List of", + length(object@logperm), "\n" + ) cat( " entropyperm :", paste(dim(object@entropyperm), collapse = "x"), "\n" @@ -140,6 +214,50 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. +#' +#' If `lik` is set to `0` the parameters of the components and the hierarchical +#' prior are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class Plots traces of MCMC samples +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermhier", @@ -177,6 +295,46 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling. In addition the parameters of the hierarchical prior are +#' plotted. +#' +#' Note, this method is so far only implemented for mictures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermhier", @@ -192,6 +350,47 @@ setMethod( } ) + +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling. In addition, the parameters of the hierarchical prior +#' are plotted. +#' +#' Note, this method is so far only implemented for mixtures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermhier", @@ -207,6 +406,45 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermhier", @@ -222,6 +460,45 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermhier", @@ -237,6 +514,45 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson or Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermhier", @@ -257,8 +573,21 @@ setMethod( ### Plot ### Traces -### Traces Poisson: Plots the traces for all Poisson -### parameters, the weights and the hpyer-parameter 'b'. + +#' Plots traces of Poisson mixture samples +#' +#' @description +#' For internal usage only. This function plots the traces for sampled values +#' from a Poisson mixture model with hierarchical prior. +#' +#' @param x An `mcmcoutputpermhier` object containing all samples. +#' @param dev A logical indicating if the plot should be shown by a graphical +#' device. +#' @return A plot of the traces of sampled values. +#' @noRd +#' +#' @seealso +#' * [plotTraces()] for the calling function ".permtraces.Poisson.Base.Hier" <- function(x, dev) { K <- x@model@K trace.n <- K * 2 @@ -293,7 +622,7 @@ setMethod( cex = 0.6, line = 3 ) } - b <- x@hyper$b + b <- x@hyperperm$b plot(b, type = "l", axes = F, col = "gray68", xlab = "", ylab = "" @@ -305,8 +634,22 @@ setMethod( } ### Histograms -### Histograms Poisson: plots histograms for all Poisson parameters, -### the weights and the hyper-parameter 'b'. + +#' Plot histograms of Poisson samples +#' +#' @description +#' For internal usage only. This function plots histograms of sampled Poisson +#' parameters and weights. In addition the parameters of the hierarchical prior +#' are plotted. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with histograms for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotHist()] for the calling function ".permhist.Poisson.Base.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -314,7 +657,7 @@ setMethod( } lambda <- x@parperm$lambda weight <- x@weightperm - b <- x@hyper$b + b <- x@hyperperm$b vars <- cbind(lambda, weight[, seq(1:(K - 1))], b) lab.names <- vector("list", 2 * K) for (k in 1:K) { @@ -328,8 +671,22 @@ setMethod( } ### Densities -### Densities Poisson: plots Kernel densities for all Poisson -### parameters, the weights and the hyper-parameter 'b'. + +#' Plot densities of Poisson samples +#' +#' @description +#' For internal usage only. This function plots densities of sampled Poisson +#' parameters and weights. In addition the parameters of the hierarchical prior +#' are plotted. +#' +#' @param x An `mcmcoutputpermhier` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown on a graphical +#' device. +#' @return A plot with densities for the sampled parameters and weights. +#' @noRd +#' +#' @seealso +#' * [plotDens()] for the calling function ".permdens.Poisson.Base.Hier" <- function(x, dev) { K <- x@model@K if (.check.grDevice() && dev) { @@ -337,7 +694,7 @@ setMethod( } lambda <- x@parperm$lambda weight <- x@weightperm - b <- x@hyper$b + b <- x@hyperperm$b vars <- cbind(lambda, weight[, seq(1:(K - 1))], b) lab.names <- vector("list", 2 * K) for (k in 1:K) { @@ -348,4 +705,4 @@ setMethod( } lab.names[[2 * K]] <- "b" .symmetric.Dens(vars, lab.names) -} +} \ No newline at end of file diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index 0c9c5e5..9d43254 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -15,8 +15,32 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermhierpost` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note that this class inherits all of its slots from the parent classes. +#' +#' @exportClass mcmcoutputpermhierpost +#' +#' @describeIn mcmcoutputperm_class Finmix `mcmcoutputpermhierpost` class +#' @seealso +#' * [mcmcoutputbase][mcmcoutput_class] for the parent class +#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermhierpost <- setClass("mcmcoutputpermhierpost", contains = c( + "mcmcpermindhier", "mcmcpermindpost", "mcmcoutputhierpost" ), @@ -26,14 +50,55 @@ } ) +#' Initializer of the `mcmcoutputpermhierpost` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param relabel A character specifying the relabeling algorithm used for +#' permuting the MCMC samples. +#' @param weightperm An array of dimension `Mperm x K` containing the +#' relabeled weight parameters. +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param hyperperm A named list containing the (permuted) parameters of the +#' hierarchical prior. +#' @param postperm A named list containing a named list `par` with array(s) of +#' parameters from the posterior density. +#' @param entropyperm An `array` of dimension `Mperm x 1` containing the +#' entropy for each MCMC permuted draw. +#' @param STperm An `array` of dimension `Mperm x 1` containing all permuted +#' MCMC states, for the last observation in slot `@@y` of the `fdata` object +#' passed in to [mixturemcmc()] where a state is defined for non-Markov +#' models as the last indicator of this observation. +#' @param An `array` of dimension `N x storeS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' of the `mcmc` object passed into [mixturemcmc()]. +#' @param NKperm An `array` of dimension `Mperm x K` containing the numbers +#' of observations assigned to each component. +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermhierpost", function(.Object, mcmcoutput, Mperm = integer(), parperm = list(), relabel = character(), weightperm = array(), logperm = list(), - postperm = list(), entropyperm = array(), - STperm = array(), Sperm = array(), - NKperm = array()) { + hyperperm = list(), postperm = list(), + entropyperm = array(), STperm = array(), + Sperm = array(), NKperm = array()) { .Object@M <- mcmcoutput@M .Object@burnin <- mcmcoutput@burnin .Object@ranperm <- mcmcoutput@ranperm @@ -53,6 +118,7 @@ setMethod( .Object@relabel <- relabel .Object@weightperm <- weightperm .Object@logperm <- logperm + .Object@hyperperm <- hyperperm .Object@postperm <- postperm .Object@entropyperm <- entropyperm .Object@STperm <- STperm @@ -62,6 +128,17 @@ setMethod( } ) +#' Shows a summary of an `mcmcoutputpermhierpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermhierpost` object gives an overview +#' of the `mcmcoutputpermhierpost` object. +#' +#' @param object An `mcmcoutputpermhierpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermhierpost", function(object) { @@ -122,6 +199,10 @@ setMethod( " logperm : List of", length(object@logperm), "\n" ) + cat( + " hyperperm : List of", + length(object@hyperperm), "\n" + ) cat( " postperm : List of", length(object@postperm), "\n" @@ -155,6 +236,54 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. +#' +#' If `lik` is set to `0` the parameters of the components, the posterior +#' parameters, and the parameters of the hierarchical prior are plotted +#' together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermbase` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermhierpost", @@ -177,7 +306,7 @@ setMethod( .permtraces.Weights.Base(x, dev, col) } else if (dist == "student") { .permtraces.Student.Hier(x, dev) - .permtraces.Weights.base(x, dev, col) + .permtraces.Weights.Base(x, dev, col) } else if (dist == "normult") { .permtraces.Normult.Hier(x, dev, col) .permtraces.Weights.Base(x, dev, col) @@ -193,6 +322,46 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling. In addition the parameters of the hierarchical prior are +#' plotted. +#' +#' Note, this method is so far only implemented for mictures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermhierpost", @@ -208,6 +377,46 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling. In addition, the parameters of the hierarchical prior +#' are plotted. +#' +#' Note, this method is so far only implemented for mixtures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermhierpost", @@ -223,6 +432,45 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermhierpost", @@ -238,6 +486,45 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermhierpost", @@ -253,6 +540,45 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson or Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermhierpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermhierpost", @@ -268,6 +594,14 @@ setMethod( } ) +#' Finmix `mcmcoutputperm` class union +#' +#' @description +#' This class union includes all classes that define objects for permuted +#' MCMC samples and is used to dispatch methods for `mcmcoutputperm` objects. +#' +#' @exportClass mcmcoutputperm +#' @noRd setClassUnion( "mcmcoutputperm", c( @@ -280,4 +614,4 @@ setClassUnion( "mcmcoutputpermpost", "mcmcoutputpermhierpost" ) -) +) \ No newline at end of file diff --git a/R/mcmcoutputpermpost.R b/R/mcmcoutputpermpost.R index a931424..cac0a33 100644 --- a/R/mcmcoutputpermpost.R +++ b/R/mcmcoutputpermpost.R @@ -15,6 +15,28 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpermpost` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note that this class inherits all of its slots from the parent classes. +#' +#' @exportClass mcmcoutputpermpost +#' @describeIn mcmcoutputperm_class +#' @seealso +#' * [mcmcoutputbase][mcmcoutput_class] for the parent class +#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermpost <- setClass("mcmcoutputpermpost", contains = c( "mcmcpermindpost", @@ -26,6 +48,45 @@ } ) +#' Initializer of the `mcmcoutputpermpost` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param relabel A character specifying the relabeling algorithm used for +#' permuting the MCMC samples. +#' @param weightperm An array of dimension `Mperm x K` containing the +#' relabeled weight parameters. +#' @param postperm A named list containing a named list `par` with array(s) of +#' parameters from the posterior density. +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param entropyperm An `array` of dimension `Mperm x 1` containing the +#' entropy for each MCMC permuted draw. +#' @param STperm An `array` of dimension `Mperm x 1` containing all permuted +#' MCMC states, for the last observation in slot `@@y` of the `fdata` object +#' passed in to [mixturemcmc()] where a state is defined for non-Markov +#' models as the last indicator of this observation. +#' @param An `array` of dimension `N x storeS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' of the `mcmc` object passed into [mixturemcmc()]. +#' @param NKperm An `array` of dimension `Mperm x K` containing the numbers +#' of observations assigned to each component. +#' +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermpost", function(.Object, mcmcoutput, Mperm = integer(), @@ -61,6 +122,17 @@ setMethod( } ) +#' Shows a summary of an `mcmcoutputpermpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermpost` object gives an overview +#' of the `mcmcoutputpermpost` object. +#' +#' @param object An `mcmcoutputpermpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputperm_class setMethod( "show", "mcmcoutputpermpost", function(object) { @@ -150,6 +222,53 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`. +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' @describeIn mcmcoutputperm_class +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermpost", @@ -187,6 +306,48 @@ setMethod( } ) +# TODO: Gives an error +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling. +#' +#' Note, this method is so far only implemented for mixtures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' @describeIn mcmcoutputperm_class Plots histograms of MCMC samples +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpermpost", @@ -202,6 +363,47 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling. +#' +#' Note, this method is so far only implemented for mixtures of Poisson and +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' @describeIn mcmcoutputperm_class Plots densities of MCMC samples +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermpost", @@ -217,6 +419,47 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotPointProc +#' @describeIn mcmcoutputperm_class Plots point process of MCMC samples +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermpost", @@ -232,6 +475,48 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' Note, this method is only implemented for mixtures of Poisson and Binomial +#' distributions. +#' +#' @param x An `mcmcoutputpermpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotSampRep +#' @describeIn mcmcoutputperm_class Plots sampling representations of MCMC +#' samples +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermpost", @@ -247,6 +532,48 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson or Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutputperm_class Plots posterior densities of component +#' parameters +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermpost", @@ -260,4 +587,4 @@ setMethod( .permpostdens.Binomial(x, dev) } } -) +) \ No newline at end of file diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index add9aab..3b17970 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -15,6 +15,24 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcoutputpost` class +#' +#' @description +#' This class inherits from the `mcmcoutputbase` class and adds posterior +#' density parameters to the MCMC sampling output. The storage of posterior +#' parameters is controlled by the slot `storepost` in the [mcmc][mcmc_class] +#' class. If set to `TRUE` posterior parameters are stored in the output of the +#' MCMC sampling. +#' +#' @slot post A named list containing a named list `par` with arrays for the +#' posterior density parameters. +#' +#' @exportClass mcmcoutputpost +#' @rdname mcmcoutputpost-class +#' +#' @seealso +#' * [mcmcoutputbase-class] for the parent class +#' * [mixturemcmc()] for performing MCMC sampling for finite mixture modeling .mcmcoutputpost <- setClass("mcmcoutputpost", representation(post = "list"), contains = c("mcmcoutputbase"), @@ -25,6 +43,17 @@ prototype(post = list()) ) +#' Shows a summary of an ` mcmcoutputpost` object. +#' +#' @description +#' Calling [show()] on an ` mcmcoutputpost` object gives an overview +#' of the ` mcmcoutputpost` object. +#' +#' @param object An ` mcmcoutputpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutput_class Shows a short summary of the object's slots setMethod( "show", "mcmcoutputpost", function(object) { @@ -74,6 +103,52 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotTraces(f_output, lik = 0) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpost", @@ -87,6 +162,43 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' @param x An `mcmcoutputpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotHist(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotHist", signature( x = "mcmcoutputpost", @@ -98,6 +210,45 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' @param x An `mcmcoutputpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpost", @@ -109,6 +260,43 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' @param x An ` mcmcoutputpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPointProc(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpost", @@ -120,6 +308,43 @@ setMethod( } ) +#' Plot sampling representations for the component parameters. +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An ` mcmcoutputpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpost", @@ -131,6 +356,44 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' @param x An ` mcmcoutputpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' @describeIn mcmcoutput_class +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpost", @@ -142,6 +405,20 @@ setMethod( } ) +#' Constructs a sub-chain of MCMC samples +#' +#' @description Calling [subseq()] constructs an MCMC sub-chain from the samples +#' in the passed-in `mcmcoutputpost` object specfied by the index `array` in +#' `index`. This can be advantageous, if chains are non-stationary. For +#' successful MCMC sampling the chain must be converged to the target +#' distribution, the true distribution of parameters, weights and indicators. +#' +#' Note, this method calls the equivalent method of the parent class and then +#' adds to it the sub-chains for the parameters of the hierarchical prior. +#' +#' @param object An `mcmcoutputpost` object containing all sampled values. +#' @param index An array specifying the extraction of the sub-chain. +#' @return An `mcmcoutputpost` object containing the values from the sub-chain. setMethod( "subseq", signature( object = "mcmcoutputpost", @@ -164,6 +441,15 @@ setMethod( } ) +#' Swaps elements between components +#' +#' @description +#' Not yet implemented. +#' +#' @param object An `mcmcoutputpost` object containing the sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutputpost` object with swapped elements. +#' @noRd setMethod( "swapElements", signature( object = "mcmcoutputpost", @@ -189,6 +475,31 @@ setMethod( } ) +#' Getter method of `mcmcoutputhier` class. +#' +#' Returns the `hyper` slot. +#' +#' @param object An `mcmcoutputhier` object. +#' @returns The `hyper` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getPost(f_output) +#' +#' @seealso +#' * [mcmcoutputpost-class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPost", "mcmcoutputpost", function(object) { diff --git a/R/mcmcpermfix.R b/R/mcmcpermfix.R index 84e8f9c..6011e39 100644 --- a/R/mcmcpermfix.R +++ b/R/mcmcpermfix.R @@ -15,6 +15,34 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcpermfix` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. +#' +#' Note that for models with fixed indicators `weight`s do not get permuted. +#' +#' @slot Mperm An integer storing the MCMC sample size after relabeling. +#' @slot parperm A named list containing the permuted component parameters. +#' @slot logperm A named list containing the mixture log-likelihood, the prior +#' log-likelihood, and the complete data posterior log-likelihood. +#' @exportClass mcmcpermfix +#' @family mcmcperm-classes +#' @rdname mcmcpermfix-class +#' +#' @seealso +#' * \code{\link{mcmcpermute}} for the calling function +#' * \code{\link{mcmcpermind}} for the corresponding class for models with +#' unknown indicators .mcmcpermfix <- setClass("mcmcpermfix", representation( Mperm = "integer", @@ -33,6 +61,22 @@ ) ## Getters ## + +#' Getter method of `mcmcpermfix` class. +#' +#' Returns the `Mperm` slot. +#' +#' @param object An `mcmcpermfix` object. +#' @returns The `Mperm` slot of the `object`. +#' @aliases mcmcpermfix_class, mcmcpermfixhier_class, mcmcpermfixpost_class, +#' mcmcpermfixhierpost +#' +#' @examples +#' \dontrun{getMperm(mcmcperm)} +#' +#' @seealso +#' * \code{\link{mcmcoutputpermfix_class}} for the inheriting class +#' * \code{\link{mcmcpermute}} for function permuting MCMC samples setMethod( "getMperm", "mcmcpermfix", function(object) { @@ -40,6 +84,20 @@ setMethod( } ) +#' Getter method of `mcmcpermfix` class. +#' +#' Returns the `parperm` slot. +#' +#' @param object An `mcmcpermfix` object. +#' @returns The `parperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getParperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermfix][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getParperm", "mcmcpermfix", function(object) { @@ -47,6 +105,20 @@ setMethod( } ) +#' Getter method of `mcmcpermfix` class. +#' +#' Returns the `logperm` slot. +#' +#' @param object An `mcmcpermfix` object. +#' @returns The `logperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getLogperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermfix][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getLogperm", "mcmcpermfix", function(object) { diff --git a/R/mcmcpermfixpost.R b/R/mcmcpermfixpost.R index 605637f..c35e7a4 100644 --- a/R/mcmcpermfixpost.R +++ b/R/mcmcpermfixpost.R @@ -15,6 +15,32 @@ # You should have received a copy of the GNU General Public License # along with Rcpp. If not, see . +#' Finmix `mcmcpermfixpost` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class is supplementing the parent class by adding a slot to store the +#' permuted parameter samples of the posterior densities. +#' +#' Note that for models with fixed indicators `weight`s do not get permuted. +#' +#' @slot postperm A named list containing a named list `par` with array(s) of +#' parameters from the posterior density. +#' +#' @exportClass mcmcpermfixpost +#' @describeIn mcmcperm_class +#' +#' @seealso +#' * [mcmcpermute()] for the calling function +#' * [mcmcpermfix][mcmcperm_class] for the parent class definition +#' * [mcmcpermindpost][mcmcperm_class] for the corresponding class for models with +#' unknown indicators .mcmcpermfixpost <- setClass("mcmcpermfixpost", representation(postperm = "list"), contains = c("mcmcpermfix"), @@ -26,6 +52,21 @@ ) ## Getters ## + +#' Getter method of `mcmcpermfixpost` class. +#' +#' Returns the `postperm` slot. +#' +#' @param object An `mcmcpermfixpost` object. +#' @returns The `postperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getMperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermfix][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getPostperm", "mcmcpermfixpost", function(object) { diff --git a/R/mcmcpermind.R b/R/mcmcpermind.R index 7a3e8d1..f93be8b 100644 --- a/R/mcmcpermind.R +++ b/R/mcmcpermind.R @@ -15,6 +15,44 @@ # You should have received a copy of the GNU General Public License # along with Rcpp. If not, see . +#' Finmix `mcmcpermind` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class stores the permuted parameters together with the new MCMC sample +#' size and the mixture log-likelihood, the prior log-likelihood, and the +#' complete data posterior log-likelihood. All this slots are inherited from +#' the parent class `mcmcpermfix`. In addition to these slots this class adds +#' permuted weights, permuted indicators as well as the entropies and number +#' of assigned observations per component. +#' +#' @slot relabel A character defining the used algorithm for relabeling. +#' @slot weightperm An array of dimension `Mperm x K` containing the +#' relabeled weight parameters. +#' @slot entropyperm An `array` of dimension `Mperm x 1` containing the +#' entropy for each MCMC permuted draw. +#' @slot STperm An `array` of dimension `Mperm x 1` containing all permuted +#' MCMC states, for the last observation in slot `@@y` of the `fdata` object +#' passed in to [mixturemcmc()] where a state is defined for non-Markov +#' models as the last indicator of this observation. +#' @slot Sperm An `array` of dimension `N x storeS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' of the `mcmc` object passed into [mixturemcmc()]. +#' @slot NKperm An `array` of dimension `Mperm x K` containing the numbers +#' of observations assigned to each component. +#' @exportClass mcmcpermind +#' @describeIn mcmcperm_class +#' +#' @seealso +#' * [mcmcpermute()] for the calling function +#' * [mcmcperfix][mcmcperm_class] for the corresponding class for models with +#' fixed indicators .mcmcpermind <- setClass("mcmcpermind", representation( relabel = "character", @@ -40,6 +78,21 @@ ) ## Getters ## + +#' Getter method of `mcmcpermind` class. +#' +#' Returns the `relabel` slot. +#' +#' @param object An `mcmcpermind` object. +#' @returns The `relabel` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getRelabel(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getRelabel", "mcmcpermind", function(object) { @@ -47,6 +100,20 @@ setMethod( } ) +#' Getter method of `mcmcpermind` class. +#' +#' Returns the `weightperm` slot. +#' +#' @param object An `mcmcpermind` object. +#' @returns The `weightperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getWeightperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getWeightperm", "mcmcpermind", function(object) { @@ -54,6 +121,20 @@ setMethod( } ) +#' Getter method of `mcmcpermind` class. +#' +#' Returns the `entropyperm` slot. +#' +#' @param object An `mcmcpermind` object. +#' @returns The `entropyperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getEntropyperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getEntropyperm", "mcmcpermind", function(object) { @@ -61,6 +142,20 @@ setMethod( } ) +#' Getter method of `mcmcpermind` class. +#' +#' Returns the `STperm` slot. +#' +#' @param object An `mcmcpermind` object. +#' @returns The `STperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getSTperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getSTperm", "mcmcpermind", function(object) { @@ -68,6 +163,20 @@ setMethod( } ) +#' Getter method of `mcmcpermind` class. +#' +#' Returns the `Sperm` slot. +#' +#' @param object An `mcmcpermind` object. +#' @returns The `Sperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getSperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getSperm", "mcmcpermind", function(object) { @@ -75,6 +184,20 @@ setMethod( } ) +#' Getter method of `mcmcpermind` class. +#' +#' Returns the `NKperm` slot. +#' +#' @param object An `mcmcpermind` object. +#' @returns The `NKperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getNKperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getNKperm", "mcmcpermind", function(object) { diff --git a/R/mcmcpermindpost.R b/R/mcmcpermindpost.R index 4602faa..ab710b7 100644 --- a/R/mcmcpermindpost.R +++ b/R/mcmcpermindpost.R @@ -15,6 +15,29 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `mcmcpermindpost` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class is supplementing the parent class by adding a slot to store the +#' permuted parameter samples of the posterior densities. +#' +#' @slot postperm A named list containing a named list `par` with array(s) of +#' parameters from the posterior density. +#' @exportClass mcmcpermindpost +#' @describeIn mcmcperm_class +#' +#' @seealso +#' * [mcmcpermute()] for the calling function +#' * [mcmcpermind][mcmcperm_class] for the parent class definition +#' * [mcmcpermfixpost][mcmcperm_class] for the corresponding class for models +#' with fixed indicators .mcmcpermindpost <- setClass("mcmcpermindpost", representation(postperm = "list"), contains = c("mcmcpermind"), @@ -26,6 +49,23 @@ ) ## Getters ## + +#' Getter method of `mcmcpermindpost` class. +#' +#' Returns the `postperm` slot. +#' +#' @param object An `mcmcpermindpost` object. +#' @returns The `postperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getMperm(mcmcperm)} +#' +#' @seealso +#' * [mcmcoutputpermpost][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermhierpost][mcmcoutput_class] for the inheriting class with +#' hierarchical prior +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getPostperm", "mcmcpermindpost", function(object) { diff --git a/R/mcmcpermute.R b/R/mcmcpermute.R index cb32838..a58b9e3 100644 --- a/R/mcmcpermute.R +++ b/R/mcmcpermute.R @@ -15,6 +15,15 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +# TODO: For fixed indicators permutations are still performed. This is probably +# wrong. Check, if mcmcestimate needs an MCMC permute object. +#' Permute MCMC samples +#' +#' @description +#' This function +#' +#' @export mcmcpermute +#' @import nloptr "mcmcpermute" <- function(mcmcout, fdata = NULL, method = "kmeans", opt_ctrl = list(max_iter = 200L)) { ## Check arguments ## .check.arg.Mcmcpermute(mcmcout) @@ -281,7 +290,7 @@ } else if (dist == "binomial") { index <- .stephens1997b.binomial.Mcmcpermute(obj, fdata.obj) } else if (dist == "exponential") { - index <- .stephens1997b.exponential.Mcmcmpermute(obj, fdata.obj) + index <- .stephens1997b.exponential.Mcmcpermute(obj, fdata.obj) } ## Create 'mcmcoutputperm' objects. startidx <- matrix(seq(1, obj@model@K), @@ -329,7 +338,8 @@ .mcmcoutputpermfixhier(obj, Mperm = obj.swap@M, parperm = obj.swap@par, - logperm = obj.swap@log + logperm = obj.swap@log, + hyperperm = obj.swap@hyper ) } else if (class(obj) == "mcmcoutputfixpost") { .mcmcoutputpermfixpost(obj, @@ -343,6 +353,7 @@ Mperm = obj.swap@M, parperm = obj.swap@par, logperm = obj.swap@log, + hyperperm = obj.swap@hyper, postperm = obj.swap@post ) } else if (class(obj) == "mcmcoutputbase") { @@ -364,6 +375,7 @@ relabel = method, weightperm = obj.swap@weight, logperm = obj.swap@log, + hyperperm = obj.swap@hyper, entropyperm = obj.swap@entropy, STperm = obj.swap@ST, Sperm = obj.swap@S, @@ -389,6 +401,7 @@ relabel = method, weightperm = obj.swap@weight, logperm = obj.swap@log, + hyperperm = obj.swap@hyper, postperm = obj.swap@post, entropyperm = obj.swap@entropy, STperm = obj.swap@ST, diff --git a/R/mcmcstart.R b/R/mcmcstart.R index 0a53a81..36f7b12 100644 --- a/R/mcmcstart.R +++ b/R/mcmcstart.R @@ -15,6 +15,43 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix default starting values +#' +#' @description +#' Calling [mcmcstart()] creates starting values for MCMC sampling. Starting +#' values are constructed for the indicators in the `fdata` argument and the +#' parameters in the `model` argument. In addition an `mcmc` object can be +#' provided in the `varargin` argument to set up all slots consistently for a +#' non-default setting of hyper-parameters. +#' +#' To assing the returned objects directly to existing names the assignment +#' operator `%%=%%` can be used together with a formula concatenating each name +#' with a tilde `~`. See the examples. +#' +#' @param fdata An `fdata` object containing the data. +#' @param model A `model` object specifying the finite mixture model to be +#' estimated. +#' @param varargin Either `NULL` or an `mcmc` object defining (possibly +#' non-default) hyper-parameters. If not provided a default `mcmc` object is +#' created internally and returned. +#' @return A list containing the `fdata` object, the `model` object and an +#' `mcmc` object all set up for MCMC sampling. +#' @export +#' @name mcmcstart +#' +#' @examples +#' # Specify a Poisson model. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Set up all objects for MCMC sampling. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model) +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mixturemcmc()] for the starting MCMC sampling "mcmcstart" <- function(fdata, model, varargin) { ## Check arguments .check.fdata.model.Mcmcstart(fdata, model) @@ -69,6 +106,26 @@ ### non-empty data slot @y. ### If the distributions in 'model' do not correspond to the dimensions ### @r in 'fdata' an error is thrown. +#' Check argument in `mcmcstart` +#' +#' For internal usage only. This function checks the input arguments `fdata` +#' and `model` for consistency. Consistency has to be ensured for the slots +#' `@@dist` in the `model` object and the slot `@@r` in the `fdata` object. +#' A dimension `r>1` calls for a multivariate distribution specified in the +#' `model` object. Furthermore, the `fdata` object must contain data in its +#' `@@y` slot. +#' +#' @param fdata_obj An `fdata` object containing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return None. If any check is not passed an error is thrown. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mixturemcmc()] for the starting MCMC sampling ".check.fdata.model.Mcmcstart" <- function(fdata.obj, model.obj) { .valid.Fdata(fdata.obj) .valid.Model(model.obj) @@ -91,6 +148,23 @@ } ### Check varargin: Argument 'varargin' must be an object of class 'mcmc'. +#' Check argument `varargin` in `mcmcstart` +#' +#' For internal usage only. This function checks the `varargin` input argument. +#' More specifically, it checks if the argument is an `mcmc` object and if it +#' is correctly specified. +#' +#' @param fdata_obj An `fdata` object containing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return None. If any check is not passed an error is thrown. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mixturemcmc()] for the starting MCMC sampling ".check.mcmc.Mcmcstart" <- function(mcmc.obj) { if (class(mcmc.obj) != "mcmc") { stop(paste("Wrong argument. 'mcmc' must be an object of class ", @@ -104,6 +178,24 @@ ### Logic parameters: Generates starting parameters for @dist in ### 'model.obj'. Returns a 'model' object with starting parameters ### in @par. +#' Sets starting parameters for `mcmcstart` +#' +#' For internal usage only. This function sets the parameters of a finite +#' mixture model defined in the slots `@@par` and `@@weight`. +#' +#' @param fdata_obj An `fdata` object containing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @param mcmc_obj An `mcmc` object specifying the hyper-parameters for MCMC +#' sampling. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mixturemcmc()] for the starting MCMC sampling ".parameters.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { K <- model.obj@K dist <- model.obj@dist @@ -121,16 +213,33 @@ if (dist %in% c("poisson", "cond.poisson")) { .parameters.poisson.Mcmcstart(fdata.obj, model.obj) } else if (dist == "exponential") { - .mcmcstart.exponential.Model(fdata.obj, model.obj, mcmc.obj) + .parameters.exponential.Mcmcstart(fdata.obj, model.obj, mcmc.obj) } else if (dist == "binomial") { .parameters.binomial.Mcmcstart(fdata.obj, model.obj) } else if (dist == "normal" || dist == "student") { - .mcmcstart.Norstud.Model(fdata.obj, model.obj, mcmc.obj) + .parameters.Norstud.Mcmcstart(fdata.obj, model.obj, mcmc.obj) } else if (dist %in% c("normult", "studmult")) { - .mcmcstart.Norstudmult.Model(fdata.obj, model.obj, mcmc.obj) + .parameters.Norstudmult.Mcmcstart(fdata.obj, model.obj, mcmc.obj) } } +#' Set up exposures in `mcmcstart` +#' +#' For internal usage only. This function sets up the exposures Poisson mixture +#' model. If the `fdata` object already contains `exposures` these are checked +#' for consistency with the number of observations `N`. if exposures cannot be +#' set an error is thrown. +#' +#' @param fdata_obj An `fdata` object containing the data. +#' @return A matrix containing th exposures. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mixturemcmc()] for the starting MCMC sampling ".mcmcstart.Exp" <- function(data.obj) { r <- data.obj@r N <- data.obj@N @@ -171,6 +280,23 @@ return(exp) } +#' Set up starting parameters for the weights in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting weights for a +#' finite mixture model, by referring to multinomial model for the indicators. +#' Starting weights are chosen to be equally weighted by the number of +#' components in the `model` object's slot `@@K`. +#' +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting weights. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mixturemcmc()] for the starting MCMC sampling ".parameters.multinomial.Mcmcstart" <- function(model.obj) { K <- model.obj@K if (!hasWeight(model.obj)) { @@ -179,6 +305,21 @@ return(model.obj) } +#' Set up starting parameters for a Poisson mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting parameters for +#' a Poisson mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".parameters.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { K <- model.obj@K datam <- getColY(fdata.obj) @@ -200,6 +341,23 @@ return(model.obj) } +#' Set up starting parameters for an exponential mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting parameters for +#' an exponential mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @param mcmc_obj An `mcmc` object containing all hyper-parameters for MCMC +#' sampling. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".parameters.exponential.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { if (!hasPar(model.obj)) { @@ -215,6 +373,21 @@ return(model.obj) } +#' Set up starting parameters for a Binomial mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting parameters for +#' a Binomial mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".parameters.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { if (!hasPar(model.obj) && hasT(fdata.obj, verbose = TRUE)) { datam <- getColY(fdata.obj) @@ -231,7 +404,24 @@ return(model.obj) } -".mcmcstart.Norstud.Model" <- function(fdata.obj, model.obj, +#' Set up starting parameters for a normal or Student-t mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting parameters for +#' a normal or Student-t mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @param mcmc_obj An `mcmc` object containing all hyper-parameters for MCMC +#' sampling. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +".parameters.Norstud.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { datam <- getColY(fdata.obj) K <- model.obj@K @@ -268,7 +458,24 @@ return(model.obj) } -".mcmcstart.Norstudmult.Model" <- function(fdata.obj, model.obj, +#' Set up starting parameters for a multivariate mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting parameters for +#' a multivariate normal or Student-t mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @param mcmc_obj An `mcmc` object containing all hyper-parameters for MCMC +#' sampling. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +".parameters.Norstudmult.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { K <- model.obj@K r <- model.obj@r @@ -314,11 +521,26 @@ return(model.obj) } +#' Set up starting degrees of freedom for a Student-t mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting degrees of +#' freedom for a Student-t mixture model specified by its argument. +#' +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".mcmcstart.Student.Df" <- function(model.obj) { + K <- model.obj@K has.par <- (length(model.obj@par) > 0) if (has.par) { has.df <- "df" %in% names(model.obj@par) - if (!df.in.model) { + if (!has.df) { model.obj@pari$df <- array(10, dim = c(1, K)) validObject(model.obj) } @@ -330,6 +552,21 @@ ### Logic indicators: Returns an 'fdata' object with generated ### indicators. +#' Set up starting indicators for a finite mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting indicators for +#' a finite mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".indicators.Mcmcstart" <- function(fdata.obj, model.obj) { dist <- model.obj@dist if (dist %in% c("poisson", "cond.poisson", "exponential")) { @@ -349,6 +586,21 @@ ### to find initial indicators. If indicators are already ### in slot @S of the 'fdata' object, the 'fdata' object is ### immediately returned. +#' Set up starting indicators for a Poisson mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting indicators for +#' a Poisson or exponential mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".indicators.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { K <- model.obj@K if (!hasS(fdata.obj)) { @@ -366,6 +618,21 @@ return(fdata.obj) } +#' Set up starting indicators for a Binomial mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting indicators for +#' a Binomial mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".indicators.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { if (!hasS(fdata.obj)) { K <- model.obj@K @@ -400,14 +667,33 @@ return(fdata.obj) } +#' Set up starting indicators for a normal or Student-t mixture in `mcmcstart` +#' +#' For internal usage only. This function sets up the starting indicators for +#' a normal or Student-t mixture model specified by its argument. +#' +#' @param fdata_obj An `fdata_obj` storing the data. +#' @param model_obj A `model` object specifying the finite mixture model. +#' @return A `model` object with starting parameters. +#' @noRd +#' @keywords internal +#' +#' @seealso +#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [model][model_class] for the definition of the `model` class +#' * [mcmc][mcmc_class] for the definition of the `mcmc` class ".mcmcstart.Ind.Norstud" <- function(data.obj, model.obj) { K <- model.obj@K - has.S <- .mcmcstart.valid.Ind(data.obj) - datam <- .mcmcstart.Data(data.obj) + # Checks, if slot 'S' ist in 'data.obj'. If not, throws an error + .valid.S.Fdata(data.obj) + # Because of the line above, we can set this.`` + has.S <- TRUE if (has.S) { return(data.obj) } else { if (data.obj@bycolumn) { + .valid.y.Fdata(data.obj) + datam <- data.obj@y data.obj@S <- as.matrix(kmeans(datam^.5, centers = K, nstart = K diff --git a/R/mincol.R b/R/mincol.R index 997f534..d151959 100644 --- a/R/mincol.R +++ b/R/mincol.R @@ -1,6 +1,31 @@ +#' Convert vector into matrix. +#' +#' @description +#' Calling [qinmatr()] on a vector of dimension `r(r+1)/2x1` +#' converts the vector into a symmetric matrix of dimension `rxr`. This +#' function is used to handle the MCMC sampling output from multivariate finite +#' mixture models. To save storage the symmetric variance-covariance matrices +#' of multivariate mixtures are stored vector form. If the covariance matrices +#' are needed for calculations this function helps to restore these matrices +#' from the storage vectors. +#' +#' @param q A vector of dimension `r(r+1)/2x1`. +#' @return A symmetric matrix of dimension `rxr`. +#' +#' @examples +#' # Define a vector. +#' q <- rnorm(n = 6, mean = 0.5, sd = 2) +#' # Generate the symmetric matrix. +#' qinmatr(q) +#' +#' @seealso +#' * [qinmatrmult()] +#' * [qincol()] +#' * [qincolmult()] "qinmatr" <- function(q) { if (length(dim(q)) > 0) { - stop(paste("The argument 'q' has to be an object of dimension 1 x r or r x 1.", + stop(paste("The argument 'q' has to be an array or matrix in column or + row format, i.e. one dimension is 1.", sep = "" ), call. = TRUE @@ -13,6 +38,28 @@ return(tmp) } +#' Convert array of vectors into array of matrices. +#' +#' @description +#' Calling [qinmatrmult()] on multiple vectors of dimension `r(r+1)/2x1` +#' converts these vectors into an array of symmetric matrices of dimension +#' `rxr`. This function is used to handle the MCMC sampling output from +#' multivariate finite mixture models. To save storage the symmetric +#' variance-covariance matrices of multivariate mixtures are stored vector +#' form. If the covariance matrices are needed for calculations this function +#' helps to restore these matrices from the storage vectors. +#' +#' @param q A matrix or array of vectors of dimension `r(r+1)/2x1`. +#' @return An array of symmetric matrices, all of dimension `rxr`. +#' +#' @examples +#' # Convert a matrix of vectors +#' qinmatrmult(matrix(rnorm(36), nrow = 6)) +#' +#' @seealso +#' * [qinmatr()] for converting a single vector into a symmetric matrix +#' * [qincol()] for converting a symmetric matrix into a vector +#' * [qincolmult()] for converting an array of symmetric matrices into vectors "qinmatrmult" <- function(m) { r <- -.5 + sqrt(.25 + 2 * nrow(m)) tmp.array <- array(numeric(), dim = c(r, r, ncol(m))) @@ -22,6 +69,32 @@ return(tmp.array) } +#' Convert a symmetric matrix into a vector +#' +#' @description +#' Calling [qincol()] on a symmetric matrix with dimension `rxr` converts +#' this matrix a vector of length `r(r+1)/2`. This function is used to +#' handle the MCMC sampling output from multivariate finite mixture models. To +#' save storage the symmetric variance-covariance matrices of multivariate +#' mixtures are stored vector form. If the covariance matrices are needed for +#' calculations the functions [qinmatr()] and [qinmatrmult()] helps to restore +#' these matrices from the storage vectors. +#' +#' @param q A symmetric matrix or dimension `rxr`. +#' @return A vector of length `r(r+1)/2`. +#' +#' @examples +#' # Define a vector. +#' q <- rnorm(n = 6, mean = 0.5, sd = 2) +#' # Generate the symmetric matrix. +#' mat <- qinmatr(q) +#' # Convert the matrix back into the vector. +#' qincol(mat) +#' +#' @seealso +#' * [qinmatr()] for converting a single vector into a symmetric matrix +#' * [qinmatrmult()] for converting multiple vectors into symmetric matrices +#' * [qincolmult()] for converting multiple symmetric matrice into vectors "qincol" <- function(m) { r <- ncol(m) index <- 0 @@ -34,6 +107,31 @@ return(qcol) } +#' Convert multiple symmetric matrices into vectors +#' +#' @description +#' Calling [qincolmult()] on an array of symmetric matrices all with dimension +#' `rxr` converts these matrices into an array of vectors with length +#' `r(r+1)/2`. This function is used to handle the MCMC sampling output from +#' multivariate finite mixture models. To save storage the symmetric +#' variance-covariance matrices of multivariate mixtures are stored vector +#' form. If the covariance matrices are needed for calculations the functions +#' [qinmatr()] and [qinmatrmult()] helps to restore these matrices from the +#' storage vectors. +#' +#' @param q A symmetric matrix or dimension `rxr`. +#' @return A vector of length `r(r+1)/2`. +#' +#' @examples +#' # Convert a matrix of vectors +#' matrices <- qinmatrmult(matrix(rnorm(36), nrow = 6)) +#' # Convert these matrices back into vectors. +#' qincolmult(matrices) +#' +#' @seealso +#' * [qinmatr()] for converting a single vector into a symmetric matrix +#' * [qinmatrmult()] for converting multiple vectors into symmetric matrices +#' * [qincol()] for converting a single symmetric matrix into a vector "qincolmult" <- function(a) { r <- dim(a)[1] K <- dim(a)[3] diff --git a/R/mixturemcmc.R b/R/mixturemcmc.R index 96f274e..a88515c 100644 --- a/R/mixturemcmc.R +++ b/R/mixturemcmc.R @@ -15,6 +15,100 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Performs MCMC sampling for finite mixture models +#' +#' @description +#' Calling [mixturemcmc()] performs MCMC sampling on the observations stored +#' in the `fdata` object for the finite mixture model defined in the `model` +#' object. MCMC sampling is performed with a Gibbs sampler for all finite +#' mixture models using a prior that must be defined in the `prior` object. +#' There are possibilities to control the MCMC sampling by hyperparameters +#' stored in the `mcmc` object. +#' +#' @details +#' ## Performance +#' This function is the central part of the `finmix` package. For MCMC sampling +#' it relies on high-performance C++ code using the `Rcpp` and `RcppArmadillo` +#' packages. More specifically, these packages simplify the usage of external +#' C++ code on the objects in `R` memory (enabled by `R`'s `C` interface). +#' Execution of MCMC sampling with the default of 10,000 iterations and a +#' burn-in of 1,000 iterations should finish in a few seconds. +#' +#' ## Algorithms +#' The algorithms used here are for the most part specified in the excellent +#' book \emph{Finite Mixture and Markov Switching Models} by +#' Sylvia Fr\"uwirth-Schnatter. These algorithms rely on Gibbs sampling by +#' alternating between sampling the component and weight parameters of the +#' finite mixture model and the indicators of the data. Thereby, a so-called +#' random permutation is performed at each iteration of the algorithm, i.e. the +#' indicators `S` and the component and weight parameters are permuted by their +#' index. As explained by Fr\"uwirth-Schnatter (2006, Section 3.5.5) label +#' switching in estimation of finite mixture distributions has to be addressed +#' explicitly when Bayesian estimation is used. While in maximum likelihood +#' estimation this is of no concern because only one of the equivalent modes of +#' likelihood function needs to be found, Bayesian estimation needs to explore +#' the full mixture posterior distribution and label switching occurs randomly, +#' but frequently during MCMC sampling. to overcome these issues the sampler is +#' forced to switch labels in a controlled form by randomly permuting the +#' labels of the components. This results in a balanced label switching and as +#' a result the sampler explores the full mixture posterior more thoroughly +#' leading to more robust estimations. +#' +#' ### Starting by sampling the parameters +#' As laid out in the description of the input parameters sampling can start +#' either by sampling the indicators using starting parameters or by sampling +#' the parameters using starting indicators. The latter is for example applied, +#' if indicators are fixed (because they might be known). For starting by +#' sampling the parameters the slot `@@startpar` in the `mcmc` input argument +#' must be set to `TRUE` (default) and starting indicators must be present in +#' slot `@@S` of the `fdata` object. +#' +#' @param fdata An `fdata` object storing the observations in slot `@@y` and +#' the (starting) indicators in slot `@@S`. If sampling should start by +#' sampling the parameters the starting indicators must be defined. +#' @param model A `model` object specifying the finite mixture model. If it +#' should be started by sampling the indicators starting parameters and +#' weights must be defined in slots `@@par` and `@@weight` respectively. +#' @param prior A `prior` object specifying the prior distribution for Bayesian +#' estimation. This object must be fully specified regardless, if sampling +#' should start with the indicators or parameters. See [priordefine()] for +#' choosing automatically a data dependent prior distribution. +#' @param mcmc An `mcmc` object storing the hyper-parameters for MCMC sampling. +#' If slot `@@startpar` is `TRUE` sampling starts by sampling the parameters. +#' Henceforth, it needs starting indicators. +#' @return An object of class [mcmcoutput][mcmcoutput_class] storing the MCMC +#' sampling results. +#' @export +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Complete object slots for consistency. +#' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model, f_mcmc) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the sampled model parameters. +#' getPar(f_output) +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition +#' * [prior][prior-class] for the `prior` class definition +#' * [prior()] for the `prior` class constructor +#' * [priordefine()] for the advanced class constructor of the `prior` class +#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [mcmc()] for the `mcmc` class constructor +#' * [mcmcstart()] for defining starting parameters and/or indicators +#' +#' @references +#' Fr\"uwirth-Schnatter, S. (2006), "Finite Mixture Models and Markov Switching +#' Models", Springer "mixturemcmc" <- function(fdata, model, prior, mcmc) { ## Check arguments mcmc <- .check.args.Mixturemcmc(fdata, model, prior, mcmc, nargs()) @@ -49,17 +143,39 @@ ### Private functions ### These functions are not exported -### Checking -### Check arguments: 'fdata' must contain valid data in @y and in case of -### starting with sampling the parameters indicators in @S. Further, -### the data in @y must match with the specified distribution in @dist -### of 'model'. -### If it should started with sampling the indicators, 'model' must -### contain valid starting parameters in @par and @weight. -### The 'prior' object must contain valid parameters for the prior -### distribution. -### Further, if a fixed indicator model is used, @startpar in 'mcmc' -### must be TRUE and @ranperm must be FALSE. +#' Checks input arguments for MCMC sampling +#' +#' @description +#' For internal usage only. This function checks if the input arguments passed +#' in to [mixturemcmc()] are valid, i.e. `fdata` must contain valid data in +#' slot `@@y` and in case of starting with sampling the parameters indicators +#' in slot `@@S`. Furthermore, the data in slot `@@y` must match with the +#' specified distribution in `@@dist` of the `model` object. +#' If MCMC sampling should start by sampling the indicators, the `model` object +#' must contain valid starting parameters in slots `@@par` and `@@weight`. +#' The `prior` object must contain valid parameters for the prior distribution. +#' Finally, if a fixed indicator model is used, `@@startpar` in `mcmc` must be +#' `TRUE` and `@@ranperm` must be `FALSE`. +#' +#' In addition this function checks for consistency between the four input +#' objects and modifies the hyper-parameters in the `mcmc` object accordingly +#' for the user. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the finite mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object defining the hyper-parameters for MCMC +#' sampling. +#' @param n.args An integer specifying how many arguments have been provided +#' by the user. As all arguments must be provided values below four throw an +#' error. +#' @return An object of class [mcmc][mcmc_class]. If any check does not pass an +#' error is thrown to let the user know, why MCMC sampling cannot be +#' performed with the actual setting. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".check.args.Mixturemcmc" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj, n.args) { ## Check if all arguments are provided @@ -187,14 +303,26 @@ return(mcmc.obj) } -### Validity -### For a Binomial model either the 'data' object -### or the 'model' object must have specified -### repetitions 'T'. This can be either a 'matrix' -### object of dimension N x 1 or 1 x 1 (if all -### repetitions are the same) +#' Checks validity of repetitions for MCMC sampling +#' +#' @description +#' For a Binomial model either the `fdata` object or the `model` object must +#' have specified repetitions in slot `@@T`. This can be either a `matrix` +#' object of dimension `N x 1` or `1 x 1` (if all repetitions are the +#' same). +#' +#' @param data An `fdata` object containing the data. +#' @param model A `model` object specifying the finite mixture model. +#' @return None. If any check does not pass an error is thrown to inform the +#' user of the detected inconsistency. +#' @noRd +#' +#' @seealso +#' * [fdata][fdata_class] for the `fdata` class definition +#' * [model][model_class] for the `model` class definition ".valid.Reps.Binomial" <- function(data, model) { has.reps <- !all(is.na(data@T)) + N <- data@N if (has.reps) { if (data@bycolumn) { if (nrow(data@T) != N && nrow(data@T) != 1) { @@ -278,9 +406,25 @@ ### MCMC ### For each model the MCMC output has to be prepared -### MCMC Poisson: Prepares all data containers for MCMC sampling for -### Poisson mixture models regarding the specifications in 'prior.obj' -### 'model.obj' and 'mcmc.obj'. + +#' Perform MCMC sampling for Poisson mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for Poisson mixture models regarding the specifications in the +#' passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Poisson" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { ## Base slots inherited to every derived class K <- model.obj@K @@ -489,18 +633,24 @@ } ## end no indicfix } -### ---------------------------------------------------------------------------- -### .do.MCMC.Binomial -### @description Performs MCMC simulation for A Binomial mixture model using -### the Gibbs Sampler. -### @par fdata.obj an S4 object of class 'fdata' -### @par model.obj an S4 object of class 'model' -### @par prior.obj an S4 object of class 'prior' -### @par mcmc.obj an S4 object of class 'mcmc' -### @return an S4 object of class 'mcmcoutput' -### @see ?mixturemcmc, ?fdata, ?model, ?prior, ?mcmc, ?mcmcoutput -### @author Lars Simon Zehnder -### ---------------------------------------------------------------------------- +#' Perform MCMC sampling for Binomial mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for Binomial mixture models regarding the specifications in the +#' passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Binomial" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { ## Base slots inherited to every derived 'mcmcoutput' class K <- model.obj@K @@ -603,19 +753,24 @@ } ## End no indicfix } -### ------------------------------------------------------------------------- -### .do.MCMC.Exponential -### @description Prepares all object for the MCMC simulation of an -### Exponential model. -### @param fdata.obj an S4 object of class 'fdata.obj' -### @param model.obj an S4 object of class 'model' -### @param prior.obj an S4 object of class 'prior' -### @param mcmc.obj an S4 object of class 'mcmc' -### @return an S4 object of class union 'mcmcoutput' -### @detail Internally the C++ routine 'mcmc_exponential_cc' is called -### @see ?mixturemcmc, mcmc_exponential_cc -### @author Lars Simon Zehnder -### ------------------------------------------------------------------------- +#' Perform MCMC sampling for exponential mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for exponential mixture models regarding the specifications in the +#' passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Exponential" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { # Base slots inherited to each derived class K <- model.obj@K @@ -703,6 +858,24 @@ return(mcmcout) } +#' Perform MCMC sampling for conditional Poisson mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for conditional Poisson mixture models regarding the specifications +#' in the passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.CondPoisson" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { if (nrow(fdata.obj@exp) == 1) { if (is.na(fdata.obj@exp)) { @@ -920,6 +1093,24 @@ } ## end no indicfix } +#' Perform MCMC sampling for normal mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for normal mixture models regarding the specifications in the +#' passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Normal" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { ## Base slots inherited to each derived class @@ -927,7 +1118,7 @@ N <- fdata.obj@N M <- mcmc.obj@M ranperm <- mcmc.obj@ranperm - burnin <- mcmc.obj@burnin + burnin<- mcmc.obj@burnin ## Set for MCMC default exposures: pars <- list( mu = array(numeric(), dim = c(M, K)), @@ -988,7 +1179,7 @@ hypers <- list(C = array(numeric(), dim = c(M, 1))) ## Model with NO posterior parameters stored if (!mcmc.obj@storepost) { - mcmcout <- mcmcoutputfixhier( + mcmcout <- .mcmcoutputfixhier( M = M, burnin = burnin, ranperm = ranperm, par = pars, log = logs, @@ -1003,10 +1194,10 @@ return(mcmcout) } else { ## Model with posterior parameters stored - mcmcout <- mcmcoutputfixhierpost( + mcmcout <- .mcmcoutputfixhierpost( M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logd, + par = pars, log = logs, hyper = hypers, post = posts, model = model.obj, prior = prior.obj @@ -1103,7 +1294,7 @@ PACKAGE = "finmix" ) if (mcmc.obj@storeS == 0) { - mcmcout@S <- as.array(ias.integer(NA)) + mcmcout@S <- as.array(is.integer(NA)) } return(mcmcout) } else { @@ -1132,6 +1323,24 @@ } ## end no indicfix } +#' Perform MCMC sampling for Student-t mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for Student-t mixture models regarding the specifications in the +#' passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Student" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { ## Base slots inherited to each derived class @@ -1202,7 +1411,7 @@ hypers <- list(C = array(numeric(), dim = c(M, 1))) ## Model with NO posterior parameters stored if (!mcmc.obj@storepost) { - mcmcout <- mcmcoutputfixhier( + mcmcout <- .mcmcoutputfixhier( M = M, burnin = burnin, ranperm = ranperm, par = pars, log = logs, @@ -1217,10 +1426,10 @@ return(mcmcout) } else { ## Model with posterior parameters stored - mcmcout <- mcmcoutputfixhierpost( + mcmcout <- .mcmcoutputfixhierpost( M = M, burnin = burnin, ranperm = ranperm, - par = pars, log = logd, + par = pars, log = logs, hyper = hypers, post = posts, model = model.obj, prior = prior.obj @@ -1346,6 +1555,24 @@ } ## end no indicfix } +#' Perform MCMC sampling for multivariate normal mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for multivariate normal mixture models regarding the specifications +#' in the passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Normult" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { ## Base slots inherited to each derived class K <- model.obj@K @@ -1502,14 +1729,14 @@ return(mcmcout) } else { ## Model output with posterior parameters stored - mcmcout <- .mcmcoutpupost( + mcmcout <- .mcmcoutputpost( M = M, burnin = burnin, ranperm = ranperm, par = pars, log = logs, weight = weights, entropy = entropies, ST = STm, S = Sm, NK = NKm, - clust = clustm, post = postm, + clust = clustm, post = posts, model = model.obj, prior = prior.obj ) .Call("mcmc_normult_cc", fdata.obj, model.obj, prior.obj, @@ -1574,6 +1801,24 @@ } ## end no indicfix } +#' Perform MCMC sampling for multivariate Student-t mixtures +#' +#' @description +#' For internal usage only. This function prepares all data containers for MCMC +#' sampling for multivariate Student-t mixture models regarding the +#' specifications in the passed-in objects. +#' +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param prior.obj A `prior` object specifying the prior distribution. +#' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC +#' sampling. +#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' results of MCMC sampling. +#' @noRd +#' +#' @seealso +#' * [mixturemcmc()] for the calling function ".do.MCMC.Studmult" <- function(fdata.obj, model.obj, prior.obj, mcmc.obj) { ## Base slots inherited to each derived class K <- model.obj@K @@ -1732,14 +1977,14 @@ return(mcmcout) } else { ## Model output with posterior parameters stored - mcmcout <- .mcmcoutpupost( + mcmcout <- .mcmcoutputpost( M = M, burnin = burnin, ranperm = ranperm, par = pars, log = logs, weight = weights, entropy = entropies, ST = STm, S = Sm, NK = NKm, - clust = clustm, post = postm, + clust = clustm, post = posts, model = model.obj, prior = prior.obj ) .Call("mcmc_studmult_cc", fdata.obj, model.obj, prior.obj, @@ -1802,4 +2047,4 @@ } } ## end hier } ## end no indicfix -} +} \ No newline at end of file diff --git a/R/mixturemoments.R b/R/mixturemoments.R index 30b26d9..281a0a5 100644 --- a/R/mixturemoments.R +++ b/R/mixturemoments.R @@ -14,7 +14,9 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +# USED IN modelmoments +#' @noRd ".mixturemoments.normal" <- function(model, J, meanm) { zm <- array(0, dim = c(J, 1)) zm[seq(2, J, by = 2)] <- exp(cumsum(log(seq(1, (J - 1), by = 2)))) @@ -27,11 +29,12 @@ cm <- diff^(m - n) * model@par$sigma^(n / 2) * zm[n] moments[m] <- moments[m] + choose(m, n) * sum(model@weight * cm) } - } + } return(moments) } +#' @noRd ".mixturemoments.student" <- function(model, J, meanm) { moments <- array(0, dim = c(J, 1)) sigma <- model@par$sigma @@ -51,6 +54,7 @@ return(moments) } +#' @noRd ".mixturemoments.exponential" <- function(model, J, meanm) { moments <- array(0, dim = c(J, 1)) lambda <- model@par$lambda @@ -67,6 +71,7 @@ return(moments) } +#' @noRd ".raw.moments.student" <- function(n, sigma, degrees) { value <- array(0, dim = c(1, length(degrees))) if (n > 0 && n %% 2 == 0) { @@ -80,10 +85,11 @@ return(value) } +#' @noRd ".raw.moments.exponential" <- function(n, lambda) { values <- rep(0, length(lambda)) for (i in seq(0, n)) { values <- values + factorial(n) / lambda^n * (-1)^i / factorial(i) } return(values) -} +} \ No newline at end of file diff --git a/R/model.R b/R/model.R index 1ed5d43..2fce96e 100644 --- a/R/model.R +++ b/R/model.R @@ -17,13 +17,17 @@ #' An S4 class to represent a finite mixture model #' +#' @description +#' This class specifies a finite mixture model. Entities are created from it by +#' calling its constructor [model()]. +#' #' @slot dist A character, defining the distribution family. Possible choices #' are binomial, exponential, normal, normult, poisson, student, and studmult. #' @slot r An integer. Defines the vector dimension of a model. Is one for all #' univariate distributions and larger than one for normult and studmult. #' @slot K An integer, defining the number of components in the finite mixture. #' @slot weight A matrix, containing the weights of the finite mixture model. -#' The matrix must have dimension \code{1\times K} and weights must add to one +#' The matrix must have dimension \code{1 x K} and weights must add to one #' must all be larger or equal to zero. #' @slot par A list containing the parameter vectors for the finite mixture #' distribution. The list can contain more than one named parameter vector. @@ -33,6 +37,8 @@ #' therefore fixed. #' @slot T A matrix containing the repetitions in case of a \code{"binomial"} or #' \code{"poisson"} model. +#' @noRd +#' @exportClass model .model <- setClass("model", representation( dist = "character", @@ -69,7 +75,7 @@ #' regard to the different parameters needed to define a finite mixture model. #' #' @param dist A character, defining the distribution family. Possible choices -#' are \code{"binomial"}, \code{"exponential"}, \code{"normal}, +#' are \code{"binomial"}, \code{"exponential"}, \code{"normal"}, #' \code{"normult"}, \code{"poisson"}, \code{"student"}, and \code{"studmult"}. #' @param r An integer. Defines the vector dimension of a model. Is one for all #' univariate distributions and larger than one for \code{"normult"} and @@ -77,7 +83,7 @@ #' @param K An integer, defining the number of components in the finite mixture. #' Must be larger or equal to one. #' @param weight A matrix, containing the weights of the finite mixture model. -#' The matrix must have dimension \code{1\times K} and weights must add to one +#' The matrix must have dimension \code{1 x K} and weights must add to one #' and must all be larger or equal to zero. #' @param par A list containing the parameter vectors for the finite mixture #' distribution. The list can contain more than one named parameter vector. @@ -86,15 +92,15 @@ #' a \code{"binomial"} model, a \code{K}-dimensional vector of positive rates #' named \code{"lambda"} for an \code{"exponential"} model, #' \code{K}-dimensional vectors of means named \code{"mu"} and variances named -#' \code{sigma} for a \code{"normal"} model, a \code{r\times K}-dimensional -#' matrix of means named \code{"mu"} and a \code{K\times r\times r} dimensional +#' \code{sigma} for a \code{"normal"} model, a \code{r x K}-dimensional +#' matrix of means named \code{"mu"} and a \code{K x r x r} dimensional #' array of variance-covariance matrices named \code{"sigma"} for a #' \code{"normult"} model, a \code{K}-dimensional vector of rates named #' \code{"rates"} for a \code{"poisson"} model, \code{K}-dimensional vectors of #' means named \code{"mu"}, variances named \code{sigma}, and degrees of freedom #' named \code{"df"} for a \code{"student"} model, a -#' \code{r\times K}-dimensional matrix of means named \code{"mu"}, a -#' \code{K\times r\times r} dimensional array of variance-covariance matrices +#' \code{r x K}-dimensional matrix of means named \code{"mu"}, a +#' \code{K x r x r} dimensional array of variance-covariance matrices #' named \code{"sigma"}, and a \code{K}-dimensional vector of degrees of freedom #' for a \code{"studmult"} model. #' @param indicmod A character defining the indicator model used. For now only @@ -103,14 +109,14 @@ #' therefore fixed. #' @param T A matrix containing the repetitions in case of a \code{"binomial"} or #' \code{"poisson"} model. Must be positive integers. -#' @return An S4 \code{model} object. +#' @return An S4 `model` object. #' @export #' -#' @example -#' \preformatted(f_model <- model(dist = "poisson", K = 2, par = list(lambda = c(0.17, 0.2)), -#' weight = matrix(c(0.5, 0.5), nrow = 1))) +#' @examples +#' f_model <- model(dist = "poisson", K = 2, par = list(lambda = c(0.17, 0.2))) #' -#' @seealso \code{model} +#' @seealso +#' * [model][model_class] for the class definition "model" <- function(dist = "poisson", r, K, weight = matrix(), par = list(), indicmod = "multinomial", @@ -150,17 +156,18 @@ #' Getter for weights #' -#' \code{getWeight} returns the weight matrix. +#' \code{hasWeight} returns the weight matrix. #' #' @param model An S4 model object. #' @param verbose A logical indicating, if the function should give a print out. #' @return Matrix of weights. -#' @export +#' @exportMethod hasWeight #' -#' @example +#' @examples #' \dontrun{ -#' weight <- getWeight(model) +#' weight <- hasWeight(model) #' } +#' @rdname model_class setMethod( "hasWeight", "model", function(object, verbose = FALSE) { @@ -201,11 +208,11 @@ setMethod( #' @param verbose A logical indicating if the function should give a print out. #' @return A logical. \code{TRUE} if repetitions are existent in the model. If #' values of slot \code{T} are \code{NA} it returns \code{FALSE}. -#' @export +#' @exportMethod hasT #' -#' @example +#' @examples #' \dontrun{ -#' if(hasT(model)) {cat('Has repetitions.)} +#' if(hasT(model)) {cat('Has repetitions.')} #' } #' #' @seealso \code{model} @@ -234,9 +241,9 @@ setMethod( #' @param model An S4 model object. #' @param verbose A logical indicating, if the function should give a print out. #' @return A matrix with repetitions. Can be empty, if no repetitions are set. -#' @export +#' @exportMethod hasPar #' -#' @example +#' @examples #' \dontrun{ #' if(hasPar(model)) {simulate(model)} #' } @@ -260,10 +267,11 @@ setMethod( #' @param seed An integer specifying the seed for the RNG. #' \code{r} and repetitions \code{T}. #' @return An S4 fdata object holding the simulated values. -#' @export +#' @exportMethod simulate +#' @describeIn model_class Simulates data from a finite mixture model #' #' @seealso \code{model}, \code{fdata} -#' @example +#' @examples #' \dontrun{ #' f_data <- simulate(model, 100) #' } @@ -304,9 +312,9 @@ setMethod( #' @param dev A logical indicating, if the plot should be shown in a graphical #' device. Set to \code{FALSE}, if plotted to a file. #' @return Density or barplot of the S4 model object. -#' @export +#' @exportMethod plot #' -#' @example \dontrun{ +#' @examples \dontrun{ #' plot(f_model) #' } #' @@ -347,9 +355,10 @@ setMethod( #' @param dev A logical indicating, if the plot should be shown in a graphical #' device. Set to \code{FALSE}, if plotted to a file. #' @return A scatter plot of weighted parameters. -#' @export +#' @exportMethod plotPointProc #' -#' @example \dontrun{ +#' @examples +#' \dontrun{ #' plotPointProc(f_model) #' } #' @@ -380,9 +389,9 @@ setMethod( #' distribution should be returned. #' @return An S4 model object with the marginal distribution for dimension #' \code{J}. -#' @export +#' @exportMethod mixturemar #' -#' @example +#' @examples #' \dontrun{ #' mar_model <- mixturemar(f_model, 1) #' } @@ -401,9 +410,9 @@ setMethod( #' #' @param object An S4 model object. #' @return A print out of model information about all slots. -#' @export +#' @exportMethod show #' -#' @example +#' @examples #' \dontrun{ #' show(f_model) #' } @@ -442,6 +451,8 @@ setMethod( ) ## Getters ## +#' @name model_class +#' @exportMethod getDist setMethod( "getDist", "model", function(object) { @@ -449,6 +460,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getR setMethod( "getR", "model", function(object) { @@ -456,6 +469,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getK setMethod( "getK", "model", function(object) { @@ -463,6 +478,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getWeight setMethod( "getWeight", "model", function(object) { @@ -470,6 +487,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getPar setMethod( "getPar", "model", function(object) { @@ -477,6 +496,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getIndicmod setMethod( "getIndicmod", "model", function(object) { @@ -484,6 +505,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getIndicfix setMethod( "getIndicfix", "model", function(object) { @@ -491,6 +514,8 @@ setMethod( } ) +#' @name model_class +#' @exportMethod getT setMethod( "getT", "model", function(object) { @@ -499,6 +524,8 @@ setMethod( ) ## Setters ## +#' @name model_class +#' @exportMethod setDist<- setReplaceMethod( "setDist", "model", function(object, value) { @@ -508,6 +535,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setR<- setReplaceMethod( "setR", "model", function(object, value) { @@ -517,6 +546,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setK<- setReplaceMethod( "setK", "model", function(object, value) { @@ -533,6 +564,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setWeight<- setReplaceMethod( "setWeight", "model", function(object, value) { @@ -543,6 +576,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setPar<- setReplaceMethod( "setPar", "model", function(object, value) { @@ -552,6 +587,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setIndicmod<- setReplaceMethod( "setIndicmod", "model", function(object, value) { @@ -560,6 +597,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setIndicfix<- setReplaceMethod( "setIndicfix", "model", function(object, value) { @@ -568,6 +607,8 @@ setReplaceMethod( } ) +#' @name model_class +#' @exportMethod setT<- setReplaceMethod( "setT", "model", function(object, value) { @@ -591,6 +632,8 @@ setReplaceMethod( ### of components is set to the number of columns of the weights. ### If argument 'weight' is missing from the call, the number of ### components is assumed to be one. + +#' @noRd ".check.K.Model" <- function(weight) { if (!all(is.na(weight))) { return(NCOL(weight)) @@ -603,6 +646,7 @@ setReplaceMethod( ### the defined distribution in argument 'dist' (if missing the ### default is 'poisson'). For univariate distributions it is set ### to one and for multivariate distribution as a default to two. +#' @noRd ".check.r.Model" <- function(dist) { univ <- .get.univ.Model() multiv <- .get.multiv.Model() @@ -620,6 +664,7 @@ setReplaceMethod( ### Check weight: If argument 'weight' is missing from the call ### equally balanced weights are given as a default. +#' @noRd ".check.weight.Model" <- function(K) { weight <- matrix(1 / K, nrow = 1, ncol = K) return(weight) @@ -629,6 +674,7 @@ setReplaceMethod( ### to validity. In case of non-numeric objects an error is thrown. ### In case of objects of type 'numeric' it is implicitly converted ### to type 'integer'. +#' @noRd ".check.T.Model" <- function(T) { if (!all(is.na(T))) { if (!is.numeric(T)) { @@ -645,6 +691,7 @@ setReplaceMethod( } ### Marginal model +#' @noRd ".mixturemar.Model" <- function(obj, J) { if (obj@dist == "normult") { .mixturemar.normult.Model(obj, J) @@ -656,6 +703,7 @@ setReplaceMethod( } } +#' @noRd ".mixturemar.normult.Model" <- function(obj, J) { dist <- ifelse(length(J) == 1, "normal", "normult") r <- length(J) @@ -676,6 +724,7 @@ setReplaceMethod( return(margin.model) } +#' @noRd ".mixturemar.studmult.Model" <- function(obj, J) { dist <- ifelse(length(J) == 1, "student", "studmult") r <- length(J) @@ -715,6 +764,7 @@ setReplaceMethod( ### -------------------------------------------------------------- ### TODO: Implement C++ function. +#' @noRd ".simulate.indicators.Model" <- function(obj, N) { K <- obj@K if (K == 1) { @@ -747,6 +797,7 @@ setReplaceMethod( ### @see ?fdata, ?simulate ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- +#' @noRd ".simulate.data.Model" <- function(obj, N, fdata.obj) { dist <- obj@dist if (dist == "poisson" || dist == "cond.poisson") { @@ -775,6 +826,18 @@ setReplaceMethod( ### @see ?simulate, model:::.simulate.data.Model, ?rpois ### @author Lars Simon Zehnder ### --------------------------------------------------------------------- +#' Simulate data from a Poisson finite mixture model +#' +#' @description +#' Simulates values from a Poisson mixture using pre-specified model and +#' indicators. +#' +#' @param obj A `model` object specifying the finite mixture model. +#' @param N An integer specifying the sample size. +#' @param fdata.obj An `fdata` object to store the simulated data. +#' @return An `fdata` object with simulated data. +#' @importFrom stats rpois +#' @noRd ".simulate.data.poisson.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "discrete" fdata.obj@sim <- TRUE @@ -782,17 +845,22 @@ setReplaceMethod( return(fdata.obj) } -### --------------------------------------------------------------------- -### .simulate.data.binomial.Model -### @description Simulates values from a Binomial mixture using pre- -### specified model and indicators -### @par obj an S4 object of class 'model' -### @par N an R 'integer' object; number of simulated values -### @par fdata.obj an S4 object of class 'fdata' -### @return an S4 object of class 'fdata' with simulated values -### @see ?simulate, model:::.simulate.data.Model, ?rbinom -### @author Lars Simon Zehnder -### --------------------------------------------------------------------- +#' Simulate data from Binomial mixture model +#' +#' @description +#' Simulates values from a Binomial mixture using pre-specified model and +#' indicators +#' @param obj An `model` object specifying the mixture model. +#' @param N An integer specifying the size of the simulated sample. +#' @param fdata.obj An `fdata` object to store the simulated sample. If the +#' `fdata` object contains repetitions in slot `@@T`, the repetitions are +#' used in sampling. +#' @return An `fdata` object containing the simulated values. +#' @importFrom stats rbinom +#' @noRd +#' +#' @seealso +#' [simulate()][model_class] for the calling function ".simulate.data.binomial.Model" <- function(obj, N, fdata.obj) { if (!hasT(fdata.obj)) { fdata.obj@T <- as.matrix(1) @@ -803,17 +871,20 @@ setReplaceMethod( return(fdata.obj) } -### --------------------------------------------------------------------- -### .simulate.data.exponential.Model -### @description Simulates values from an Exponential mixture using -### specified model and indicators. -### @param obj an S4 object of class 'model' -### @param N an R 'integer' object; number of simulated values -### @param fdata.obj an S4 object of class 'fdata' -### @return an S4 object of class 'fdata' with simulated values -### @see ?simulate, model:::.simulate.data.Model, ?rexp -### @author Lars Simon Zehnder -### --------------------------------------------------------------------- +#' Simulate data from exponential mixture model +#' +#' @description +#' Simulates values from a exponential mixture using pre-specified model and +#' indicators +#' @param obj An `model` object specifying the mixture model. +#' @param N An integer specifying the size of the simulated sample. +#' @param fdata.obj An `fdata` object to store the simulated sample. +#' @return An `fdata` object containing the simulated values. +#' @importFrom stats rexp +#' @noRd +#' +#' @seealso +#' [simulate()][model_class] for the calling function ".simulate.data.exponential.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -821,17 +892,19 @@ setReplaceMethod( return(fdata.obj) } -### --------------------------------------------------------------------- -### .simulate.data.normal.Model -### @description Simulates values from a Normal mixture using -### specified model and indicators. -### @param obj an S4 object of class 'model' -### @param N an R 'integer' object; number of simulated values -### @param fdata.obj an S4 object of class 'fdata' -### @return an S4 object of class 'fdata' with simulated values -### @see ?simulate, model:::.simulate.data.Model, ?rnorm -### @author Lars Simon Zehnder -### --------------------------------------------------------------------- +#' Simulate data from Normal mixture model +#' +#' @description +#' Simulates values from a Normal mixture using pre-specified model and +#' indicators +#' @param obj An `model` object specifying the mixture model. +#' @param N An integer specifying the size of the simulated sample. +#' @param fdata.obj An `fdata` object to store the simulated sample. +#' @return An `fdata` object containing the simulated values. +#' @noRd +#' +#' @seealso +#' [simulate()][model_class] for the calling function ".simulate.data.normal.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -842,6 +915,22 @@ setReplaceMethod( return(fdata.obj) } +#' Simulate data from Student-t mixture model +#' +#' @description +#' Simulates values from a Student-t mixture using pre-specified model and +#' indicators +#' @param obj An `model` object specifying the mixture model. +#' @param N An integer specifying the size of the simulated sample. +#' @param fdata.obj An `fdata` object to store the simulated sample. If the +#' `fdata` object contains repetitions in slot `@@T`, the repetitions are +#' used in sampling. +#' @return An `fdata` object containing the simulated values. +#' @importFrom stats rgamma +#' @noRd +#' +#' @seealso +#' [simulate()][model_class] for the calling function ".simulate.data.student.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -854,6 +943,22 @@ setReplaceMethod( return(fdata.obj) } +#' Simulate data from a multivariate Normal mixture model +#' +#' @description +#' Simulates values from a multivariate Normal mixture using pre-specified +#' model and indicators +#' @param obj An `model` object specifying the mixture model. +#' @param N An integer specifying the size of the simulated sample. +#' @param fdata.obj An `fdata` object to store the simulated sample. If the +#' `fdata` object contains repetitions in slot `@@T`, the repetitions are +#' used in sampling. +#' @return An `fdata` object containing the simulated values. +#' @importFrom mvtnorm rmvnorm +#' @noRd +#' +#' @seealso +#' [simulate()][model_class] for the calling function ".simulate.data.normult.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -875,6 +980,9 @@ setReplaceMethod( ### The range for the x-axis is determined via the ### quantiles of the largest and smallest Poisson model ### in the mixture. +#' @importFrom stats qpois dpois +#' @importFrom grDevices axisTicks +#' @noRd ".plot.Poisson.Model" <- function(model.obj, dev, ...) { if (.check.grDevice() && dev) { dev.new(title = "Model plot") @@ -911,6 +1019,8 @@ setReplaceMethod( ### models and line model is used. ### The grid for the x-axis is determined by taking ### the +#' @importFrom stats dbinom +#' @noRd ".plot.Binomial.Model" <- function(model.obj, dev, ...) { if (.check.grDevice() && dev) { dev.new(title = "Model plot") @@ -933,6 +1043,8 @@ setReplaceMethod( points(x.grid, y.grid, pch = 20) } +#' @importFrom stats qexp dexp +#' @noRd ".plot.Exponential.Model" <- function(model.obj, dev, ...) { if (.check.grDevice() && dev) { dev.new(title = "Model plot") @@ -957,6 +1069,8 @@ setReplaceMethod( ) } +#' @importFrom stats qt dt +#' @noRd ".plot.Student.Model" <- function(model.obj, dev, ...) { if (.check.grDevice() && dev) { dev.new(title = "Model plot") @@ -985,6 +1099,8 @@ setReplaceMethod( ) } +#' @importFrom stats qnorm dnorm +#' @noRd ".plot.Normal.Model" <- function(model.obj, dev, ...) { if (.check.grDevice() && dev) { dev.new(title = "Model Plot") @@ -1014,11 +1130,12 @@ setReplaceMethod( ) } +#' @noRd ".plot.Normult.Model" <- function(model.obj, dev, ...) { K <- model.obj@K r <- model.obj@r if (r == 2) { - if (.check.gr.Device() && dev) { + if (.check.grDevice() && dev) { dev.new(title = "Model: Perspective plot") } xyz.grid <- .generate.Grid.Normal(model.obj) @@ -1070,11 +1187,12 @@ setReplaceMethod( } } -".plot.Normult.Model" <- function(model.obj, dev, ...) { +#' @noRd +".plot.Studmult.Model" <- function(model.obj, dev, ...) { K <- model.obj@K r <- model.obj@r if (r == 2) { - if (.check.gr.Device() && dev) { + if (.check.grDevice() && dev) { dev.new(title = "Model: Perspective plot") } xyz.grid <- .generate.Grid.Student(model.obj) @@ -1126,7 +1244,10 @@ setReplaceMethod( } } +#' @importFrom mvtnorm qmvnorm dmvnorm +#' @noRd ".generate.Grid.Normal" <- function(model.obj) { + K <- model.obj@k mu <- model.obj@par$mu sigma <- model.obj@par$sigma weight <- model.obj@weight @@ -1155,13 +1276,16 @@ setReplaceMethod( xy.grid <- t(apply(xy.grid, 1, "+", max.mu)) z.grid <- outer(xy.grid[, 1], xy.grid[, 2], func) grid.list <- list( - x = xy.grid[, 1], y = y.grid[, 2], + x = xy.grid[, 1], y = xy.grid[, 2], z = z.grid ) return(grid.list) } +#' @importFrom mvtnorm qmvt dmvt +#' @noRd ".generate.Grid.Student" <- function(model.obj) { + K <- model.obj@K mu <- model.obj@par$mu sigma <- model.obj@par$sigma df <- model.obj@par$df @@ -1192,13 +1316,14 @@ setReplaceMethod( xy.grid <- t(apply(xy.grid, 1, "+", max.mu)) z.grid <- outer(xy.grid[, 1], xy.grid[, 2], func) grid.list <- list( - x = xy.grid[, 1], y = y.grid[, 2], + x = xy.grid[, 1], y = xy.grid[, 2], z = z.grid ) return(grid.list) } ### plotPointProc +#' @noRd ".plotpointproc.Poisson" <- function(x, dev) { K <- x@K if (.check.grDevice() && dev) { @@ -1236,6 +1361,7 @@ setReplaceMethod( ### Has ### Checks if a 'model' object has specified parameters. +#' @noRd ".haspar.Model" <- function(obj, verbose) { if (length(obj@par) > 0) { dist <- obj@dist @@ -1277,6 +1403,7 @@ setReplaceMethod( ### specified or not. In case verbose == FALSE an ### error is thrown. ### ----------------------------------------------------------------- +#' @noRd ".haspar.poisson.Model" <- function(obj, verbose) { if (length(obj@par) == 0) { if (verbose) { @@ -1325,6 +1452,7 @@ setReplaceMethod( ### specified or not. In case verbose == TRUE an ### error is thrown. ### ------------------------------------------------------------------- +#' @noRd ".haspar.binomial.Model" <- function(obj, verbose) { if (length(obj@par) == 0) { if (verbose) { @@ -1335,7 +1463,7 @@ setReplaceMethod( return(FALSE) } } else { - if ("p" %in% names(obj@par)) { + if (!"p" %in% names(obj@par)) { if (verbose) { stop(paste("Wring specification of slot @par ", "in 'model' object. Binomial models ", @@ -1376,6 +1504,7 @@ setReplaceMethod( ### @return either TRUE or FALSE if parameters are fully specified or ### nor. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ +#' @noRd ".haspar.exponential.Model" <- function(obj, verbose) { if (length(obj@par) == 0) { if (verbose) { @@ -1428,6 +1557,7 @@ setReplaceMethod( ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ +#' @noRd ".haspar.normal.Model" <- function(obj, verbose) { K <- obj@K if (length(obj@par) == 0) { @@ -1504,6 +1634,7 @@ setReplaceMethod( ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ +#' @noRd ".haspar.normult.Model" <- function(obj, verbose) { K <- obj@K if (length(obj@par) == 0) { @@ -1580,6 +1711,7 @@ setReplaceMethod( ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ +#' @noRd ".haspar.student.Model" <- function(obj, verbose) { K <- obj@K if (length(obj@par) == 0) { @@ -1669,6 +1801,7 @@ setReplaceMethod( ### @return either TRUE or FALSE if parameters are fully specified or ### not. In case verbose == TRUE an error is thrown . ### ------------------------------------------------------------------ +#' @noRd ".haspar.studmult.Model" <- function(obj, verbose) { K <- obj@K if (length(obj@par) == 0) { @@ -1765,6 +1898,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix'), .init.valid.*, .valid.* ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- +#' @noRd ".init.valid.Model" <- function(obj) { .valid.dist.Model(obj) .init.valid.K.Model(obj) @@ -1783,6 +1917,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix'), .init.valid.*, .valid.* ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- +#' @noRd ".valid.Model" <- function(obj) { .valid.dist.Model(obj) .valid.K.Model(obj) @@ -1800,6 +1935,7 @@ setReplaceMethod( ### @return An error in case the distribution is unknown. ### @see ?model, ?vignette('finmix')i ### ---------------------------------------------------------------------------- +#' @noRd ".valid.dist.Model" <- function(obj) { dists <- c( "normal", "normult", "exponential", @@ -1838,6 +1974,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".init.valid.K.Model" <- function(obj) { if (obj@K < 1) { stop(paste("Wrong specification of slot 'K' of ", @@ -1874,6 +2011,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".valid.K.Model" <- function(obj) { if (obj@K < 1) { stop(paste("Wrong specification of slot 'K' of ", @@ -1908,6 +2046,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".init.valid.r.Model" <- function(obj) { univ <- .get.univ.Model() multiv <- .get.multiv.Model() @@ -1952,6 +2091,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".valid.r.Model" <- function(obj) { univ <- .get.univ.Model() multiv <- .get.multiv.Model() @@ -1997,6 +2137,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".init.valid.weight.Model" <- function(obj) { if (!all(is.na(obj@weight))) { if (nrow(obj@weight) > 1) { @@ -2067,6 +2208,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------------- +#' @noRd ".valid.weight.Model" <- function(obj) { if (!all(is.na(obj@weight))) { if (nrow(obj@weight) > 1) { @@ -2135,6 +2277,7 @@ setReplaceMethod( ### the wrong dimension, or non-positive values. ### @see ?model, ?vignette('finmix') ### -------------------------------------------------------------------------------------- +#' @noRd ".init.valid.T.Model" <- function(obj) { if (!all(is.na(obj@T))) { if (!is.integer(obj@T)) { @@ -2174,6 +2317,7 @@ setReplaceMethod( ### the wrong dimension, or non-positive values. ### @see ?model, ?vignette('finmix') ### -------------------------------------------------------------------------------------- +#' @noRd ".valid.T.Model" <- function(obj) { if (!all(is.na(obj@T))) { if (!is.integer(obj@T)) { @@ -2217,6 +2361,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### -------------------------------------------------------------------------------- +#' @noRd ".init.valid.par.Model" <- function(obj) { dist <- obj@dist if (length(obj@par) > 0) { @@ -2248,6 +2393,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### -------------------------------------------------------------------------------- +#' @noRd ".valid.par.Model" <- function(obj) { dist <- obj@dist if (length(obj@par) > 0) { @@ -2283,6 +2429,7 @@ setReplaceMethod( ### @see ?model ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- +#' @noRd ".init.valid.Poisson.Model" <- function(obj) { if (length(obj@par) > 0) { if ("lambda" %in% names(obj@par)) { @@ -2351,6 +2498,7 @@ setReplaceMethod( ### @see $model ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- +#' @noRd ".valid.Poisson.Model" <- function(obj) { if (length(par) > 0) { if ("lambda" %in% names(obj@par)) { @@ -2417,6 +2565,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------ +#' @noRd ".init.valid.Binomial.Model" <- function(obj) { if (length(obj@par)) { if (!"p" %in% names(obj@par)) { @@ -2462,7 +2611,7 @@ setReplaceMethod( ) } } - if (dim(model.obj@T)[1] > 1 && dim(model.obj@T)[2] > 1) { + if (dim(obj@T)[1] > 1 && dim(obj@T)[2] > 1) { stop(paste( "Dimensions of repetitions 'T' for binomial mixture", "model do not match conditions. Only one-dimensional", @@ -2485,6 +2634,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------ +#' @noRd ".valid.Binomial.Model" <- function(obj) { if (length(obj@par)) { if (!"p" %in% names(obj@par)) { @@ -2530,7 +2680,7 @@ setReplaceMethod( ) } } - if (dim(model.obj@T)[1] > 1 && dim(model.obj@T)[2] > 1) { + if (dim(obj@T)[1] > 1 && dim(obj@T)[2] > 1) { stop(paste( "Dimensions of repetitions 'T' for binomial mixture", "model do not match conditions. Only one-dimensional", @@ -2555,6 +2705,7 @@ setReplaceMethod( ### @see ?model ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- +#' @noRd ".init.valid.Exponential.Model" <- function(obj) { if (length(obj@par) > 0) { if ("lambda" %in% names(obj@par)) { @@ -2623,6 +2774,7 @@ setReplaceMethod( ### @see $model ### @author Lars Simon Zehnder ### ----------------------------------------------------------------------------- +#' @noRd ".valid.Exponential.Model" <- function(obj) { if (length(par) > 0) { if ("lambda" %in% names(obj@par)) { @@ -2695,6 +2847,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- +#' @noRd ".init.valid.Normal.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -2799,6 +2952,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- +#' @noRd ".valid.Normal.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -2903,6 +3057,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".init.valid.Normult.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -3009,6 +3164,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".valid.Normult.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -3115,6 +3271,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- +#' @noRd ".init.valid.Student.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -3254,6 +3411,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ------------------------------------------------------------------------------- +#' @noRd ".valid.Student.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -3393,6 +3551,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".init.valid.Studmult.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -3534,6 +3693,7 @@ setReplaceMethod( ### @see ?model, ?vignette('finmix') ### @author Lars Simon Zehnder ### ---------------------------------------------------------------------------- +#' @noRd ".valid.Studmult.Model" <- function(obj) { if (length(obj@par) > 0) { if (!"mu" %in% names(obj@par)) { @@ -3655,7 +3815,13 @@ setReplaceMethod( } ### Additional functions -#' @keywords internal +#' Returns all univariate distributions +#' +#' @description +#' For internal usage only. +#' +#' @return A character vector containing all univariate distributions. +#' @noRd ".get.univ.Model" <- function() { univ <- c( "poisson", "cond.poisson", @@ -3665,6 +3831,13 @@ setReplaceMethod( return(univ) } +#' Returns all multivariate distributions +#' +#' @description +#' For internal usage only. +#' +#' @return A character vector containing all multivariate distributions. +#' @noRd ".get.multiv.Model" <- function() { multiv <- c("normult", "studmult") return(multiv) diff --git a/R/modelmoments.R b/R/modelmoments.R index 0a34c30..0637cc7 100644 --- a/R/modelmoments.R +++ b/R/modelmoments.R @@ -14,7 +14,21 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `modelmoments` class +#' +#' @description +#' Defines a container to hold the moments of a finite mixture model. The +#' finmix `model` object should contains parameters and weights. +#' +#' @slot mean A vector of component means. +#' @slot var An array of components variances or in case of multivariate +#' distributions covariance matrices. +#' @slot model The corresponding `model` object. +#' @exportClass modelmoments +#' +#' @name modelmoments_class +#' @seealso +#' * [modelmoments()] the constructor of the `modelmoments` class setClass("modelmoments", representation( mean = "vector", @@ -32,6 +46,25 @@ setClass("modelmoments", ) ) +#' Constructor of finmix `modelmoments` class +#' +#' Calling [modelmoments()] calculates the corresponding moments of the +#' finite mixture distribution defined in the `model` object. The `model` +#' object should contain parameters in slot `par` and weights in slot `weight`. +#' +#' @param model A `model` object containing defined parameters in slot `par` +#' and defined weights in slot `weight`. +#' @returns A `modelmoments` object with calculated moments of the finite +#' mixture model defined in the `model` object. +#' @export +#' +#' @examples +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' modelmoments(f_model) +#' +#' @seealso +#' * [modelmoments_class] for all slots of the `modelmoments` class "modelmoments" <- function(model) { dist <- model@dist if (dist == "normult") { @@ -52,6 +85,22 @@ setClass("modelmoments", } ## Getters ## +#' Getter method of `modelmoments` class. +#' +#' Returns the `mean` slot of a `modelmoments` object. +#' +#' @param object A `modelmoments` object. +#' @returns The `mean` slot of the `object`. +#' @exportMethod getMean +#' @describeIn modelmoments_class +#' +#' @examples +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getMean(f_moments) +#' +#' @seealso [modelmoments_class] for all slots of the `modelmoments` class setMethod( "getMean", "modelmoments", function(object) { @@ -59,6 +108,22 @@ setMethod( } ) +#' Getter method of `modelmoments` class. +#' +#' Returns the `var` slot of a `modelmoments` object. +#' +#' @param object A `modelmoments` object. +#' @returns The `var` slot of the `object`. +#' @exportMethod getVar +#' @describeIn modelmoments_class +#' +#' @examples +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getVar(f_moments) +#' +#' @seealso [modelmoments_class] for all slots of the `modelmoments` class setMethod( "getVar", "modelmoments", function(object) { @@ -66,6 +131,22 @@ setMethod( } ) +#' Getter method of `modelmoments` class. +#' +#' Returns the `model` slot of a `modelmoments` object. +#' +#' @param object A `modelmoments` object. +#' @returns The `model` slot of the `object`. +#' @exportMethod getModel +#' @describeIn modelmoments_class +#' +#' @examples +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), +#' weight=matrix(c(0.3, 0.7), nrow=1)) +#' f_moments <- modelmoments(f_model) +#' getModel(f_moments) +#' +#' @seealso [modelmoments_class] for all slots of the `modelmoments` class setMethod( "getModel", "modelmoments", function(object) { diff --git a/R/normalmodelmoments.R b/R/normalmodelmoments.R index 27adf18..b3ec38a 100644 --- a/R/normalmodelmoments.R +++ b/R/normalmodelmoments.R @@ -14,7 +14,22 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `normalmodelmoments` class +#' +#' @description +#' Defines a class that holds theoretical moments for a finite mixture of +#' normal distributions. Note that this class is not directly used, but +#' indirectly when calling the `modelmoments` constructor [modelmoments()]. +#' +#' @slot B A numeric defining the between-group heterogeneity. +#' @slot W A numeric defining the within-group heterogeneity. +#' @slot R A numeric defining the coefficient of determination. +#' @exportClass normalmodelmoments +#' @name normalmodelmoments +#' +#' @seealso +#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes .normalmodelmoments <- setClass("normalmodelmoments", representation( B = "numeric", @@ -33,6 +48,24 @@ ) ) +#' Initializer of the `normalmodelmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "normalmodelmoments", function(.Object, ..., model) { @@ -42,6 +75,15 @@ setMethod( } ) +#' Generate moments for normal mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' normal mixture distribution. +#' +#' @param object An `normalmodelmoments` object. +#' @return An `normalmodelmoments` object with calculated moments. +#' @keywords internal setMethod( "generateMoments", "normalmodelmoments", function(object) { @@ -49,6 +91,15 @@ setMethod( } ) +#' Shows a summary of an `normalmodelmoments` object. +#' +#' Calling [show()] on an `normalmodelmoments` object gives an overview +#' of the moments of an normal finite mixture. +#' +#' @param object An `normalmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @describeIn normalmodelmoments setMethod( "show", "normalmodelmoments", function(object) { @@ -84,6 +135,25 @@ setMethod( ) ## Getters ## +#' Getter method of `normalmodelmoments` class. +#' +#' Returns the `B` slot. +#' +#' @param object An `normalmodelmoments` object. +#' @returns The `B` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- c(-2, 2) +#' sigmas <- matrix(c(2, 4), nrow=1) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) +#' getB(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getB", "normalmodelmoments", function(object) { @@ -91,6 +161,25 @@ setMethod( } ) +#' Getter method of `normalmodelmoments` class. +#' +#' Returns the `W` slot. +#' +#' @param object An `normalmodelmoments` object. +#' @returns The `W` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- c(-2, 2) +#' sigmas <- matrix(c(2, 4), nrow=1) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) +#' getW(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getW", "normalmodelmoments", function(object) { @@ -98,6 +187,25 @@ setMethod( } ) +#' Getter method of `normalmodelmoments` class. +#' +#' Returns the `R` slot. +#' +#' @param object An `normalmodelmoments` object. +#' @returns The `R` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- c(-2, 2) +#' sigmas <- matrix(c(2, 4), nrow=1) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) +#' getR(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getR", "normalmodelmoments", function(object) { @@ -110,6 +218,17 @@ setMethod( ### Private functions ### This functions are not exported +#' Generate model moments for an normal mixture +#' +#' @description +#' Only called implicitly. generates all moments of an normal mixture +#' distribution. +#' +#' @param object An `normalmodelmoments` object to contain all calculated +#' moments. +#' @returns An `normalmodelmoments` object containing all moments of the +#' normal mixture distributions. +#' @keywords internal ".generateMomentsNormal" <- function(object) { mu <- object@model@par$mu sigma <- object@model@par$sigma diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index 0cd29e2..09076d3 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -14,7 +14,22 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `normultmodelmoments` class +#' +#' @description +#' Defines a class that holds modelmoments for a finite mixture of normult +#' distributions. Note that this class is not directly used, but indirectly +#' when calling the `modelmoments` constructor [modelmoments()]. +#' +#' @slot B A numeric defining the between-group heterogeneity. +#' @slot W A numeric defining the within-group heterogeneity. +#' @slot R A numeric defining the coefficient of determination. +#' @exportClass normultmodelmoments +#' @name normultmodelmoments +#' +#' @seealso +#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes .normultmodelmoments <- setClass("normultmodelmoments", representation( B = "array", @@ -37,6 +52,24 @@ ) ) +#' Initializer of the `normultmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object_ see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "normultmodelmoments", function(.Object, ..., model) { @@ -45,6 +78,15 @@ setMethod( } ) +#' Generate moments for normult mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' normult mixture distribution. +#' +#' @param object An `normultmodelmoments` object. +#' @return An `normultmodelmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "normultmodelmoments", function(object) { @@ -52,6 +94,15 @@ setMethod( } ) +#' Shows a summary of an `normultmodelmoments` object. +#' +#' Calling [show()] on an `normultmodelmoments` object gives an overview +#' of the moments of an normult finite mixture. +#' +#' @param object An `normultmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @describeIn normultmodelmoments setMethod( "show", "normultmodelmoments", function(object) { @@ -101,6 +152,26 @@ setMethod( ) ## Getters ## +#' Getter method of `normultmodelmoments` class. +#' +#' Returns the `B` slot. +#' +#' @param object An `normultmodelmoments` object. +#' @returns The `B` slot of the `object`. +#' @describeIn datamoments_class Getter method for slot `B` +#' +#' @examples +#' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) +#' getB(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getB", "normultmodelmoments", function(object) { @@ -108,6 +179,26 @@ setMethod( } ) +#' Getter method of `normultmodelmoments` class. +#' +#' Returns the `W` slot. +#' +#' @param object An `normultmodelmoments` object. +#' @returns The `W` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) +#' getW(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getW", "normultmodelmoments", function(object) { @@ -115,13 +206,52 @@ setMethod( } ) +#' Getter method of `normultmodelmoments` class. +#' +#' Returns the `Rdet` slot. +#' +#' @param object An `normultmodelmoments` object. +#' @returns The `Rdet` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) +#' getRdet(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getRdet", "normultmodelmoments", function(object) { - return(object@B) + return(object@Rdet) } ) +#' Getter method of `normultmodelmoments` class. +#' +#' Returns the `Rtr` slot. +#' +#' @param object An `normultmodelmoments` object. +#' @returns The `Rtr` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' getRtr(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getRtr", "normultmodelmoments", function(object) { @@ -129,6 +259,25 @@ setMethod( } ) +#' Getter method of `normultmodelmoments` class. +#' +#' Returns the `Corr` slot. +#' +#' @param object An `normultmodelmoments` object. +#' @returns The `Corr` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' getCorr(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getCorr", "normultmodelmoments", function(object) { @@ -141,6 +290,17 @@ setMethod( ### private functions ### these function are not exported +#' Generate model moments for an normult mixture +#' +#' @description +#' Only called implicitly. generates all moments of an normult mixture +#' distribution. +#' +#' @param object An `normultmodelmoments` object to contain all calculated +#' moments. +#' @returns An `normultmodelmoments` object containing all moments of the +#' normult mixture distributions. +#' @noRd ".generateMomentsNormult" <- function(object) { mu <- object@model@par$mu sigma <- object@model@par$sigma diff --git a/R/poissonmodelmoments.R b/R/poissonmodelmoments.R index a1420ce..66271f3 100644 --- a/R/poissonmodelmoments.R +++ b/R/poissonmodelmoments.R @@ -14,7 +14,22 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `poissonmodelmoments` class +#' +#' @description +#' Defines a class that holds modelmoments for a finite mixture of poisson +#' distributions. Note that this class is not directly used, but indirectly +#' when calling the `modelmoments` constructor [modelmoments()]. +#' +#' @slot B A numeric defining the between-group heterogeneity. +#' @slot W A numeric defining the within-group heterogeneity. +#' @slot R A numeric defining the coefficient of determination. +#' @exportClass poissonmodelmoments +#' @name poissonmodelmoments +#' +#' @seealso +#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes .poissonmodelmoments <- setClass("poissonmodelmoments", contains = c("dmodelmoments"), validity = function(object) { @@ -23,6 +38,24 @@ } ) +#' Initializer of the `poissonmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object_ see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "poissonmodelmoments", function(.Object, ..., model) { @@ -31,6 +64,15 @@ setMethod( } ) +#' Generate moments for poisson mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' poisson mixture distribution. +#' +#' @param object An `poissonmodelmoments` object. +#' @return An `poissonmodelmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "poissonmodelmoments", function(object) { @@ -38,6 +80,15 @@ setMethod( } ) +#' Shows a summary of an `poissonmodelmoments` object. +#' +#' Calling [show()] on an `poissonmodelmoments` object gives an overview +#' of the moments of an poisson finite mixture. +#' +#' @param object An `poissonmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @describeIn poissonmodelmoments setMethod( "show", "poissonmodelmoments", function(object) { @@ -69,6 +120,17 @@ setMethod( ### Private functions ### These functions are not exported +#' Generate model moments for an poisson mixture +#' +#' @description +#' Only called implicitly. generates all moments of an poisson mixture +#' distribution. +#' +#' @param object An `poissonmodelmoments` object to contain all calculated +#' moments. +#' @returns An `poissonmodelmoments` object containing all moments of the +#' poisson mixture distributions. +#' @noRd ".generateMomentsPoisson" <- function(object) { hasPar(object@model, verbose = TRUE) K <- object@model@K diff --git a/R/prior.R b/R/prior.R index 778b9ce..048bd50 100644 --- a/R/prior.R +++ b/R/prior.R @@ -15,9 +15,34 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -### ================================================================ -### The prior class -### ---------------------------------------------------------------- +#' Finmix `prior` class +#' +#' The `prior` class stores the specifications for the prior distribution used +#' for Bayesian estimation of the finite mixture parameters and weights. There +#' exists next to the general constructor also an advanced constructor that +#' specifies a data dependent prior. See [priordefine()] for this advanced +#' constructor. +#' +#' @slot weight A matrix storing the prior parameters for the `weight` of a +#' finite mixture model. +#' @slot par A list storing the prior parameters for the parameters of a finite +#' mixture model. +#' @slot type A character specifying what type of prior should be used in +#' Bayesian estimation. Either `"independent"` for an independent prior +#' distribution or `"condconjugate"` for a conditionally conjugate prior +#' distribution. +#' @slot hier A logical defining, if the used prior should be hierarchical. +#' Hierarchical prior are often more robust, but need an additional layer in +#' sampling, so computing costs increase. +#' @exportClass prior +#' @name prior-class +#' +#' @seealso +#' * \code{\link{prior}} for the general constructor of this class +#' * \code{\link{priordefine}} for the advanced constructor of this class +#' +#' @references +#' * Frühwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" .prior <- setClass("prior", representation( weight = "matrix", @@ -42,20 +67,42 @@ ### Constructors ### ---------------------------------------------------------------- -### ---------------------------------------------------------------- -### prior -### @description Default constructor. -### @par weight an R 'matrix' object containing the prior weights -### @par par an R list object containing the hyper parameters -### @par type an R 'character' object defining the type of the -### prior; possible type are either "independent" or -### "condconjugate" -### @par hier an R 'logical' object indicating if a hierarchical -### prior should be used -### @returns an S4 object of class 'prior' -### @see ?prior -### @author Lars SImon Zehnder -### ----------------------------------------------------------------- +#' Constructor for `prior` class +#' +#' @description +#' Calling [prior()] constructs an object of class [prior][prior-class]. The +#' constructor can be called without providing any arguments, but the prior +#' has to be filled with appropriate parameters when MCMC sampling should be +#' performed. +#' +#' There exists next to the general constructor also an advanced constructor +#' that specifies a data dependent prior. See [priordefine()] for this advanced +#' constructor. +#' +#' @slot weight A matrix storing the prior parameters for the `weight` of a +#' finite mixture model. +#' @slot par A list storing the prior parameters for the parameters of a finite +#' mixture model. +#' @slot type A character specifying what type of prior should be used in +#' Bayesian estimation. Either `"independent"` for an independent prior +#' distribution or `"condconjugate"` for a conditionally conjugate prior +#' distribution. +#' @slot hier A logical defining, if the used prior should be hierarchical. +#' Hierarchical prior are often more robust, but need an additional layer in +#' sampling, so computing costs increase. +#' @export +#' @name prior +#' +#' @examples +#' # Call the default constructor without any arguments. +#' f_prior <- prior() +#' +#' @seealso +#' * [prior()] for the general constructor of this class +#' * [priordefine()] for the advanced constructor of this class +#' +#' @references +#' * Fr\"uhwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" "prior" <- function(weight = matrix(), par = list(), type = c("independent", "condconjugate"), hier = TRUE) { @@ -65,19 +112,44 @@ type = type, hier = hier ) } -### ----------------------------------------------------------------- -### priordefine -### @description Advanced constructor. Constructs an object from -### input parameters. Constructed prior has data- -### dependent hyper parameters. -### @par fdata an S4 object of class 'fdata' -### @par model an S4 object of class 'model' -### @par coef.mat not implemented yet -### @par varargin an S4 object of class 'prior' -### @return an S4 object of class 'prior' -### @see ?fdata, ?model, ?priordefine -### @author Lars Simon Zehnder -### ----------------------------------------------------------------- + +#' Advanced constructor for the `prior` class +#' +#' This constructor defines a data dependent prior with parameters by matching +#' moments. As a consequence it needs as inputs an `fdata` object and a `model` +#' object. The prior distributions chosen and the methods how parameters are +#' computed are described in Frühwirth-Schnatter (2006). +#' +#' @param fdata An `fdata` object holding the data. Observations in slot `@@y` +#' must be existent. +#' @param model A `model` object specifying the finite mixture model. +#' @param varargin `NULL` or a `prior` object. This enables the user to pass in +#' an already constructed prior object that gets then completed. +#' @param prior.wagner A logical indicating, if the prior from Wagner (2007) +#' should be used in case of an exponential mixture model. +#' @param s A numeric specifying the standard deviation `s` for the +#' Metropolis-Hastings proposal. +#' @return A fully specified `prior` object. +#' @export +#' @name priordefine +#' +#' @examples +#' # Create a Poisson mixture model. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Use the advanced constructor to generate a prior. +#' f_prior <- priordefine(f_data, f_model) +#' +#' @seealso +#' * [prior][prior-class] for the class definition +#' * [prior()] for the default constructor of the class +#' +#' @references +#' * Fr\"uwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching +#' Models" +#' * Wagner, H. (2007), "Bayesian analysis of mixtures of exponentials", +#' Journal of Applied Mathematics, Statistics and Informatics 3, 165-183 "priordefine" <- function(fdata = fdata(), model = model(), varargin = NULL, prior.wagner = TRUE, s = 5.0) { .check.fdata.model.Prior(fdata, model) @@ -94,6 +166,30 @@ ### ================================================================== ### Has methods ### ------------------------------------------------------------------ +#' Checks for parameters in a `prior` object +#' +#' @description +#' Calling [hasPriorPar()] checks if `model`-appropriate parameters are stored +#' in the `prior` object. +#' +#' @param object A `prior` object containing the specifications for the prior. +#' @param model A `model` object containing the specifications for the model. +#' @param verbose A logical indicating, if the output should be verbose. +#' @exportMethod hasPriorPar +#' @describeIn prior-class Checks for parameters in `prior` object +#' +#' @examples +#' # Define a Poisson mixture model. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Call the default constructor. +#' f_prior <- prior() +#' # Check if the prior has appropriate parameters defined. +#' hasPriorPar(f_prior) +#' hasPriorPar(f_prior, TRUE) +#' +#' @seealso +#' * [prior][prior-class] for the definition of the `prior` class +#' * [model][model_class] for the definition of the `model` class setMethod( "hasPriorPar", signature( object = "prior", @@ -105,6 +201,30 @@ setMethod( } ) +#' Checks for parameters in a `prior` object +#' +#' @description +#' Calling [hasPriorWeight()] checks if `model`-appropriate weight parameters +#' are stored in the `prior` object. +#' +#' @param object A `prior` object containing the specifications for the prior. +#' @param model A `model` object containing the specifications for the model. +#' @param verbose A logical indicating, if the output should be verbose. +#' @exportMethod hasPriorWeight +#' @describeIn prior-class Checks for prior weights in `prior` object +#' +#' @examples +#' # Define a Poisson mixture model. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Call the default constructor. +#' f_prior <- prior() +#' # Check if the prior has appropriate parameters defined. +#' hasPriorWeight(f_prior) +#' hasPriorWeight(f_prior, TRUE) +#' +#' @seealso +#' * [prior][prior-class] for the definition of the `prior` class +#' * [model][model_class] for the definition of the `model` class setMethod( "hasPriorWeight", signature( object = "prior", @@ -141,21 +261,28 @@ setMethod( } ) -### ----------------------------------------------------------------------- -### generaterPrior -### @description Generates an object of class 'prior' from input -### parameters, i.e. it fills all slots with appropriate -### values. The object itself is constructed before this -### method is called. -### @par obj an S4 object of class 'prior' -### @par fdata an S4 object of class 'fdata' -### @par model an S4 object of class 'model' -### @par varargin an S4 object of class 'prior' or 'missing' -### @par coef.mat not yet implemented -### @return a fully specified S4 object of class 'prior' -### @see .generatePrior -### @author Lars Simon Zehnder -### ----------------------------------------------------------------------- +#' Generates `prior` object +#' +#' @description +#' Calling [generatePrior()] generates the `prior` object when [priordefine()] +#' had been called. When this function is called all checks have been passed +#' and `prior` construction can take place. +#' +#' @param object A `prior` object to store the prior parameters and weights. +#' @param fdata An `fdata` object holding the data. Observations in slot `@@y` +#' must be existent. +#' @param model A `model` object specifying the finite mixture model. +#' @param varargin `NULL` or a `prior` object. This enables the user to pass in +#' an already constructed prior object that gets then completed. +#' @param prior.wagner A logical indicating, if the prior from Wagner (2007) +#' should be used in case of an exponential mixture model. +#' @param s A numeric specifying the standard deviation `s` for the +#' Metropolis-Hastings proposal. +#' @keywords internal +#' +#' @seealso +#' * [prior][prior-class] for the class definition +#' * [priordefine()] for the advanced class constructor using this method setMethod( "generatePrior", "prior", function(object, fdata, model, varargin, prior.wagner, s) { @@ -196,6 +323,15 @@ setMethod( } ) +#' Shows a summary of a `prior` object. +#' +#' Calling [show()] on a `prior` object gives an overview +#' of the slots of a `prior` object. +#' +#' @param object A `prior` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @describeIn prior-class setMethod( "show", "prior", function(object) { @@ -217,6 +353,20 @@ setMethod( ) ## Getters ## +#' Getter method of `prior` class. +#' +#' Returns the `weight` slot. +#' +#' @param object An `prior` object. +#' @returns The `weight` slot of the `object`. +#' @exportMethod getWeight +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Get the slot. +#' getWeight(f_prior) setMethod( "getWeight", "prior", function(object) { @@ -224,6 +374,21 @@ setMethod( } ) +## Getters ## +#' Getter method of `prior` class. +#' +#' Returns the `par` slot. +#' +#' @param object An `prior` object. +#' @returns The `par` slot of the `object`. +#' @exportMethod getPar +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Get the slot. +#' getPar(f_prior) setMethod( "getPar", "prior", function(object) { @@ -231,6 +396,21 @@ setMethod( } ) +## Getters ## +#' Getter method of `prior` class. +#' +#' Returns the `type` slot. +#' +#' @param object An `prior` object. +#' @returns The `type` slot of the `object`. +#' @exportMethod getType +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Get the slot. +#' getType(f_prior) setMethod( "getType", "prior", function(object) { @@ -238,6 +418,21 @@ setMethod( } ) +## Getters ## +#' Getter method of `prior` class. +#' +#' Returns the `hier` slot. +#' +#' @param object An `prior` object. +#' @returns The `hier` slot of the `object`. +#' @exportMethod getHier +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Get the slot. +#' getHier(f_prior) setMethod( "getHier", "prior", function(object) { @@ -246,6 +441,21 @@ setMethod( ) ## Setters ## +#' Setter method of `prior` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `prior` object. +#' @param value An integer defining the new value for the `@@weight` slot. +#' @returns None. +#' @exportMethod setWeight<- +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Set the slot. +#' setWeight(f_prior) <- matrix(c(0.5, 0.5), nrow = 1) setReplaceMethod( "setWeight", "prior", function(object, value) { @@ -255,6 +465,22 @@ setReplaceMethod( } ) +#' Setter method of `prior` class. +#' +#' Sets the slot. Returns the none. +#' +#' @param object An `prior` object. +#' @param value An integer defining the new value for the `@@par` slot. +#' @returns None. +#' @exportMethod setPar<- +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Set the slot. +#' setPar(f_prior) <- setPar(f_prior) <- list(a = matrix(c(1.2, 0.8), nrow = 1), +#' b = matrix(c(2.3, 0.4), nrow = 1)) setReplaceMethod( "setPar", "prior", function(object, value) { @@ -264,6 +490,21 @@ setReplaceMethod( } ) +#' Setter method of `prior` class. +#' +#' Sets the slot. Returns none. +#' +#' @param object An `prior` object. +#' @param value An integer defining the new value for the `@@type` slot. +#' @returns None. +#' @exportMethod setType<- +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Set the slot. +#' setType(f_prior) <- "condconjugate" setReplaceMethod( "setType", "prior", function(object, value) { @@ -273,6 +514,21 @@ setReplaceMethod( } ) +#' Setter method of `prior` class. +#' +#' Sets the slot. Returns none. +#' +#' @param object An `prior` object. +#' @param value An integer defining the new value for the `@@hier` slot. +#' @returns None. +#' @exportMethod setHier<- +#' @noRd +#' +#' @examples +#' # Generate a prior object. +#' f_prior <- prior() +#' # Set the slot. +#' setHier(f_prior) <- TRUE setReplaceMethod( "setHier", "prior", function(object, value) { @@ -285,22 +541,20 @@ setReplaceMethod( ### Private functions ### These functions are not exported -### ================================================================== -### Checking -### ------------------------------------------------------------------ - -### ------------------------------------------------------------------ -### .check.fdata.model.Prior -### @description Checks objects of classes 'fdata' and 'model' for -### validity and consistency. -### @par fdata.obj an S4 object of class 'fdata' -### @par model.obj an S4 object of class 'model' -### @return throws an error if any object is not valid or if -### the two objects are not consistent among each other -### @see fdata:::.valid.Fdata, fdata:::.hasY, model:::.valid.Model, -### .valid.fdata.model.Prior -### @author Lars Simon Zehnder -### ------------------------------------------------------------------- +#' Check validity of `fdata` and `model` objects for prior generation +#' +#' @description +#' For internal usage only. This function checks the validity of the passed in +#' objects `fdata` and `model` in [priordefine()]. This includes checking, if +#' the `fdata` object contains observations in slot `@@y` and, if the `model` +#' object is valid. Finally, the consistency between the two objects is checked. +#' +#' @param fdata.obj An `fdata` object. Must contain observations in slot `@@y` +#' to pass the checks. +#' @param model.obj A `model` object. Must be specified by parameters in slot +#' `@@par` and number of components in `@@K`. +#' @returns None. If the checks do not pass, an error is thrown. +#' @noRd ".check.fdata.model.Prior" <- function(fdata.obj, model.obj) { .valid.Fdata(fdata.obj) hasY(fdata.obj, verbose = TRUE) @@ -308,17 +562,16 @@ setReplaceMethod( .valid.fdata.model.Prior(fdata.obj, model.obj) } -### ------------------------------------------------------------------ -### .check.varargin.Prior -### @description Checks if the variable argument 'varargin' is also -### of class 'prior' and is valid. Throws an error if -### any condition is not fulfilled. -### @par obj any R object passed to the function 'priordefine()' -### by the user -### @return throws an error if 'obj' is not of class 'prior' -### @see validity -### @author Lars Simon Zehnder -### ------------------------------------------------------------------- +#' Check validity of `varargin` object for prior generation +#' +#' @description +#' For internal usage only. This function checks the optional `prior` object +#' passed in to [priordefine()]. This object has to be of class +#' [prior][prior-class] and has to be valid as this. +#' +#' @param obj Any object. +#' @returns None. If the checks do not pass, an error is thrown. +#' @noRd ".check.varargin.Prior" <- function(obj) { if (!inherits(obj, "prior")) { stop(paste("Argument 'varargin' is not of class 'prior'. ", @@ -333,6 +586,21 @@ setReplaceMethod( ### Has ### hasPar Prior +#' Checks for parameters in `prior` object +#' +#' @description +#' For internal usage only. This function checks, if a given +#' [prior][prior-class] contains specified parameters in its slot `@@par`. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.Prior" <- function(obj, model.obj, verbose) { dist <- model.obj@dist if (dist == "poisson") { @@ -351,6 +619,30 @@ setReplaceMethod( } ### hasPar Prior Poisson +#' Checks for parameters in `prior` object for Poisson mixture +#' +#' @description +#' For internal usage only. This function checks, if a given +#' [prior][prior-class] contains specified parameters in its slot `@@par`. For +#' a Poisson mixture the parameters must be a `list` with named elements `a` +#' and `b` for the Gamma shape and rate parameters, respectively. In addition +#' the dimension of the parameters are checked for validity. The dimension of +#' these parameters must conform to the number of components `K`. +#' +#' Hierarchical Poisson priors also need named shape parameter `g` and rate +#' parameter `G` in the parameter list in slot `@@par`. The heorarchical prior +#' is the same for each component, henceforth, there will be only one pair of +#' such parameters. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.poisson.Prior" <- function(obj, model.obj, verbose) { K <- model.obj@K if (length(obj@par) == 0) { @@ -430,7 +722,7 @@ setReplaceMethod( "in 'prior' object if slot 'hier' ", "is set to TRUE. Hierarchical Poisson models ", "need Gamma rate hyperparameter named ", - "'gG'.", + "'G'.", sep = "" ), call. = FALSE) } else { @@ -450,6 +742,27 @@ setReplaceMethod( } } +#' Checks for parameters in `prior` object for conditional Poisson mixture +#' +#' @description +#' For internal usage only. This function checks, if a given +#' [prior][prior-class] contains specified parameters in its slot `@@par`. For +#' a conditional Poisson mixture the parameters must be a `list` with named +#' elements `Q` and `N`, the component means and observations, respectively. +#' Furthermore, parameters `a` and `b` are needed for each of the `K` +#' components, defining the parameters of the uniform priors. As a final +#' parameter conditional Poisson mixtures need the standard deviation `s` for +#' the Metropolis-Hastings proposal. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.condpoisson.Prior" <- function(obj, model.obj, verbose) { K <- model.obj@K if (length(obj@par) == 0) { @@ -566,6 +879,24 @@ setReplaceMethod( } } +#' Checks for parameters in `prior` object for Poisson mixture +#' +#' @description +#' For internal usage only. This function checks, if a given +#' [prior][prior-class] contains specified parameters in its slot `@@par`. For +#' a Binomial mixture the parameters must be a `list` with named elements `a` +#' and `b` holding the shape and rate parameters of the Beta prior for each +#' component. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.binomial.Prior" <- function(obj, model.obj, verbose) { K <- model.obj@K if (!length(obj@par)) { @@ -605,7 +936,7 @@ setReplaceMethod( if (verbose) { stop(paste("Wrong specification of slot @par ", "in 'prior' object. Binomial models ", - "need Beta shape parameters named ", + "need Beta rate parameters named ", "'b'.", sep = "" ), call. = FALSE) @@ -633,9 +964,24 @@ setReplaceMethod( } } -### ----------------------------------------------------------------- -### .haspar.exponential.Prior -### ----------------------------------------------------------------- +#' Checks for parameters in `prior` object for exponential mixture +#' +#' @description +#' For internal usage only. This function checks, if a given +#' [prior][prior-class] contains specified parameters in its slot `@@par`. For +#' a exponential mixture the parameters must be a `list` with named elements +#' `a` and `b` defining the shape and rate parameters for the Gamma prior for +#' each of the `K` components. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.exponential.Prior" <- function(obj, model.obj, verbose) { K <- model.obj@K if (!length(obj@par)) { @@ -706,6 +1052,69 @@ setReplaceMethod( } } +#' Checks for parameters in `prior` object for a normal mixture +#' +#' @description +#' For internal usage only. This function checks, if a given +#' \code{\link{prior-class}} contains specified parameters in its slot `@@par`. For +#' a normal mixture the parameters must be a `list` with named elements `mu`, +#' and `sigma` defining the prior parameters for the mean and standard +#' deviations respectively. +#' +#' ## Conditionally conjugate prior +#' In case a conditional conjugate prior is chosen +#' `mu` and `sigma` must be lists with elements `b` and `N0` and `c` and `C`, +#' respectively. `b` and `N0` define the parameters of a normal prior with +#' means `b` and standard deviations `sigma/N0`. `c` and `C` define the shape +#' and rate parameters of an inverse Gamma prior for the standard deviations. +#' +#' ## Independent prior +#' If an independent prior is chosen, the elements `mu` and `sigma` in slot +#' `@@par` of the `prior` object must contain lists with the following +#' elements: `b` and `Binv` and `c` and `C`. `b` and `Binv` are the means and +#' inverse standard deviations of normal priors and `c` and `C` are the shape +#' and rate parameters of an inverse Gamma distribution, respectively. +#' +#' ## Hierarchical prior +#' In case of an hierarchical prior the list referred to by the name `sigma` in +#' `@@par` needs to contain a shape parameter `g` and rate parameter `G` of the +#' hierarchical gamma prior for the prior parameter `C`. +#' +#' ## Multivariate normal mixtures +#' In case that the `model.obj` defines a multivariate normal mixture +#' distribution the prior parameters are defined by `list` with elements `mu` +#' and `sigma` for the prior for the means and the prior for the +#' variance-covariance matrices, respectively. +#' +#' ### Conditionally conjugate prior +#' In case of a conditionally conjugate prior, the prior for the means is +#' defined by a `list` with elements named `b` and `N0` with `b` an `rxK` +#' matrix defining the means of the normal prior and `N0` an `1xK` vector +#' defining the scaling constants for the standard deviations of the normal +#' prior for the means. +#' The element `sigma` is a `list` with elements `c` and `C` defining the +#' parameters of the Wishart prior for the covariance matrices. `c` is an +#' `1xK` matrix or vector and `C` an `rxrxK` array. In +#' addition an element `logdetC` is required that contains the logarithmized +#' determinants of the matrices in `C`. +#' +#' ### Independent prior +#' In case an independent prior is used the element `mu` must contain a `list` +#' with elements `b` and `Binv`. `b` is the means matrix of dimension +#' `rxK` for the normal prior of `mu` and `Binv` contain the inverted +#' variance-covariance matrices of the normal prior. +#' The corresponding prior for the variance-covariance matrices `sigma` is the +#' same as for the conditionally conjugate prior. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.normal.Prior" <- function(obj, model.obj, verbose) { K <- model.obj@K if (length(obj@par) == 0) { @@ -932,6 +1341,82 @@ setReplaceMethod( } } +#' Checks for parameters in `prior` object for a normal mixture +#' +#' @description +#' For internal usage only. This function checks, if a given +#' [prior][prior-class] contains specified parameters in its slot `@@par`. For +#' a normal mixture the parameters must be a `list` with named elements `mu`, +#' and `sigma` defining the prior parameters for the mean and standard +#' deviations respecitvely. +#' +#' ## Conditionally conjugate prior +#' In case a conditional conjugate prior is chosen +#' `mu` and `sigma` must be lists with elements `b` and `N0` and `c` and `C`, +#' respectively. `b` and `N0` define the parameters of a normal prior with +#' means `b` and standard deviations `sigma/N0`. `c` and `C` define the shape +#' and rate parameters of an inverse Gamma prior for the standard deviations. +#' +#' ## Independent prior +#' If an independent prior is chosen, the elements `mu` and `sigma` in slot +#' `@@par` of the `prior` object must contain lists with the following +#' elements: `b` and `Binv` and `c` and `C`. `b` and `Binv` are the means and +#' inverse standard deviations of normal priors and `c` and `C` are the shape +#' and rate parameters of an inverse Gamma distribution respectively. +#' +#' ## Hierarchical prior +#' In case of an hierarchical prior the list referred to by the name `sigma` in +#' `@@par` needs to contain a shape parameter `g` and rate parameter `G` of the +#' hierarchical gamma prior for the prior parameter `C`. +#' +#' ## Multivariate normal mixtures +#' In case that the `model.obj` defines a multivariate normal mixture +#' distribution the prior parameters are defined by `list` with elements `mu` +#' and `sigma` for the prior for the means and the prior for the +#' variance-covariance matrices, resepectively. +#' +#' ### Conditionally conjugate prior +#' In case of a conditionally conjugate prior, the prior for the means is +#' defined by a `list` with elements named `b` and `N0` with `b` an `rxK` +#' matrix defining the means of the normal prior and `N0` an `1xK` vector +#' defining the scaling constants for the standard deviations of the normal +#' prior for the means. +#' The element `sigma` is a `list` with elements `c` and `C` defining the +#' parameters of the Wishart prior for the covariance matrices. `c` is an +#' `1xK` matrix or vector and `C` an `rxrxK` array. In +#' addition an element `logdetC` is required that contains the logarithmized +#' determinants of the matrices in `C`. +#' +#' ### Independent prior +#' In case an independent prior is used the element `mu` must contain a `list` +#' with elements `b` and `Binv`. `b` is the means matrix of dimension +#' `rxK` for the normal prior of `mu` and `Binv` contain the inverted +#' variance-covariance matrices of the normal prior. +#' The corresponding prior for the variance-covariance matrices `sigma` is the +#' same as for the conditionally conjugate prior. +#' +#' ## Prior for the degrees of freedom +#' The prior for the degrees of freedom is the same for univariate and +#' multivariate mixtures. in both cases the slot `@@par` must contain in its +#' `list` of prior parameters a field named `df` that further contains a `list` +#' with elements `type`, `trans`, `a0`, `b0`, and `d`. `type` defines the type +#' of prior used and must be set to `"inhier"` for the independent hierarchcial +#' prior. For this prior `trans` is the translation parameter and the other +#' parameters are further parameters to define the prior. All parameters are +#' `numeric`s. Furthermore, there is an additional parameter named `mhtune` +#' defining the width parameters of the uniform log random walk proposals for +#' the degrees of freedom in Metropolis-Hastings sampling. This field has to be +#' a vector of size `1xK`. +#' +#' @param obj A `prior` object to be checked. +#' @param model.obj A `model` object providing the model distribution for +#' which prior parameters should be checked. +#' @param verbose A logical indicating, if the output should be verbose or +#' silent. +#' @returns Either a logical indicating, if the passed-in `prior` object +#' contains defined parameters or verbose output. Throws an error, if the +#' checks do not pass. +#' @noRd ".haspar.student.Prior" <- function(obj, model.obj, verbose) { K <- model.obj@K if (length(obj@par) == 0) { @@ -1239,7 +1724,7 @@ setReplaceMethod( } else { if (!"mhtune" %in% names(obj@par$df)) { if (verbose) { - stop(paste("Wrog specification of slot @par in ", + stop(paste("Wrong specification of slot @par in ", "'prior' object. Priors for the degrees ", "of freedom need Metropolis-Hastings ", "tuning parameters named 'mhtune'.", @@ -1266,28 +1751,31 @@ setReplaceMethod( } } -### ----------------------------------------------------------------- -### obj, model.obj, verbose .generatePriorPoisson -### @description Generates the hyper parameters for a Poisson -### distribution. -### @par obj an S4 object of class 'prior' -### @par fdata.obj an S4 object of class 'fdata' -### @par model.obj an S4 object of class 'model' -### @par varargin am S4 object of class 'prior' -### @return a fully specified 'prior' object for Poisson -### models specified by 'model.obj' with data in -### 'fdata.obj' and predefined slots in 'varargin' -### @details the type of a data-dependent Poisson prior is -### is always conditionally conjugate Gamma with -### parameters: a: shape, 1 x model.obj@K -### b: rate, 1 x model.obj@K -### If not otherwise specified in 'varargin' an -### hierarchical Gamma distribution is chosen with -### parameters: g: shape, 1 x 1 -### G: rate, 1 x 1. -### @see ?prior, ?fdata, ?model -### @author Lars Simon Zehnder -### ------------------------------------------------------------------ +#' Generate default prior for Poisson mixture +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' a Poisson mixture. +#' +#' @details +#' The type of a data-dependent Poisson prior is +#' is always conditionally conjugate Gamma with +#' parameters: a: shape, 1 x model.obj@K +#' b: rate, 1 x model.obj@K +#' If not otherwise specified in 'varargin' an +#' hierarchical Gamma distribution is chosen with +#' parameters: g: shape, 1 x 1 +#' G: rate, 1 x 1. +#' +#' @param obj A `prior` object to be enriched by prior parameters. +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param varargin A `prior` object passed in by the user. Optional. +#' @return A `prior` object with specified prior parameters for the prior of +#' a Poisson mixture model. +#' @noRd +#' @seealso +#' * [priordefine()] for the calling function. ".generatePriorPoisson" <- function(obj, fdata.obj, model.obj, varargin) { K <- model.obj@K @@ -1333,6 +1821,22 @@ setReplaceMethod( return(obj) } +#' Generate default prior for conditional Poisson mixture +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' a conditional Poisson mixture. +#' +#' @param obj A `prior` object to be enriched by prior parameters. +#' @param fdata.obj An `fdata` object containing the data. +#' @param model.obj A `model` object specifying the mixture model. +#' @param varargin A `prior` object passed in by the user. Optional. +#' @return A `prior` object with specified prior parameters for the prior of +#' a conditional Poisson mixture model. +#' @importFrom stats kmeans +#' @noRd +#' @seealso +#' * [priordefine()] for the calling function. ".generatePriorCondPoisson" <- function(obj, fdata.obj, model.obj, s) { K <- model.obj@K @@ -1375,6 +1879,16 @@ setReplaceMethod( return(obj) } +#' Selects the Beta prior by quantiles. +#' +#' @description +#' For internal usage only. Not used. Rather a relic. +#' +#' @param quantile1 A `list`. +#' @param quantile2 A `list`. +#' @return Unknown. +#' @importFrom stats pbeta approx +#' @noRd ".select.beta.Prior" <- function(quantile1, quantile2) { betaprior1 <- function(K, x, p) { m.lo <- 0.0 @@ -1402,22 +1916,27 @@ setReplaceMethod( m0 <- betaprior1(K0, x1, p1) return(round(K0 * c(m0, (1 - m0)), 2)) } -### ---------------------------------------------------------------- -### .generatePriorBinomial -### @description Generates the hyper parameters for a Binomial -### distribution. -### @par obj an S4 object of class 'prior' -### @par model.obj an S4 object of class 'model' -### @return a fully specified 'prior' object for Binomial -### models specified by 'model.obj'. -### @details the type of generated Binomial prior is always -### conditionally conjugate Beta with parameters: -### a: shape, 1 x model.obj@K -### b: rate, 1 x model.obj@K; -### starting values are a = (1, 1), b = (1, 1). -### @see ?prior, ?model -### author Lars Simon Zehnder -### ---------------------------------------------------------------- + +#' Generate default prior for Binomial mixture +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' a Binomial mixture. +#' +#' @details +#' The type of generated Binomial prior is always a conditionally conjugate, +#' i.e. Beta with parameters: +#' a: shape, 1 x model.obj@@K +#' b: rate, 1 x model.obj@@K; +#' starting values are a = (1, 1), b = (1, 1). +#' +#' @param obj A `prior` object to be enriched by prior parameters. +#' @param model.obj A `model` object specifying the mixture model. +#' @return A `prior` object with specified prior parameters for the prior of +#' a Binomial mixture model. +#' @noRd +#' @seealso +#' * [priordefine()] for the calling function. ".generatePriorBinomial" <- function(obj, model.obj) { K <- model.obj@K obj@type <- "condconjugate" @@ -1431,24 +1950,25 @@ setReplaceMethod( return(obj) } -### ---------------------------------------------------------------- -### .generatePriorExponential -### @description Generates the hyper parameters for an Exponential -### distribution. -### @param obj an S4 object of class 'model' -### @param fdata.obj an S4 object of class 'fdata' -### @param model.obj an S4 object of class 'model' -### @param prior.wagner an R object of class 'logical' -### @return a fully specified 'prior' object for Exponential models -### specified by 'model.obj' and data specified in'fdata.obj' -### @detail If the identifier 'prior.wagner == TRUE' the prior from -### Wagner (2007) is taken. In the remaining case a -### prior is constructed from the analysis of overdispersion -### in the observations. This prior can also be hierarchical -### if specified. -### @see ?priordefine -### @author Lars Simon Zehnder -### ---------------------------------------------------------------- +#' Generate default prior for exponential mixture +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' a exponential mixture. +#' +#' @details +#' If the identifier `prior.wagner == TRUE` the prior from Wagner (2007) is +#' taken. In the remaining case a prior is constructed from the analysis of +#' over-dispersion in the observations. This prior can also be hierarchical +#' if specified. +#' +#' @param obj A `prior` object to be enriched by prior parameters. +#' @param model.obj A `model` object specifying the mixture model. +#' @return A `prior` object with specified prior parameters for the prior of +#' a exponential mixture model. +#' @noRd +#' @seealso +#' * [priordefine()] for the calling function. ".generatePriorExponential" <- function(obj, fdata.obj, model.obj, varargin, prior.wagner) { if (is.null(varargin)) { @@ -1520,6 +2040,22 @@ setReplaceMethod( return(obj) } +#' Generate default prior for normal or Student-t mixtures +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' a normal or Student-t mixture. +#' +#' @param obj A `prior` object to be enriched by prior parameters. +#' @param data.obj An `fdata` object storing the observations. +#' @param model.obj A `model` object specifying the mixture model. +#' @param varargin A `rpior` object passed in by the user with predefined +#' slots. +#' @return A `prior` object with specified prior parameters for the prior of +#' a normal or Student-t mixture model. +#' @noRd +#' @seealso +#' * [priordefine()] for the calling function. ".generatePriorNorstud" <- function(obj, data.obj, model.obj, varargin) { r <- data.obj@r @@ -1687,6 +2223,18 @@ setReplaceMethod( return(obj) } +#' Generate default prior for the degrees of freedom +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' the degrees of freedom. +#' +#' @param object A `prior` object to be enriched by prior parameters. +#' @return A `prior` object with specified prior parameters for the prior of +#' a Student-t mixture model. +#' @noRd +#' @seealso +#' * [priordefine()] for the calling function. ".generateDfPrior" <- function(object) { ## default prior: independent hierarchical prior following Fernandéz and Steel (1999) df.type <- "inhier" @@ -1703,11 +2251,24 @@ setReplaceMethod( return(object) } -### Prior weight: The prior distribution of the weights. -### @Distribution: Dirichlet -### @Parameters: -### e_1,...e_K, 1 x K -### A default with e_i = 4 for all i = 1, ..., K is chosen. +#' Generate default prior for the weights of any finite mixture +#' +#' @description +#' For internal usage only. This function constructs the default priors for +#' the weights of any finite mixture. +#' +#' @details +#' e_1,...e_K, 1 x K +#' A default with e_i = 4 for all i = 1, ..., K is chosen. +#' +#' @param object A `prior` object to be enriched by prior parameters. +#' @param model A `model` object specifying the mixture model. +#' @return A `prior` object with specified prior parameters for the weights of +#' any finite mixture model. +#' @noRd +#' +#' @seealso +#' * [priordefine()] for the calling function. ".generatePriorWeight" <- function(object, model) { K <- model@K if (K > 1 && !model@indicfix) { @@ -1719,11 +2280,20 @@ setReplaceMethod( return(object) } -### Validity -### Valid type: The prior @type must be one of the two choices -### 'independent' or 'condconjugate' (conditional conjugate). -### For some distribution models only one type of prior exists: -### @Poisson: 'condconjugate' +#' Check validity of type of a prior +#' +#' @description +#' For internal usage only. This function checks the `type` of a prior. Only +#' two values are possible: either `"condconjugate"` indicating a conditionally +#' conjugate prior or `"independent"` for an independence prior. +#' +#' @param obj A `prior` object with defined `@@type` slot. +#' @return None. Throws an error if the type is wrong. +#' @noRd +#' +#' @seealso +#' * [prior()] for the class constructor calling this checking function +#' * [priordefine()] for the advanced class constructor calling this function ".valid.type.Prior" <- function(obj) { type.choices <- c("condconjugate", "independent") if (!(obj@type %in% type.choices)) { @@ -1740,11 +2310,28 @@ setReplaceMethod( # } } -### The coefficient matrix 'coef.mat' for 'cond.poisson' -### distributions with conditional prior must be a lower -### triangular matrix with ones on its diagonal. -### Further it must be of type 'matrix' or 'array' with -### dimension K x K. +#' Check validity of type of a prior +#' +#' @description +#' For internal usage only. This function checks the argument `coef.mat` in +#' the constructors. This argument is not yet implemented for usage by the user. +#' +#' @details +#' The coefficient matrix `coef.mat` for `cond.poisson` +#' distributions with conditional prior must be a lower +#' triangular matrix with ones on its diagonal. +#' Further it must be of type `matrix` or `array` with +#' dimension `KxK`. +#' +#' @param model.obj A `model` object specifying the mixture model. +#' @param coef.mat A `matrix` containing the coefficients. Must be lower +#' triangular. +#' @return None. Throws an error if the coefficient matrix is wrongly specified. +#' @noRd +#' +#' @seealso +#' * [prior()] for the class constructor calling this checking function +#' * [priordefine()] for the advanced class constructor calling this function ".valid.coefmat.Prior" <- function(model.obj, coef.mat) { K <- model.obj@K if (is.null(coef.mat)) { @@ -1765,18 +2352,22 @@ setReplaceMethod( } } -### ------------------------------------------------------------------------------- -### .valid.fdata.model.Prior -### @description Checks for consistency between the specified model in slot -### @dist of the 'model' object and the dimension of variables -### @r in the 'fdata' object. Throws and error if no consistency -### exists. -### @par fdata.obj an S4 object of class 'fdata' -### @par model.obj an S4 object of class 'model' -### @return Throws an error if no consistency is found. -### @see ?fdata, ?model -### @author Lars Simon Zehnder -### -------------------------------------------------------------------------------- +#' Check consistency of `fdata` and `model` object for a prior +#' +#' @description +#' For internal usage only. This function checks the consistency of an `fdata` +#' object and a corresponding `model` object. Consistency is ensured, if the +#' distribution in slot `@@dist` of a `model` object conforms to the dimension +#' in slot `@@r` of the `fdata` object. +#' +#' @param fdata.obj An `fdata` object containing the observations. +#' @param model.obj A `model` object specifying the finite mixture model. +#' @return None. Throws an error if the type is wrong. +#' @noRd +#' +#' @seealso +#' * [prior()] for the class constructor calling this checking function +#' * [priordefine()] for the advanced class constructor calling this function ".valid.fdata.model.Prior" <- function(fdata.obj, model.obj) { if (model.obj@dist %in% .get.univ.Model() && fdata.obj@r > 1) { stop(paste("Wrong specification of slot 'r' in 'fdata' object. ", diff --git a/R/sdatamoments.R b/R/sdatamoments.R index cf57041..9014007 100644 --- a/R/sdatamoments.R +++ b/R/sdatamoments.R @@ -15,6 +15,23 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `sdatamoments` class +#' +#' Stores moments for indicators of discrete data. +#' +#' @slot gmoments A [groupmoments][groupmoments_class] object storing the +#' moments for each mixture component. +#' @slot fdata An [fdata][fdata_class] object with data from a discrete valued +#' mixture distribution. +#' @exportClass sdatamoments +#' @name sdatamoments_class +#' @seealso +#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments()] for the constructor of any object of the `datamoments` +#' class family +#' * [groupmoments][groupmoments_class] for the parent class +#' * [csdatamoments][csdatamoments_class] for the corresponding class defining +#' moments for data from a continuous-valued finite mixture .sdatamoments <- setClass("sdatamoments", representation( gmoments = "groupmoments", @@ -26,9 +43,46 @@ } ) +#' Finmix class union of `sdatamoments` and `NULL` +#' +#' @description +#' Defines a class union such that the object held by a child class can also +#' be `NULL`. +#' +#' @export +#' @keywords internal setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) ## mutual constructor for both types of sdatamoments ## +#' Finmix `sdatamoments` constructor +#' +#' Calling [sdatamoments()] constructs an object of class `sdatamoments` or +#' `csdatamoments` depending on the `type` slot of the argument `value`. If +#' this slot is `"discrete"` an `sdatamoments` object is returned and if the +#' slot is `"continuous"`, a `csdatamoments` object is returned. +#' +#' @param value An [fdata][fdata_class] object containing the indicators for +#' which moments should be calculated. +#' @return If slot `type` of the argument `value` is `"discrete"` an +#' `sdatamoments` object is returned and if the slot is `"continuous"`, +#' a `csdatamoments` object is returned. +#' @export +#' @name sdatamoments +#' +#' @example +#' # Define a model of exponential mixtures. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Compute data moments for the indicators. +#' sdatamoments(f_data) +#' +#' @seealso +#' * [sdatamoments][sdatamoments_class] for the class of indicator +#' moments for discrete data +#' * [csdatamoments][csdatamoments_class] for the class of indicator moments +#' for continuous +#' * [groupmoments][groupmoments_class] for the parent class## Copyright (C) 2013 Lars Simon Zehnder "sdatamoments" <- function(value = fdata()) { hasY(value, verbose = TRUE) hasS(value, verbose = TRUE) @@ -40,6 +94,23 @@ setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) return(object) } +#' Initializer of the `sdatamoments` class +#' +#' @description +#' Only used implicitly. The initializer calls the constructor for a +#' [groupmoments][groupmoments_class] object. to generate in the initialization +#' step the moments for a passed-in `fdata` object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix [fdata][fdata_class] object containing the observations. +#' @keywords internal +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "sdatamoments", function(.Object, ..., value = fdata()) { @@ -49,6 +120,16 @@ setMethod( } ) +#' Shows a summary of an `sdatamoments` object. +#' +#' Calling [show()] on an `sdatamoments` object gives an overview +#' of the moments of a finite mixture with discrete data. +#' +#' @param object An `sdatamoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn sdatamoments_class Shows a summary of an object setMethod( "show", "sdatamoments", function(object) { @@ -65,6 +146,31 @@ setMethod( ) ## Getters ## +#' Getter method of `sdatamoments` class. +#' +#' Returns the `gmoments` slot. +#' +#' @param object An `sdatamoments` object. +#' @returns The `gmoments` slot of the `object`. +#' @noRd +#' +#' @exportMethod getGmoments +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getGmoments(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [sdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getGmoments", "sdatamoments", function(object) { @@ -72,6 +178,30 @@ setMethod( } ) +#' Getter method of `sdatamoments` class. +#' +#' Returns the `fdata` slot. +#' +#' @param object An `sdatamoments` object. +#' @returns The `fdata` slot of the `object`. +#' @noRd +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_sdatamoms <- sdatamoments(f_data) +#' # Get the moments for the included indicators of the data. +#' getFdata(f_sdatamoms) +#' +#' @seealso +#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' class family +#' * [sdatamoments][sdatamoments_class] for the class definition +#' * [sdatamoments()][sdatamoments] for the constructor of the class setMethod( "getFdata", "sdatamoments", function(object) { @@ -80,4 +210,4 @@ setMethod( ) ## Setters ## -## No Setters, as it is adviced for users not to manipulate moment objects ## +## No Setters, as it is adviced for users not to manipulate moment objects ## \ No newline at end of file diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index 9558edd..6d77a36 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -15,6 +15,22 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . +#' Finmix `studentmodelmoments` class +#' +#' @description +#' Defines a class that holds theoretical moments for a finite mixture of +#' student distributions. Note that this class is not directly used, but +#' indirectly when calling the `modelmoments` constructor [modelmoments()]. +#' +#' @slot B A numeric defining the between-group heterogeneity. +#' @slot W A numeric defining the within-group heterogeneity. +#' @slot R A numeric defining the coefficient of determination. +#' @exportClass studentmodelmoments +#' @name studentmodelmoments +#' +#' @seealso +#' * \code{\link{modelmoments_class}} for the base class for model moments +#' * \code{\link{modelmoments}} for the constructor of `modelmoments` classes .studentmodelmoments <- setClass("studentmodelmoments", representation( B = "numeric", @@ -33,6 +49,24 @@ ) ) +#' Initializer of the `studentmodelmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "studentmodelmoments", function(.Object, ..., model) { @@ -41,6 +75,15 @@ setMethod( } ) +#' Generate moments for student mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' student mixture distribution. +#' +#' @param object An `studentmodelmoments` object. +#' @return An `studentmodelmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "studentmodelmoments", function(object) { @@ -48,6 +91,15 @@ setMethod( } ) +#' Shows a summary of an `studentmodelmoments` object. +#' +#' Calling [show()] on an `studentmodelmoments` object gives an overview +#' of the moments of an student finite mixture. +#' +#' @param object An `studentmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @describeIn studentmodelmoments setMethod( "show", "studentmodelmoments", function(object) { @@ -83,6 +135,25 @@ setMethod( ) ## Getters ## +#' Getter method of `studentmodelmoments` class. +#' +#' Returns the `B` slot. +#' +#' @param object An `studentmodelmoments` object. +#' @returns The `B` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- c(-2, 2) +#' sigmas <- matrix(c(2, 4), nrow=1) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(20, 40)) +#' f_moments <- modelmoments(f_model) +#' getB(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getB", "studentmodelmoments", function(object) { @@ -90,6 +161,25 @@ setMethod( } ) +#' Getter method of `studentmodelmoments` class. +#' +#' Returns the `W` slot. +#' +#' @param object An `studentmodelmoments` object. +#' @returns The `W` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- c(-2, 2) +#' sigmas <- matrix(c(2, 4), nrow=1) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(20, 40)) +#' f_moments <- modelmoments(f_model) +#' getW(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getW", "studentmodelmoments", function(object) { @@ -97,6 +187,25 @@ setMethod( } ) +#' Getter method of `studentmodelmoments` class. +#' +#' Returns the `R` slot. +#' +#' @param object An `studentmodelmoments` object. +#' @returns The `R` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- c(-2, 2) +#' sigmas <- matrix(c(2, 4), nrow=1) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(20, 40)) +#' f_moments <- modelmoments(f_model) +#' getR(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getR", "studentmodelmoments", function(object) { diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index 5f661a2..ae770cf 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -14,7 +14,22 @@ # # You should have received a copy of the GNU General Public License # along with finmix. If not, see . - +#' Finmix `studmultmodelmoments` class +#' +#' @description +#' Defines a class that holds modelmoments for a finite mixture of studmult +#' distributions. Note that this class is not directly used, but indirectly +#' when calling the `modelmoments` constructor [modelmoments()]. +#' +#' @slot B A numeric defining the between-group heterogeneity. +#' @slot W A numeric defining the within-group heterogeneity. +#' @slot R A numeric defining the coefficient of determination. +#' @exportClass studmultmodelmoments +#' @name studmultmodelmoments +#' +#' @seealso +#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes .studmultmodelmoments <- setClass("studmultmodelmoments", representation( B = "array", @@ -37,6 +52,24 @@ ) ) +#' Initializer of the `studmultmoments` class +#' +#' @description +#' Only used implicitly. The initializer calls a function `generateMoments()` +#' to generate in the initialization step also the moments for a passed `model` +#' object. +#' +#' @param .Object An object_ see the "initialize Methods" section in +#' [initialize]. +#' @param ... Arguments to specify properties of the new object, to be passed +#' to `initialize()`. +#' @param model A finmix `model` object containing the definition of the +#' finite mixture distribution. +#' @noRd +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "studmultmodelmoments", function(.Object, ..., model) { @@ -45,6 +78,15 @@ setMethod( } ) +#' Generate moments for studmult mixture +#' +#' @description +#' Implicit method. Calling [generateMoments()] generates the moments of an +#' studmult mixture distribution. +#' +#' @param object An `studmultmodelmoments` object. +#' @return An `studmultmodelmoments` object with calculated moments. +#' @noRd setMethod( "generateMoments", "studmultmodelmoments", function(object) { @@ -52,6 +94,16 @@ setMethod( } ) +#' Shows a summary of an `studmultmodelmoments` object. +#' +#' Calling [show()] on an `studmultmodelmoments` object gives an overview +#' of the moments of an studmult finite mixture. +#' +#' @param object An `studmultmodelmoments` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn studmultmodelmoments Shows a summary of an object setMethod( "show", "studmultmodelmoments", function(object) { @@ -98,6 +150,26 @@ setMethod( ) ## Getters ## +#' Getter method of `studmultmodelmoments` class. +#' +#' Returns the `B` slot. +#' +#' @param object An `studmultmodelmoments` object. +#' @returns The `B` slot of the `object`. +#' @noRd +#' @exportMethod getB +#' @examples +#' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +#' f_moments <- modelmoments(f_model) +#' getB(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getB", "studmultmodelmoments", function(object) { @@ -105,6 +177,26 @@ setMethod( } ) +#' Getter method of `studmultmodelmoments` class. +#' +#' Returns the `W` slot. +#' +#' @param object An `studmultmodelmoments` object. +#' @returns The `W` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +#' f_moments <- modelmoments(f_model) +#' getW(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getW", "studmultmodelmoments", function(object) { @@ -112,6 +204,26 @@ setMethod( } ) +#' Getter method of `studmultmodelmoments` class. +#' +#' Returns the `Rdet` slot. +#' +#' @param object An `studmultmodelmoments` object. +#' @returns The `Rdet` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +#' f_moments <- modelmoments(f_model) +#' getRdet(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getRdet", "studmultmodelmoments", function(object) { @@ -119,6 +231,26 @@ setMethod( } ) +#' Getter method of `studmultmodelmoments` class. +#' +#' Returns the `Rtr` slot. +#' +#' @param object An `studmultmodelmoments` object. +#' @returns The `Rtr` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +#' f_moments <- modelmoments(f_model) +#' getRtr(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getRtr", "studmultmodelmoments", function(object) { @@ -126,6 +258,26 @@ setMethod( } ) +#' Getter method of `studmultmodelmoments` class. +#' +#' Returns the `Corr` slot. +#' +#' @param object An `studmultmodelmoments` object. +#' @returns The `Corr` slot of the `object`. +#' @noRd +#' +#' @examples +#' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +#' means <- matrix(c(-2, -2, 2, 2),nrow = 2) +#' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +#' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +#' setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +#' f_moments <- modelmoments(f_model) +#' getCorr(f_moments) +#' +#' @seealso +#' * [modelmoments] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getCorr", "studmultmodelmoments", function(object) { @@ -138,6 +290,17 @@ setMethod( ### Private functions ### These function are not exported +#' Generate model moments for an studmult mixture +#' +#' @description +#' Only called implicitly. generates all moments of an studmult mixture +#' distribution. +#' +#' @param object An `studmultmodelmoments` object to contain all calculated +#' moments. +#' @returns An `studmultmodelmoments` object containing all moments of the +#' studmult mixture distributions. +#' @noRd ".generateMomentsStudmult" <- function(object) { mu <- object@model@par$mu sigma <- object@model@par$sigma diff --git a/R/unass.R b/R/unass.R index a489918..78f6746 100644 --- a/R/unass.R +++ b/R/unass.R @@ -1,34 +1,31 @@ -################################################################ -# Copyright (c) 2013 All Rights Reserved -# author: Barry Rowlingson -# created: January 2013 -# -# avialability: https://gist.github.com/spacedman/4543212 -################################################################# - #' Unstructuring assignments +#' +#' @description \code{unsass} assigns multiple objects in its argument +#' \code{rhs} (right-hand side) to multiple objects (names) chained in its +#' argument \code{lhs} (left-hand-side). +#' +#' This is a helper function to simplify the use of the package. The right-hand +#' side can be a function that returns multiple objects and the left-hand side +#' must be a formula with objects (names) chained by \code{~}. Assignment works +#' via \code{lhs %=% rhs}. +#' +#' @param lhs A \code{formula} chaining multiple objects (names) together by +#' \code{~}. These are the objects (names) the right-hand side should be +#' assigned to. +#' @param rhs A \code{list} of objects that should be assigned to the left-hand +#' side \code{lhs}. +#' @name unsass +#' @rdname unsass #' -#' \code{unsass} assigns multiple objects in its argument \code{rhs} (right-hand side) -#' to multiple objects (names) chained in its argument \code{lhs} (left-hand-side). -#' -#' This is a helper function to simplify the use of the package. The right-hand side can -#' be a function that returns multiple objects and the left-hand side must be a formula -#' with objects (names) chained by \code{~}. Assignment works via \code{lhs %=% rhs}. -#' -#' @param lhs A \code{formula} chaining multiple objects (names) together by \code{~}. -#' These are the objects (names) the right-hand side should be assigned to. -#' @param rhs A \code{list} of objects that should be assigned to the left-hand side -#' \code{lhs}. -#' -#' @return None. -#' -#' @example -#' f_model <- model(K=2, dist= 'poisson', par=list(lambda=c(0.17, 0.12)), weight = matrix(c(0.6, 0.4), nrow=1)) -#' f_data <- simulate(model) -#' mcmc <- mcmc() -#' f_data~f_model~mcmc) %=% mcmcstart(f_data, f_model, mcmc) -#' -#' @seealso \code{mcmcstart} +#' @examples +#' f_model <- model(K=2, dist= 'poisson', par=list(lambda=c(0.17, 0.12))) +#' f_data <- simulate(model) +#' mcmc <- mcmc() +#' (f_data~f_model~mcmc) %=% mcmcstart(f_data, f_model, mcmc) +#' +#' @author Barry Rowlingson (January, 2013) +#' @seealso +#' * \code{\link{mcmcstart}} for generating starting parameters or indicators "unsass" <- function(lhs, rhs) { nvalues <- length(rhs) lhss <- .getFormulaNames(lhs) @@ -47,8 +44,26 @@ invisible(0) } +#' Assigns `\%=\%` to the `unsass()` function +#' +#' +#' @name %=% +#' @rdname unsass +#' @aliases unsass +#' @export +#' @seealso +#' * \code{\link{unsass}} assign("%=%", unsass) +#' Extracts elements from a formula +#' +#' @description +#' Used in the \link{unsass} function. +#' +#' @param formula A formula defining the left-hand and right-hand side of the +#' assignment. +#' @return Elements from the formula. +#' @noRd ".getFormulaNames" <- function(formula) { ## extract elements from a~b[1]~c~d ## recursive - might be an easier way... @@ -58,7 +73,7 @@ assign("%=%", unsass) } else { if (is.call(formula)) { if (formula[[1]] == "~") { - return(c(getFormulaNames(formula[[2]]), getFormulaNames(formula[[3]]))) + return(c(.getFormulaNames(formula[[2]]), .getFormulaNames(formula[[3]]))) } else { return(formula) } diff --git a/inst/unitTests/Makefile b/inst/unitTests/Makefile deleted file mode 100644 index 3052dc2..0000000 --- a/inst/unitTests/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -TOP=../.. -PKG=${shell cd ${TOP};pwd} -SUITE=doRUnit.R -R=R - -all: inst test - -inst: # Install package - cd ${TOP}/..;\ - ${R} CMD INSTALL ${PKG} - -test: # Run unit tests - export RCMDCHECK=FALSE;\ - cd ${TOP}/tests;\ - ${R} --vanilla --slave < ${SUITE} diff --git a/inst/unitTests/report.html b/inst/unitTests/report.html deleted file mode 100644 index 4cd5f23..0000000 --- a/inst/unitTests/report.html +++ /dev/null @@ -1,81 +0,0 @@ - -RUNIT TEST PROTOCOL--Sat Aug 31 12:21:09 2013 - -

RUNIT TEST PROTOCOL--Sat Aug 31 12:21:09 2013

-

Number of test functions: 69

-

Number of errors: 0

-

Number of failures: 0

-
-

1 Test suite

- - - - - - - - - - - -
NameTest functionsErrorsFailures
finmix unit testing6900
-
-

Details

-

Test Suite: finmix unit testing
-Test function regexp: ^test.+
Test file regexp: ^runit.+\.[rR]$
Involved directory:
/Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
NameValue
platformx86_64-apple-darwin12.3.0
archx86_64
osdarwin12.3.0
systemx86_64, darwin12.3.0
statusPatched
major3
minor0.1
year2013
month05
day30
svn rev62840
languageR
version.stringR version 3.0.1 Patched (2013-05-30 r62840)
nicknameGood Sport
hostSimons-MacBook-Pro.local
compilerg++-4.8.1
- - diff --git a/inst/unitTests/report.txt b/inst/unitTests/report.txt deleted file mode 100644 index 2ee24bc..0000000 --- a/inst/unitTests/report.txt +++ /dev/null @@ -1,112 +0,0 @@ -RUNIT TEST PROTOCOL -- Sat Aug 31 12:21:09 2013 -*********************************************** -Number of test functions: 69 -Number of errors: 0 -Number of failures: 0 - - -1 Test Suite : -finmix unit testing - 69 test functions, 0 errors, 0 failures - - - -Details -*************************** -Test Suite: finmix unit testing -Test function regexp: ^test.+ -Test file regexp: ^runit.+\.[rR]$ -Involved directory: -/Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.dataclass.R -test.dataclass.exceptions: (6 checks) ... OK (0.02 seconds) -test.dataclass.poisson.default: (13 checks) ... OK (0.02 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.datamoments.R -test.datamoments.discrete: (33 checks) ... OK (0.01 seconds) -test.groupmoments.discrete: (17 checks) ... OK (0.01 seconds) -test.sdatamoments.discrete: (15 checks) ... OK (0.01 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.fdata.R -test.fdata: (10 checks) ... OK (0 seconds) -test.fdata.check.exp: (11 checks) ... OK (0.01 seconds) -test.fdata.check.N: (4 checks) ... OK (0.01 seconds) -test.fdata.check.r: (4 checks) ... OK (0.01 seconds) -test.fdata.check.S: (12 checks) ... OK (0.01 seconds) -test.fdata.check.T: (12 checks) ... OK (0.01 seconds) -test.fdata.check.type: (1 checks) ... OK (0 seconds) -test.fdata.check.y: (9 checks) ... OK (0 seconds) -test.fdata.getColExp: (2 checks) ... OK (0 seconds) -test.fdata.getColS: (2 checks) ... OK (0 seconds) -test.fdata.getColT: (2 checks) ... OK (0 seconds) -test.fdata.getColY: (2 checks) ... OK (0 seconds) -test.fdata.getRowS: (2 checks) ... OK (0 seconds) -test.fdata.getRowT: (2 checks) ... OK (0 seconds) -test.fdata.getRowY: (2 checks) ... OK (0 seconds) -test.fdata.hasExp: (3 checks) ... OK (0 seconds) -test.fdata.hasS: (3 checks) ... OK (0 seconds) -test.fdata.hasT: (3 checks) ... OK (0 seconds) -test.fdata.hasY: (3 checks) ... OK (0 seconds) -test.fdata.setBycolumn: (8 checks) ... OK (0 seconds) -test.fdata.setExp: (11 checks) ... OK (0.01 seconds) -test.fdata.setS: (11 checks) ... OK (0.01 seconds) -test.fdata.setT: (11 checks) ... OK (0.01 seconds) -test.fdata.setY: (10 checks) ... OK (0.01 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.mcmc.R -test.mcmc.default: (7 checks) ... OK (0 seconds) -test.mcmc.validity: (6 checks) ... OK (0 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.mcmcoutput.R -test.mcmcoutput.subseq: (5 checks) ... OK (0.53 seconds) -test.mcmcoutput.swapElements: (8 checks) ... OK (0.2 seconds) -test.swap_cc: (7 checks) ... OK (0 seconds) -test.swapInd_cc: (7 checks) ... OK (0 seconds) -test.swapInteger_cc: (7 checks) ... OK (0 seconds) -test.swapST_cc: (7 checks) ... OK (0 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.mcmcpermute.poisson.R -test.mcmcpermute.exceptions: (5 checks) ... OK (0.33 seconds) -test.mcmcpermute.kmeans: (49 checks) ... OK (0.69 seconds) -test.mcmcpermute.Stephens1997a: (49 checks) ... OK (35.61 seconds) -test.mcmcpermute.Stephens1997b: (49 checks) ... OK (2.09 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.mcmcstart.R -test.mcmcstart.exceptions: (4 checks) ... OK (0.01 seconds) -test.mcmcstart.poisson: (7 checks) ... OK (0.01 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.mixturemcmc.poisson.R -test.mixturemcmc.poisson.fix: (44 checks) ... OK (0.33 seconds) -test.mixturemcmc.poisson.ind: (88 checks) ... OK (0.71 seconds) -test.mixturemcmc.poisson.ind.byrow: (88 checks) ... OK (0.66 seconds) -test.mixturemcmc.poisson.ind.expos: (88 checks) ... OK (0.63 seconds) -test.mixturemcmc.poisson.ind.startpar: (88 checks) ... OK (0.7 seconds) -test.mixturemcmc.poisson.ind.startpar.ranperm: (88 checks) ... OK (0.7 seconds) -test.mixturemcmc.poisson.one: (44 checks) ... OK (0.24 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.mixturemcmc.R -test.mixturemcmc.exception: (11 checks) ... OK (0.01 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.model.R -test.model: (6 checks) ... OK (0 seconds) -test.model.check.dist: (2 checks) ... OK (0 seconds) -test.model.check.K: (4 checks) ... OK (0 seconds) -test.model.check.r: (3 checks) ... OK (0 seconds) -test.model.haspar: (4 checks) ... OK (0 seconds) -test.model.hasT: (2 checks) ... OK (0 seconds) -test.model.hasweight: (3 checks) ... OK (0 seconds) -test.model.setDist: (1 checks) ... OK (0 seconds) -test.model.setK: (1 checks) ... OK (0 seconds) -test.model.setPar: (5 checks) ... OK (0 seconds) -test.model.setT: (3 checks) ... OK (0 seconds) -test.model.setWeight: (3 checks) ... OK (0 seconds) -test.model.valid.par.poisson: (5 checks) ... OK (0.01 seconds) -test.model.valid.T: (2 checks) ... OK (0 seconds) -test.model.valid.weight: (3 checks) ... OK (0 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.modelmoments.R -test.modelmoments.poisson: (17 checks) ... OK (0.01 seconds) ---------------------------- -Test file: /Users/simonzehnder/finmixcopy/finmix/tests/../inst/unitTests/runit.prior.R -test.prior.default: (9 checks) ... OK (0 seconds) -test.prior.poisson: (27 checks) ... OK (0.01 seconds) diff --git a/inst/unitTests/reportSummary.txt b/inst/unitTests/reportSummary.txt deleted file mode 100644 index 2f2c824..0000000 --- a/inst/unitTests/reportSummary.txt +++ /dev/null @@ -1,9 +0,0 @@ -RUNIT TEST PROTOCOL -- Sat Aug 31 12:21:09 2013 -*********************************************** -Number of test functions: 69 -Number of errors: 0 -Number of failures: 0 - - -1 Test Suite : -finmix unit testing - 69 test functions, 0 errors, 0 failures diff --git a/inst/unitTests/runit.dataclass.R b/inst/unitTests/runit.dataclass.R deleted file mode 100644 index a28b3b0..0000000 --- a/inst/unitTests/runit.dataclass.R +++ /dev/null @@ -1,88 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Testing -"test.dataclass.exceptions" <- function() -{ - y <- .setUp.y() - checkException(dataclass(), "check1") - fdata.obj <- fdata(y = y) - checkException(dataclass(fdata.obj), "check2") - model.obj <- model("poisson", K = 2) - checkException(dataclass(model.obj, model.obj), "check3") - checkException(dataclass(fdata.obj, model.obj), "check4") - mcmc.obj <- mcmc(startpar = FALSE) - (fdata.obj~model.obj~mcmc.obj) %=% mcmcstart(fdata.obj, model.obj, mcmc.obj) - S <- as.matrix(sample(seq(1, 3), 100, TRUE)) - fdata.obj@S <- S - checkException(dataclass(fdata.obj, model.obj), "check5") - ## Model with fixed indicators - model.obj@indicfix <- TRUE - checkException(dataclass(fdata.obj, model.obj), "check6") -} - -"test.dataclass.poisson.default" <- function() -{ - ## Setup - y <- .setUp.y() - fdata.obj <- fdata(y = y) - model.obj <- model("poisson", K = 2) - mcmc.obj <- mcmc(startpar = FALSE) - (fdata.obj~model.obj~mcmc.obj) %=% mcmcstart(fdata.obj, model.obj, mcmc.obj) - datac.obj <- dataclass(fdata.obj, model.obj) - checkTrue(class(datac.obj) == "dataclass", "check1") - checkTrue(!all(is.na(datac.obj@logpy)), "check2") - checkTrue(!all(is.na(datac.obj@prob)), "check3") - checkTrue(!is.na(datac.obj@mixlik), "check4") - checkTrue(!is.na(datac.obj@entropy), "check5") - checkTrue(!all(is.na(datac.obj@loglikcd)), "check6") - ## With simulated indicators - datac.list <- dataclass(fdata.obj, model.obj, simS = TRUE) - datac.obj <- datac.list$dataclass - S <- datac.list$S - checkTrue(!is.na(datac.obj@postS), "check7") - checkTrue(!all(is.na(S)), "check8") - ## With fixed indicators - model.obj@indicfix <- TRUE - datac.obj <- dataclass(fdata.obj, model.obj) - checkTrue(!all(is.na(datac.obj@logpy)), "check9") - checkTrue(all(is.na(datac.obj@prob)), "check10") - checkTrue(all(is.na(datac.obj@mixlik)), "check11") - checkTrue(all(is.na(datac.obj@entropy)), "check12") - checkTrue(all(is.na(datac.obj@postS)), "check13") - ## With fixed indicators and simS = TRUE - datac.obj <- dataclass(fdata.obj, model.obj, simS = TRUE) -} diff --git a/inst/unitTests/runit.datamoments.R b/inst/unitTests/runit.datamoments.R deleted file mode 100644 index ece4a72..0000000 --- a/inst/unitTests/runit.datamoments.R +++ /dev/null @@ -1,142 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Start testing ## -"test.groupmoments.discrete" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - mom <- groupmoments(fdata.obj) - checkTrue(class(mom) == "groupmoments", "check1") - checkTrue("NK" %in% slotNames(mom), "check2") - checkTrue("mean" %in% slotNames(mom), "check3") - checkTrue("WK" %in% slotNames(mom), "check4") - checkTrue("var" %in% slotNames(mom), "check5") - checkTrue("fdata" %in% slotNames(mom), "check6") - checkTrue(!all(is.na(mom@NK)), "check7") - checkTrue(!all(is.na(mom@mean)), "check8") - checkTrue(!all(is.na(mom@WK)), "check9") - checkTrue(!all(is.na(mom@var)), "check10") - checkEquals(dim(mom@NK), 2) - checkEquals(dim(mom@mean), c(1, 2)) - checkEquals(dim(mom@WK), c(1, 1, 2)) - checkEquals(dim(mom@var), c(1, 1, 2)) - checkTrue(class(mom@fdata) == "fdata", "check11") - ## Check exception - fdata.obj <- fdata() - checkException(groupmoments(fdata.obj), "check12") - fdata.obj <- fdata(y = y) - checkException(groupmoments(fdata.obj), "check13") -} - -"test.sdatamoments.discrete" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - mom <- sdatamoments(fdata.obj) - checkTrue(class(mom) == "sdatamoments", "check1") - checkTrue("gmoments" %in% slotNames(mom), "check2") - checkTrue("fdata" %in% slotNames(mom), "check3") - checkTrue(class(mom@gmoments) == "groupmoments", "check4") - checkTrue(class(mom@fdata) == "fdata", "check5") - checkTrue(!all(is.na(mom@gmoments@NK)), "check6") - checkTrue(!all(is.na(mom@gmoments@mean)), "check7") - checkTrue(!all(is.na(mom@gmoments@WK)), "check8") - checkTrue(!all(is.na(mom@gmoments@var)), "check9") - checkEquals(dim(mom@gmoments@NK), 2) - checkEquals(dim(mom@gmoments@mean), c(1, 2)) - checkEquals(dim(mom@gmoments@WK), c(1, 1, 2)) - checkEquals(dim(mom@gmoments@var), c(1, 1, 2)) - ## Check exception - fdata.obj <- fdata() - checkException(sdatamoments(fdata.obj), "check10") - fdata.obj <- fdata(y = y) - checkException(sdatamoments(fdata.obj), "check11") -} - -"test.datamoments.discrete" <- function() -{ - ## Setup - ## No indicators - y <- .setUp.y() - fdata.obj <- fdata(y = y) - mom <- datamoments(fdata.obj) - checkTrue(class(mom) == "ddatamoments", "check1") - checkTrue("mean" %in% slotNames(mom), "check2") - checkTrue("var" %in% slotNames(mom), "check3") - checkTrue("fdata" %in% slotNames(mom), "check4") - checkTrue("factorial" %in% slotNames(mom), "check6") - checkTrue("over" %in% slotNames(mom), "check7") - checkTrue("zero" %in% slotNames(mom), "check8") - checkTrue("smoments" %in% slotNames(mom), "check9") - checkTrue(!all(is.na(mom@mean)), "check10") - checkTrue(!all(is.na(mom@var)), "check11") - checkTrue(!all(is.na(mom@factorial)), "check12") - checkTrue(!is.na(mom@over), "check13") - checkTrue(!is.na(mom@zero), "check14") - checkEquals(length(mom@mean), 1) - checkEquals(dim(mom@var), c(1, 1)) - checkEquals(dim(mom@factorial), c(4, 1)) - checkEquals(length(mom@over), 1) - checkEquals(length(mom@zero), 1) - checkTrue(class(mom@fdata) == "fdata", "check15") - checkTrue(class(mom@smoments) == "NULL", "check16") - ## Check exceptions - fdata.obj <- fdata() - checkException(datamoments(fdata.obj), "check17") - checkException(datamoments(), "check18") - ## Check with y and S - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - mom <- datamoments(fdata.obj) - checkTrue(class(mom@smoments) == "sdatamoments", "check19") - checkTrue(class(mom@smoments@gmoments) == "groupmoments", "check20") - gmom <- mom@smoments@gmoments - checkTrue(!all(is.na(gmom@NK)), "check21") - checkTrue(!all(is.na(gmom@mean)), "check22") - checkTrue(!all(is.na(gmom@WK)), "check23") - checkTrue(!all(is.na(gmom@var)), "check24") - checkEquals(dim(gmom@NK), 2) - checkEquals(dim(gmom@mean), c(1, 2)) - checkEquals(dim(gmom@WK), c(1, 1, 2)) - checkEquals(dim(gmom@var), c(1, 1, 2)) - checkTrue(class(gmom@fdata) == "fdata", "check25") -} - diff --git a/inst/unitTests/runit.fdata.R b/inst/unitTests/runit.fdata.R deleted file mode 100644 index 8ba5ed9..0000000 --- a/inst/unitTests/runit.fdata.R +++ /dev/null @@ -1,477 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Start testing ## -"test.fdata" <- function() -{ - ## Default ## - fdata.obj <- fdata() - checkTrue(all(is.na(fdata.obj@y)), "check1") - checkTrue(all(is.na(fdata.obj@S)), "check2") - checkTrue(all(is.na(fdata.obj@exp)),"check3") - checkTrue(all(is.na(fdata.obj@T)), "check4") - checkTrue(fdata.obj@bycolumn, "check5") - checkTrue(!fdata.obj@sim, "check6") - checkEquals(fdata.obj@N, 1) - checkEquals(fdata.obj@r, 1) - checkEquals(fdata.obj@type, "discrete") - checkEquals(length(fdata.obj@name), 0) -} - -"test.fdata.check.y" <- function() -{ - ## Setup ## - y <- .setUp.y() - fdata.obj <- fdata(y = y) - checkTrue(!all(is.na(fdata.obj@y)), "check1") - checkEquals(fdata.obj@N, nrow(fdata.obj@y)) - checkEquals(fdata.obj@r, ncol(fdata.obj@y)) - checkTrue(fdata.obj@bycolumn, "check2") - ## Check row-ordering ## - y <- t(.setUp.y()) - fdata.obj <- fdata(y = y) - checkTrue(!all(is.na(fdata.obj@y)), "check3") - checkEquals(fdata.obj@N, ncol(fdata.obj@y)) - checkEquals(fdata.obj@r, nrow(fdata.obj@y)) - checkTrue(!fdata.obj@bycolumn, "check4") - ## Check exception - y <- matrix("", nrow = 20) - checkException(fdata(y = y), "check5") -} - -"test.fdata.check.N" <- function() -{ - ## Setup - fdata.obj <- fdata(N = 200) - checkEquals(fdata.obj@N, 200) - y <- .setUp.y() - fdata.obj <- fdata(y = y, N = 100) - ## Check exception - checkException(fdata(y = y, N = 200), "check1") - ## Check row-ordering - y <- t(y) - fdata.obj <- fdata(y = y, N = 100) - checkEquals(fdata.obj@N, 100) - checkException(fdata(y = y, N = 200), "check2") -} - -"test.fdata.check.r" <- function() -{ - ## Setup - fdata.obj <- fdata(r = 2, type = "continuous") - checkEquals(fdata.obj@r, 2) - y <- .setUp.y() - fdata.obj <- fdata(y = y, r = 1) - ## Check exception - checkException(fdata(y = y, r = 2), "check1") - ## Check row-ordering - y <- t(y) - fdata.obj <- fdata(y = y, r = 1) - checkEquals(fdata.obj@r, 1) - checkException(fdata(y = y, r = 2), "check2") -} - -"test.fdata.check.type" <- function() -{ - checkException(fdata(type = "jump"), "check1") -} - -"test.fdata.check.S" <- function() -{ - S <- .setUp.S() - fdata.obj <- fdata(S = S$V1) - checkTrue(!all(is.na(fdata.obj@S)), "check1") - checkEquals(fdata.obj@N, NROW(S$V1)) - checkEquals(fdata.obj@r, 1) - ## Check row-ordering - S <- t(S$V1) - fdata.obj <- fdata(S = S) - checkTrue(!all(is.na(fdata.obj@S)), "check2") - checkEquals(fdata.obj@N, NCOL(S)) - checkEquals(fdata.obj@r, 1) - ## Check Exception - S <- matrix("", nrow = 10) - checkException(fdata(S = S), "check23") - S <- matrix(c(2.3, 4.1, 2.3)) - fdata.obj <- fdata(S = S) - checkEquals(fdata.obj@S[1], 2) - S <- .setUp.S() - S <- S$V1[1:50] - y <- .setUp.y() - checkException(fdata(y = y, S = S), "check4") - S <- .setUp.S() - S <- cbind(S$V1, S$V1) - checkException(fdata(S = S), "check5") - checkException(fdata(S = t(S)), "check6") - S <- c(2, 1, 1, 1, 2, -1) - checkException(fdata(S = S), "check7") -} - -"test.fdata.check.T" <- function() -{ - T <- .setUp.S() - fdata.obj <- fdata(T = T$V1) - checkTrue(!all(is.na(fdata.obj@T)), "check1") - checkEquals(fdata.obj@N, NROW(T)) - checkEquals(fdata.obj@r, 1) - ## Check row-ordering - T <- t(T$V1) - fdata.obj <- fdata(T = T) - checkTrue(!all(is.na(fdata.obj@T)), "check2") - checkEquals(fdata.obj@N, NCOL(T)) - checkEquals(fdata.obj@r, 1) - ## Check exceptions - T <- matrix("", nrow = 10) - checkException(fdata(T = T), "check3") - T <- matrix(c(2.3, 4.1, 2.3)) - fdata.obj <- fdata(T = T) - checkEquals(fdata.obj@T[1], 2) - T <- .setUp.S() - T <- T$V1[1:50] - y <- .setUp.y() - checkException(fdata(y = y, T = T), "check4") - T <- .setUp.S() - T <- cbind(T$V1, T$V1) - checkException(fdata(T = T), "check5") - checkException(fdata(T = t(T)), "check6") - T <- c(2, 1, 2, 2, 0) - checkException(fdata(T = T), "check7") -} - -"test.fdata.check.exp" <- function() -{ - expos <- .setUp.y() - fdata.obj <- fdata(exp = expos$V1) - checkTrue(!all(is.na(fdata.obj@exp)), "check1") - checkEquals(fdata.obj@N, NROW(expos)) - checkEquals(fdata.obj@r, 1) - ## Check row-ordering - expos <- t(expos$V1) - fdata.obj <- fdata(exp = expos) - checkTrue(!all(is.na(fdata.obj@exp)), "check2") - checkEquals(fdata.obj@N, NCOL(expos)) - checkEquals(fdata.obj@r, 1) - ## Check exceptions - expos <- matrix("", nrow = 10) - checkException(fdata(exp = expos), "check3") - expos <- .setUp.y() - expos <- expos$V1[1:50] - y <- .setUp.y() - checkException(fdata(y = y, exp = expos), "check4") - expos <- .setUp.y() - expos <- cbind(expos$V1, expos$V1) - checkException(fdata(exp = expos), "check5") - checkException(fdata(exp = t(expos)), "check6") - expos <- c(2, -1, 3, 1, 2, 0.0003) - checkException(fdata(exp = expos), "check7") -} - -"test.fdata.setY" <- function() -{ - ## Default - fdata.obj <- fdata() - y <- .setUp.y() - setY(fdata.obj) <- y - checkTrue(!all(is.na(fdata.obj@y)), "check1") - checkEquals(fdata.obj@N, NROW(y)) - checkEquals(fdata.obj@r, 1) - ## Check row-ordering - setY(fdata.obj) <- t(y) - ## Check with S - S <- .setUp.S() - fdata.obj <- fdata(S = S$V1) - checkEquals(fdata.obj@N, NROW(S$V1)) - setY(fdata.obj) <- y - checkTrue(!all(is.na(fdata.obj@y)), "check2") - checkEquals(fdata.obj@N, NROW(S$V1)) - checkEquals(fdata.obj@r, 1) - setY(fdata.obj) <- t(y) - checkEquals(nrow(fdata.obj@y), NROW(S$V1)) - checkEquals(ncol(fdata.obj@y), 1) - y <- cbind(y, y) - setType(fdata.obj) <- "continuous" - setY(fdata.obj) <- y - setY(fdata.obj) <- t(y) - ## Check exception - y <- matrix("", nrow = 10) - checkException(setY(fdata.obj) <- y, "check3") -} - -"test.fdata.setBycolumn" <- function() -{ - ## Default - fdata.obj <- fdata() - setBycolumn(fdata.obj) <- FALSE - y <- .setUp.y() - fdata.obj <- fdata(y = y) - setBycolumn(fdata.obj) <- TRUE - checkTrue(getBycolumn(fdata.obj), "check1") - setBycolumn(fdata.obj) <- FALSE - checkTrue(!getBycolumn(fdata.obj), "check2") - checkEquals(nrow(fdata.obj@y), NCOL(y)) - checkEquals(ncol(fdata.obj@y), NROW(y)) - checkEquals(fdata.obj@N, NROW(y)) - checkEquals(fdata.obj@r, NCOL(y)) - S <- .setUp.S() - fdata.obj <- fdata(S = S$V1) - setBycolumn(fdata.obj) <- FALSE - checkEquals(nrow(fdata.obj@S), NCOL(S$V1)) - checkEquals(ncol(fdata.obj@S), NROW(S$V1)) -} - -"test.fdata.setS" <- function() -{ - ## Default - fdata.obj <- fdata() - S <- .setUp.S() - setS(fdata.obj) <- S$V1 - checkTrue(!all(is.na(fdata.obj@S)), "check1") - ## Check row-ordering - setS(fdata.obj) <- t(S$V1) - checkEquals(nrow(fdata.obj@S), NROW(S$V1)) - checkEquals(ncol(fdata.obj@S), NCOL(S$V1)) - ## Check with y - y <- .setUp.y() - fdata.obj <- fdata(y = y) - setS(fdata.obj) <- S$V1 - checkEquals(nrow(fdata.obj@S), NROW(S$V1)) - checkEquals(ncol(fdata.obj@S), NCOL(S$V1)) - ## Check with y and row-ordering - fdata.obj <- fdata(y = t(y)) - setS(fdata.obj) <- S$V1 - checkEquals(nrow(fdata.obj@S), NCOL(S$V1)) - checkEquals(ncol(fdata.obj@S), NROW(S$V1)) - fdata.obj <- fdata(y = y) - setS(fdata.obj) <- t(S$V1) - checkEquals(nrow(fdata.obj@S), NROW(S$V1)) - checkEquals(ncol(fdata.obj@S), NCOL(S$V1)) - ## Check exception - S <- c(2, 1, 2, - 1) - checkException(setS(fdata.obj) <- S, "check2") - S <- matrix("", nrow = 10) - checkException(setS(fdata.obj) <- S, "check3") -} - -"test.fdata.setExp" <- function() -{ - ## Default - fdata.obj <- fdata() - expos <- .setUp.y() - expos <- matrix(expos$V1) - setExp(fdata.obj) <- expos - checkTrue(!all(is.na(fdata.obj@exp)), "check1") - ## Check row-ordering - setExp(fdata.obj) <- t(expos) - checkEquals(nrow(fdata.obj@exp), NROW(expos)) - checkEquals(ncol(fdata.obj@exp), NCOL(expos)) - ## Check with y - y <- .setUp.y() - fdata.obj <- fdata(y = y) - setExp(fdata.obj) <- expos - checkEquals(nrow(fdata.obj@exp), NROW(expos)) - checkEquals(ncol(fdata.obj@exp), NCOL(expos)) - ## Check with y and row-ordering - fdata.obj <- fdata(y = t(y)) - setExp(fdata.obj) <- expos - checkEquals(nrow(fdata.obj@exp), NCOL(expos)) - checkEquals(ncol(fdata.obj@exp), NROW(expos)) - fdata.obj <- fdata(y = y) - setExp(fdata.obj) <- t(expos) - checkEquals(nrow(fdata.obj@exp), NROW(expos)) - checkEquals(ncol(fdata.obj@exp), NCOL(expos)) - ## Check exception - expos <- c(2, 1, 2, - 1) - checkException(setExp(fdata.obj) <- expos, "check2") - expos <- matrix("", nrow = 10) - checkException(setExp(fdata.obj) <- expos, "check3") -} - -"test.fdata.setT" <- function() -{ - ## Default - fdata.obj <- fdata() - T <- .setUp.S() - setT(fdata.obj) <- T$V1 - checkTrue(!all(is.na(fdata.obj@T)), "check1") - ## Check row-ordering - setT(fdata.obj) <- t(T$V1) - checkEquals(nrow(fdata.obj@T), NROW(T$V1)) - checkEquals(ncol(fdata.obj@T), NCOL(T$V1)) - ## Check with y - y <- .setUp.y() - fdata.obj <- fdata(y = y) - setT(fdata.obj) <- T$V1 - checkEquals(nrow(fdata.obj@T), NROW(T$V1)) - checkEquals(ncol(fdata.obj@T), NCOL(T$V1)) - ## Check with y and row-ordering - fdata.obj <- fdata(y = t(y)) - setT(fdata.obj) <- T$V1 - checkEquals(nrow(fdata.obj@T), NCOL(T$V1)) - checkEquals(ncol(fdata.obj@T), NROW(T$V1)) - fdata.obj <- fdata(y = y) - setT(fdata.obj) <- t(T$V1) - checkEquals(nrow(fdata.obj@T), NROW(T$V1)) - checkEquals(ncol(fdata.obj@T), NCOL(T$V1)) - ## Check exception - T <- c(2, 1, 2, - 1) - checkException(setT(fdata.obj) <- T, "check2") - T <- matrix("", nrow = 10) - checkException(setT(fdata.obj) <- T, "check3") -} - -"test.fdata.hasY" <- function() -{ - ## Default - fdata.obj <- fdata() - checkTrue(!hasY(fdata.obj), "check1") - checkException(hasY(fdata.obj, verbose = TRUE), "check2") - y <- .setUp.y() - fdata.obj <- fdata(y = y) - checkTrue(hasY(fdata.obj), "check3") -} - -"test.fdata.hasS" <- function() -{ - ## Default - fdata.obj <- fdata() - checkTrue(!hasS(fdata.obj), "check1") - checkException(hasS(fdata.obj, verbose = TRUE), "check2") - S <- .setUp.S() - fdata.obj <- fdata(S = S$V1) - checkTrue(hasS(fdata.obj), "check3") -} - -"test.fdata.hasExp" <- function() -{ - ## Default - fdata.obj <- fdata() - checkTrue(!hasExp(fdata.obj), "check1") - checkException(hasExp(fdata.obj, verbose = TRUE), "check2") - expos <- .setUp.y() - fdata.obj <- fdata(exp = expos$V1) - checkTrue(hasExp(fdata.obj), "check3") -} - -"test.fdata.hasT" <- function() -{ - ## Default - fdata.obj <- fdata() - checkTrue(!hasT(fdata.obj), "check1") - checkException(hasT(fdata.obj, verbose = TRUE), "check2") - T <- .setUp.S() - fdata.obj <- fdata(T = T$V1) - checkTrue(hasT(fdata.obj), "check3") -} - -"test.fdata.getColY" <- function() -{ - ## Default - y <- .setUp.y() - fdata.obj <- fdata(y = y) - y.out <- getColY(fdata.obj) - checkEquals(nrow(y.out), NROW(y)) - checkEquals(ncol(y.out), NCOL(y)) -} - -"test.fdata.getRowY" <- function() -{ - ## Default - y <- .setUp.y() - fdata.obj <- fdata(y = y) - y.out <- getRowY(fdata.obj) - checkEquals(ncol(y.out), NROW(y)) - checkEquals(nrow(y.out), NCOL(y)) -} - -"test.fdata.getColS" <- function() -{ - ## Default - S <- .setUp.S() - fdata.obj <- fdata(S = S$V1) - S.out <- getColS(fdata.obj) - checkEquals(nrow(S.out), NROW(S)) - checkEquals(ncol(S.out), NCOL(S)) -} - -"test.fdata.getRowS" <- function() -{ - ## Default - S <- .setUp.S() - fdata.obj <- fdata(S = S$V1) - S.out <- getRowS(fdata.obj) - checkEquals(ncol(S.out), NROW(S)) - checkEquals(nrow(S.out), NCOL(S)) -} - -"test.fdata.getColExp" <- function() -{ - ## Default - expos <- .setUp.y() - fdata.obj <- fdata(exp = expos$V1) - exp.out <- getColExp(fdata.obj) - checkEquals(nrow(exp.out), NROW(expos)) - checkEquals(ncol(exp.out), NCOL(expos)) -} - -"test.fdata.getRowY" <- function() -{ - ## Default - expos <- .setUp.y() - fdata.obj <- fdata(exp = expos$V1) - exp.out <- getRowExp(fdata.obj) - checkEquals(ncol(exp.out), NROW(expos)) - checkEquals(nrow(exp.out), NCOL(expos)) -} - -"test.fdata.getColT" <- function() -{ - ## Default - T <- .setUp.S() - fdata.obj <- fdata(T = T$V1) - T.out <- getColT(fdata.obj) - checkEquals(nrow(T.out), NROW(T)) - checkEquals(ncol(T.out), NCOL(T)) -} - -"test.fdata.getRowT" <- function() -{ - ## Default - T <- .setUp.S() - fdata.obj <- fdata(T = T$V1) - T.out <- getRowT(fdata.obj) - checkEquals(ncol(T.out), NROW(T)) - checkEquals(nrow(T.out), NCOL(T)) -} diff --git a/inst/unitTests/runit.mcmc.R b/inst/unitTests/runit.mcmc.R deleted file mode 100644 index b4e92ae..0000000 --- a/inst/unitTests/runit.mcmc.R +++ /dev/null @@ -1,34 +0,0 @@ -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -## Testing -"test.mcmc.default" <- function() -{ - ## Default - mcmc.obj <- mcmc() - checkTrue(class(mcmc.obj) == "mcmc", "check1") - checkTrue(mcmc.obj@startpar, "check2") - checkTrue(mcmc.obj@ranperm, "check3") - checkTrue(mcmc.obj@storepost, "check4") - checkEquals(mcmc.obj@burnin, 0) - checkEquals(mcmc.obj@M, 5000) - checkEquals(mcmc.obj@storeS, 1000) -} - -"test.mcmc.validity" <- function() -{ - ## Setup - ## checkException - checkException(mcmc(burnin = -10), "check1") - checkException(mcmc(storeS = -2), "check2") - checkException(mcmc(M = 0), "check3") - ## Setters - mcmc.obj <- mcmc() - checkException(setBurnin(mcmc.obj) <- -10, "check4") - checkException(setStoreS(mcmc.obj) <- -10, "check5") - checkException(setM(mcmc.obj) <- 0, "check6") -} diff --git a/inst/unitTests/runit.mcmcoutput.R b/inst/unitTests/runit.mcmcoutput.R deleted file mode 100644 index afbc32c..0000000 --- a/inst/unitTests/runit.mcmcoutput.R +++ /dev/null @@ -1,179 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Testing -"test.mcmcoutput.subseq" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmc.obj <- mcmc() - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - index <- matrix(seq(1, mcmcout@M) < 6, nrow = mcmcout@M, - ncol = 1) - mcmcsub <- subseq(mcmcout, index) - checkEquals(mcmcsub@M, 5) - ## Test exceptions - checkException(subseq(mcmcout), "check1") - checkException(subseq(mcmcout, TRUE), "check2") - index <- matrix(1, nrow = mcmcout@M, ncol = 2) - checkException(subseq(mcmcout, index), "check3") - index <- matrix(mcmcout@M > 1, nrow = mcmcout@M, ncol = 2) - checkException(subseq(mcmcout, index), "check4") -} - -"test.mcmcoutput.swapElements" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmc.obj <- mcmc(storeS = 1) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - index <- matrix(as.integer(2), nrow = 100, ncol = 2) - checkException(swapElements(mcmcout, index), "check1") - index <- matrix(as.integer(c(2, 1)), nrow = mcmcout@M, - ncol = 2, byrow = TRUE) - mcmcout.perm <- swapElements(mcmcout, index) - checkTrue(any(mcmcout@par$lambda != mcmcout.perm@par$lambda), "check2") - checkTrue(any(mcmcout@post$par$a != mcmcout.perm@post$par$a), "check3") - checkTrue(any(mcmcout@post$par$b != mcmcout.perm@post$par$b), "check4") - checkTrue(any(mcmcout@weight != mcmcout.perm@weight), "check5") - checkTrue(any(mcmcout@ST != mcmcout.perm@ST), "check6") - checkTrue(any(mcmcout@S != mcmcout.perm@S), "check7") - checkTrue(any(mcmcout@NK != mcmcout.perm@NK), "check8") -} - - -### --- Test [[Rcpp::export]] functions --- ### - -"test.swap_cc" <- function() { - set.seed(0) - values <- matrix(rnorm(20), nrow = 10, ncol = 2) - perm.index <- matrix(as.integer(c(2,1)), nrow = 10, ncol = 2, byrow = TRUE) - values.perm <- swap_cc(values, perm.index) - ## Test cases ## - checkEquals(nrow(values), nrow(values.perm)) - checkEquals(ncol(values), ncol(values.perm)) - checkTrue(!any(values == values.perm), "check3") - ## Test exception ## - perm.index <- matrix(as.integer(c(2,1)), nrow = 1, ncol = 2, byrow = TRUE) - checkException(swap_cc(values, perm.index), silent = TRUE) - ## --- Check for K = 3 --- ## - values <- matrix(rnorm(30), nrow = 10, ncol = 3) - perm.index <- matrix(as.integer(c(2, 3, 1)), nrow = 10, ncol = 3, byrow = TRUE) - values.perm <- swap_cc(values, perm.index) - ## Test cases ## - checkEquals(nrow(values), nrow(values.perm)) - checkEquals(ncol(values), ncol(values.perm)) - checkTrue(!any(values == values.perm), "check7") -} - -"test.swapInteger_cc" <- function() { - set.seed(0) - values <- matrix(as.integer(rpois(20, 2)), nrow = 10, ncol = 2) - perm.index <- matrix(as.integer(c(2,1)), nrow = 10, ncol = 2, byrow = TRUE) - values.perm <- swapInteger_cc(values, perm.index) - ## Test cases ## - checkEquals(nrow(values), nrow(values.perm)) - checkEquals(ncol(values), ncol(values.perm)) - checkTrue(!any(values == values.perm), "check3") - ## Test exception ## - perm.index <- matrix(as.integer(c(2,1)), nrow = 1, ncol = 2, byrow = TRUE) - checkException(swapInteger_cc(values, perm.index), silent = TRUE) - ## --- Check for K = 3 --- ## - values <- matrix(as.integer(rpois(30, 2)), nrow = 10, ncol = 3) - perm.index <- matrix(as.integer(c(2, 3, 1)), nrow = 10, ncol = 3, byrow = TRUE) - values.perm <- swapInteger_cc(values, perm.index) - ## Test cases ## - checkEquals(nrow(values), nrow(values.perm)) - checkEquals(ncol(values), ncol(values.perm)) - checkTrue(!all(values == values.perm), "check7") -} - -"test.swapInd_cc" <- function() { - set.seed(0) - indicator <- matrix(sample(c(1,2), 10, replace = TRUE)) - perm.index <- matrix(as.integer(c(2,1)), nrow = 1, ncol = 2, byrow = TRUE) - indicator.perm <- swapInd_cc(indicator, perm.index) - ## Test cases ## - checkEquals(nrow(indicator.perm), nrow(indicator)) - checkEquals(ncol(indicator.perm), ncol(indicator)) - checkTrue(!any(indicator == indicator.perm), "check3") - ## Test exception ## - perm.index <- matrix(c(2,1), nrow = 2, ncol = 2, byrow = TRUE) - checkException(swapInd_cc(indicator, perm.index), silent = TRUE) - ## --- Check K = 3 --- ## - set.seed(0) - indicator <- matrix(sample(c(1, 2, 3), 10, replace = TRUE)) - perm.index <- matrix(as.integer(c(2, 3, 1)), nrow = 1, ncol = 3, byrow = TRUE) - indicator.perm <- swapInd_cc(indicator, perm.index) - ## Test cases ## - checkEquals(nrow(indicator), nrow(indicator.perm)) - checkEquals(ncol(indicator), ncol(indicator.perm)) - checkTrue(!any(indicator == indicator.perm), "check7") -} - -"test.swapST_cc" <- function() { - set.seed(0) - indicator <- matrix(sample(c(1,2), 10, replace = TRUE)) - perm.index <- matrix(as.integer(c(2,1)), nrow = 10, ncol = 2, byrow = TRUE) - indicator.perm <- swapST_cc(indicator, perm.index) - ## Test cases ## - checkEquals(nrow(indicator), nrow(indicator.perm)) - checkEquals(ncol(indicator), ncol(indicator.perm)) - checkTrue(!any(indicator == indicator.perm), "check3") - ## Test exception ## - perm.index <- matrix(as.integer(c(2,1)), nrow = 2, ncol = 2, byrow = TRUE) - checkException(swapST_cc(indicator, perm.index), silent = TRUE) - ## --- Check for K = 3 --- ## - set.seed(0) - indicator <- matrix(sample(c(1, 2, 3), 10, replace = TRUE)) - perm.index <- matrix(as.integer(c(2, 3, 1)), nrow = 10, ncol = 3, byrow = TRUE) - indicator.perm <- swapST_cc(indicator, perm.index) - ## Test cases ## - checkEquals(nrow(indicator), nrow(indicator.perm)) - checkEquals(ncol(indicator), ncol(indicator.perm)) - checkTrue(!any(indicator == indicator.perm), "check7") -} - diff --git a/inst/unitTests/runit.mcmcpermute.poisson.R b/inst/unitTests/runit.mcmcpermute.poisson.R deleted file mode 100644 index a7f82b3..0000000 --- a/inst/unitTests/runit.mcmcpermute.poisson.R +++ /dev/null @@ -1,258 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Testing ## -"test.mcmcpermute.exceptions" <- function() -{ - mcmc.obj <- mcmc() - checkException(mcmcpermute(mcmc.obj), "check1") - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - ## Check K == 1 - model.obj <- model(K = 1) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmc.obj <- mcmc() - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - options(warn = 2) - checkException(mcmcpermute(mcmcout), "check2") - ## Check indicfix = TRUE - model.obj <- model(K = 2, indicfix = TRUE) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkException(mcmcpermute(mcmcout), "check3") - model.obj <- model(K = 2, indicfix = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkException(mcmcpermute(mcmcout, method = "sth"), "check3") - checkException(mcmcpermute(mcmcout, model.obj, method = "Stephens1997b"), "check4") - options(warn = 1) -} - -"test.mcmcpermute.kmeans" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmc.obj <- mcmc() - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - perm <- mcmcpermute(mcmcout) - checkTrue(class(perm) == "mcmcoutputpermhierpost", "check1") - checkTrue(perm@ranperm, "check2") - checkEquals(NROW(perm@par$lambda), perm@M) - checkEquals(NCOL(perm@par$lambda), perm@model@K) - checkEquals(NROW(perm@log$mixlik), perm@M) - checkEquals(NCOL(perm@log$mixlik), 1) - checkEquals(NROW(perm@log$mixprior), perm@M) - checkEquals(NCOL(perm@log$mixprior), 1) - checkEquals(NROW(perm@weight), perm@M) - checkEquals(NCOL(perm@weight), perm@model@K) - checkEquals(NROW(perm@S), fdata.obj@N) - checkEquals(NCOL(perm@S), mcmc.obj@storeS) - checkEquals(NROW(perm@NK), perm@M) - checkEquals(NCOL(perm@NK), perm@model@K) - checkEquals(NROW(perm@clust), fdata.obj@N) - checkEquals(NCOL(perm@clust), 1) - checkEquals(NROW(perm@ST), perm@M) - checkEquals(NCOL(perm@ST), 1) - checkEquals(NROW(perm@post$par$a), perm@M) - checkEquals(NCOL(perm@post$par$a), perm@model@K) - checkEquals(NROW(perm@post$par$b), perm@M) - checkEquals(NCOL(perm@post$par$b), perm@model@K) - checkEquals(NROW(perm@post$weight), perm@M) - checkEquals(NCOL(perm@post$weight), perm@model@K) - checkEquals(NROW(perm@hyper$b), perm@M) - checkEquals(NCOL(perm@hyper$b), 1) - ## perm attributes - checkTrue(perm@Mperm <= perm@M, "check3") - checkEquals(NROW(perm@parperm$lambda), perm@Mperm) - checkEquals(NCOL(perm@parperm$lambda), perm@model@K) - checkEquals(NROW(perm@logperm$mixlik), perm@Mperm) - checkEquals(NCOL(perm@logperm$mixlik), 1) - checkEquals(NROW(perm@logperm$mixprior), perm@Mperm) - checkEquals(NCOL(perm@logperm$mixprior), 1) - checkEquals(NROW(perm@weightperm), perm@Mperm) - checkEquals(NCOL(perm@weightperm), perm@model@K) - checkEquals(NROW(perm@Sperm), fdata.obj@N) - checkEquals(NCOL(perm@Sperm), mcmc.obj@storeS) - checkEquals(NROW(perm@NKperm), perm@Mperm) - checkEquals(NCOL(perm@NKperm), perm@model@K) - checkEquals(NROW(perm@clust), fdata.obj@N) - checkEquals(NCOL(perm@clust), 1) - checkEquals(NROW(perm@STperm), perm@Mperm) - checkEquals(NCOL(perm@STperm), 1) - checkEquals(NROW(perm@postperm$par$a), perm@Mperm) - checkEquals(NCOL(perm@postperm$par$a), perm@model@K) - checkEquals(NROW(perm@postperm$par$b), perm@Mperm) - checkEquals(NCOL(perm@postperm$par$b), perm@model@K) - checkEquals(NROW(perm@postperm$weight), perm@Mperm) - checkEquals(NCOL(perm@postperm$weight), perm@model@K) -} - -"test.mcmcpermute.Stephens1997a" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmc.obj <- mcmc() - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - perm <- mcmcpermute(mcmcout, method = "Stephens1997a") - checkTrue(class(perm) == "mcmcoutputpermhierpost", "check1") - checkTrue(perm@ranperm, "check2") - checkEquals(NROW(perm@par$lambda), perm@M) - checkEquals(NCOL(perm@par$lambda), perm@model@K) - checkEquals(NROW(perm@log$mixlik), perm@M) - checkEquals(NCOL(perm@log$mixlik), 1) - checkEquals(NROW(perm@log$mixprior), perm@M) - checkEquals(NCOL(perm@log$mixprior), 1) - checkEquals(NROW(perm@weight), perm@M) - checkEquals(NCOL(perm@weight), perm@model@K) - checkEquals(NROW(perm@S), fdata.obj@N) - checkEquals(NCOL(perm@S), mcmc.obj@storeS) - checkEquals(NROW(perm@NK), perm@M) - checkEquals(NCOL(perm@NK), perm@model@K) - checkEquals(NROW(perm@clust), fdata.obj@N) - checkEquals(NCOL(perm@clust), 1) - checkEquals(NROW(perm@ST), perm@M) - checkEquals(NCOL(perm@ST), 1) - checkEquals(NROW(perm@post$par$a), perm@M) - checkEquals(NCOL(perm@post$par$a), perm@model@K) - checkEquals(NROW(perm@post$par$b), perm@M) - checkEquals(NCOL(perm@post$par$b), perm@model@K) - checkEquals(NROW(perm@post$weight), perm@M) - checkEquals(NCOL(perm@post$weight), perm@model@K) - checkEquals(NROW(perm@hyper$b), perm@M) - checkEquals(NCOL(perm@hyper$b), 1) - ## perm attributes - checkTrue(perm@Mperm <= perm@M, "check3") - checkEquals(NROW(perm@parperm$lambda), perm@Mperm) - checkEquals(NCOL(perm@parperm$lambda), perm@model@K) - checkEquals(NROW(perm@logperm$mixlik), perm@Mperm) - checkEquals(NCOL(perm@logperm$mixlik), 1) - checkEquals(NROW(perm@logperm$mixprior), perm@Mperm) - checkEquals(NCOL(perm@logperm$mixprior), 1) - checkEquals(NROW(perm@weightperm), perm@Mperm) - checkEquals(NCOL(perm@weightperm), perm@model@K) - checkEquals(NROW(perm@Sperm), fdata.obj@N) - checkEquals(NCOL(perm@Sperm), mcmc.obj@storeS) - checkEquals(NROW(perm@NKperm), perm@Mperm) - checkEquals(NCOL(perm@NKperm), perm@model@K) - checkEquals(NROW(perm@clust), fdata.obj@N) - checkEquals(NCOL(perm@clust), 1) - checkEquals(NROW(perm@STperm), perm@Mperm) - checkEquals(NCOL(perm@STperm), 1) - checkEquals(NROW(perm@postperm$par$a), perm@Mperm) - checkEquals(NCOL(perm@postperm$par$a), perm@model@K) - checkEquals(NROW(perm@postperm$par$b), perm@Mperm) - checkEquals(NCOL(perm@postperm$par$b), perm@model@K) - checkEquals(NROW(perm@postperm$weight), perm@Mperm) - checkEquals(NCOL(perm@postperm$weight), perm@model@K) -} - -"test.mcmcpermute.Stephens1997b" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- priordefine(fdata.obj, model.obj) - mcmc.obj <- mcmc() - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - perm <- mcmcpermute(mcmcout, fdata.obj, method = "Stephens1997b") - checkTrue(class(perm) == "mcmcoutputpermhierpost", "check1") - checkTrue(perm@ranperm, "check2") - checkEquals(NROW(perm@par$lambda), perm@M) - checkEquals(NCOL(perm@par$lambda), perm@model@K) - checkEquals(NROW(perm@log$mixlik), perm@M) - checkEquals(NCOL(perm@log$mixlik), 1) - checkEquals(NROW(perm@log$mixprior), perm@M) - checkEquals(NCOL(perm@log$mixprior), 1) - checkEquals(NROW(perm@weight), perm@M) - checkEquals(NCOL(perm@weight), perm@model@K) - checkEquals(NROW(perm@S), fdata.obj@N) - checkEquals(NCOL(perm@S), mcmc.obj@storeS) - checkEquals(NROW(perm@NK), perm@M) - checkEquals(NCOL(perm@NK), perm@model@K) - checkEquals(NROW(perm@clust), fdata.obj@N) - checkEquals(NCOL(perm@clust), 1) - checkEquals(NROW(perm@ST), perm@M) - checkEquals(NCOL(perm@ST), 1) - checkEquals(NROW(perm@post$par$a), perm@M) - checkEquals(NCOL(perm@post$par$a), perm@model@K) - checkEquals(NROW(perm@post$par$b), perm@M) - checkEquals(NCOL(perm@post$par$b), perm@model@K) - checkEquals(NROW(perm@post$weight), perm@M) - checkEquals(NCOL(perm@post$weight), perm@model@K) - checkEquals(NROW(perm@hyper$b), perm@M) - checkEquals(NCOL(perm@hyper$b), 1) - ## perm attributes - checkTrue(perm@Mperm <= perm@M, "check3") - checkEquals(NROW(perm@parperm$lambda), perm@Mperm) - checkEquals(NCOL(perm@parperm$lambda), perm@model@K) - checkEquals(NROW(perm@logperm$mixlik), perm@Mperm) - checkEquals(NCOL(perm@logperm$mixlik), 1) - checkEquals(NROW(perm@logperm$mixprior), perm@Mperm) - checkEquals(NCOL(perm@logperm$mixprior), 1) - checkEquals(NROW(perm@weightperm), perm@Mperm) - checkEquals(NCOL(perm@weightperm), perm@model@K) - checkEquals(NROW(perm@Sperm), fdata.obj@N) - checkEquals(NCOL(perm@Sperm), mcmc.obj@storeS) - checkEquals(NROW(perm@NKperm), perm@Mperm) - checkEquals(NCOL(perm@NKperm), perm@model@K) - checkEquals(NROW(perm@clust), fdata.obj@N) - checkEquals(NCOL(perm@clust), 1) - checkEquals(NROW(perm@STperm), perm@Mperm) - checkEquals(NCOL(perm@STperm), 1) - checkEquals(NROW(perm@postperm$par$a), perm@Mperm) - checkEquals(NCOL(perm@postperm$par$a), perm@model@K) - checkEquals(NROW(perm@postperm$par$b), perm@Mperm) - checkEquals(NCOL(perm@postperm$par$b), perm@model@K) - checkEquals(NROW(perm@postperm$weight), perm@Mperm) - checkEquals(NCOL(perm@postperm$weight), perm@model@K) -} diff --git a/inst/unitTests/runit.mcmcstart.R b/inst/unitTests/runit.mcmcstart.R deleted file mode 100644 index c58b3d2..0000000 --- a/inst/unitTests/runit.mcmcstart.R +++ /dev/null @@ -1,72 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Start testing ## -"test.mcmcstart.exceptions" <- function() -{ - checkException(mcmcstart(), "check1") - checkException(mcmcstart(fdata(), model()), "check2") - y <- .setUp.y() - fdata.obj <- fdata(y = y) - checkException(mcmcstart(fdata.obj), "check3") - checkException(mcmcstart(fdata.obj, model(), model()), "check4") -} - -"test.mcmcstart.poisson" <- function() -{ - ## Setup - y <- .setUp.y() - fdata.obj <- fdata(y = y) - model.obj <- model(dist = "poisson", K = 2) - (fdata.obj~model.obj~mcmc.obj) %=% mcmcstart(fdata.obj, model.obj) - checkTrue(class(mcmc.obj) == "mcmc", "check1") - checkTrue(hasS(fdata.obj), "check2") - checkTrue(!hasPar(model.obj), "check3") - ## Starting with indicators (@startpar = FALSE) - fdata.obj <- fdata(y = y) - mcmc.obj <- mcmc(startpar = FALSE) - (fdata.obj~model.obj~prior.obj) %=% mcmcstart(fdata.obj, model.obj, mcmc.obj) - checkTrue(hasPar(model.obj), "check4") - checkTrue(!hasS(fdata.obj), "check5") - ## Check model with fixed indicators (@indicfix = TRUE) - setIndicfix(model.obj) <- TRUE - fdata.obj <- fdata(y = y) - (fdata.obj~model.obj~mcmc.obj) %=% mcmcstart(fdata.obj, model.obj) - checkTrue(!hasS(fdata.obj), "check6") - options(warn = 2) - checkException(mcmcstart(fdata.obj, model.obj), "check7") - options(warn = 1) -} diff --git a/inst/unitTests/runit.mixturemcmc.R b/inst/unitTests/runit.mixturemcmc.R deleted file mode 100644 index 4ddd751..0000000 --- a/inst/unitTests/runit.mixturemcmc.R +++ /dev/null @@ -1,85 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Testing -"test.mixturemcmc.exception" <- function() -{ - ## Default - checkException(mixturemcmc(), "check1") - y <- .setUp.y() - fdata.obj <- fdata(y = y) - checkException(mixturemcmc(fdata.obj, fdata.obj, - fdata.obj, fdata.obj), "check2") - model.obj <- model(dist = "poisson", K = 2) - checkException(mixturemcmc(fdata.obj, model.obj, - model.obj, model.obj), "check3") - prior.obj <- priordefine(fdata.obj, model.obj) - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, prior.obj), "check4") - ## Check empty data slot. - fdata.obj <- fdata() - mcmc.obj <- mcmc() - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check5") - ## Check startpar = TRUE without starting indicators. - fdata.obj <- fdata(y = y) - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check6") - ## Check startpar = FALSE without starting parameters. - mcmc.obj@startpar <- FALSE - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check7") - ## Check fixed indicator model without indicators - model.obj@indicfix <- TRUE - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check8") - ## Check fixed indicator model without indicators but startpar set to TRUE - mcmc.obj@startpar <- TRUE - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check9") - ## Check without prior parameters - model.obj@indicfix <- FALSE - prior.obj <- prior() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check10") - ## Check wihtout prior weight - prior.obj <- priordefine(fdata.obj, model.obj) - prior.obj@weight <- matrix() - checkException(mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj), "check11") -} diff --git a/inst/unitTests/runit.mixturemcmc.poisson.R b/inst/unitTests/runit.mixturemcmc.poisson.R deleted file mode 100644 index b3b4636..0000000 --- a/inst/unitTests/runit.mixturemcmc.poisson.R +++ /dev/null @@ -1,911 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -".setUp.S" <- function() -{ - if (Sys.getenv("RCMDCHECK") == FALSE) { - ind.path <- file.path(getwd(), "..", - "data", - "poisson.ind.csv") - } else { - ind.path <- system.file(package = pkg, - 'data/poisson.ind.csv') - } - read.csv(ind.path, header = FALSE, sep = ",") -} - -## Testing -"test.mixturemcmc.poisson.fix" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2, indicfix = TRUE) - ## Set hier = FALSE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - ## Set storepost = FALSE - mcmc.obj <- mcmc(storepost = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfix", "check1") - checkTrue(!mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfixhier", "check3") - checkTrue(!mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and stroepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj@storepost <- TRUE - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfixpost", "check5") - checkTrue(!mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfixhierpost", "check7") - checkTrue(!mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) -} - -"test.mixturemcmc.poisson.ind" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = FALSE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputbase", "check1") - checkTrue(!mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhier", "check3") - checkTrue(!mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and storepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = TRUE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputpost", "check5") - checkTrue(!mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhierpost", "check7") - checkTrue(!mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) -} - -"test.mixturemcmc.poisson.ind.startpar" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = FALSE, ranperm = TRUE, - startpar = FALSE) - ## Generate starting parameters - (fdata.obj~model.obj~mcmc.obj) %=% mcmcstart(fdata.obj, - model.obj, - mcmc.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputbase", "check1") - checkTrue(mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhier", "check3") - checkTrue(mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and storepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = TRUE, ranperm = TRUE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputpost", "check5") - checkTrue(mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhierpost", "check7") - checkTrue(mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) -} - -"test.mixturemcmc.poisson.ind.startpar.ranperm" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = FALSE, ranperm = TRUE, - startpar = FALSE) - ## Generate starting parameters - (fdata.obj~model.obj~mcmc.obj) %=% mcmcstart(fdata.obj, - model.obj, - mcmc.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputbase", "check1") - print(mcmcout@ranperm) - checkTrue(mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhier", "check3") - checkTrue(mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and storepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = TRUE, ranperm = TRUE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputpost", "check5") - checkTrue(mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhierpost", "check7") - checkTrue(mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) -} - -## Test special case K = 1 -"test.mixturemcmc.poisson.one" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 1) - ## Set hier = FALSE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - ## Set storepost = FALSE - mcmc.obj <- mcmc(storepost = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfix", "check1") - checkTrue(!mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfixhier", "check3") - checkTrue(!mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and stroepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj@storepost <- TRUE - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfixpost", "check5") - checkTrue(!mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputfixhierpost", "check7") - checkTrue(!mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) -} - -"test.mixturemcmc.poisson.ind.byrow" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = t(y), S = t(S$V1)) - model.obj <- model(K = 2) - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = FALSE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputbase", "check1") - checkTrue(!mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhier", "check3") - checkTrue(!mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and storepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = TRUE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputpost", "check5") - checkTrue(!mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhierpost", "check7") - checkTrue(!mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) -} -"test.mixturemcmc.poisson.ind" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - fdata.obj <- fdata(y = y, S = S$V1) - model.obj <- model(K = 2) - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = FALSE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputbase", "check1") - checkTrue(!mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhier", "check3") - checkTrue(!mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and storepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = TRUE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputpost", "check5") - checkTrue(!mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhierpost", "check7") - checkTrue(!mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) -} - -"test.mixturemcmc.poisson.ind.expos" <- function() -{ - ## Setup - y <- .setUp.y() - S <- .setUp.S() - expos <- matrix(390, nrow = nrow(y), ncol = 1) - fdata.obj <- fdata(y = y, S = S$V1, exp = expos) - model.obj <- model(K = 2) - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = FALSE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputbase", "check1") - checkTrue(!mcmcout@ranperm, "check2") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - ## Set hier = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhier", "check3") - checkTrue(!mcmcout@ranperm, "check4") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) - ## Set hier = FALSE and storepost = TRUE - prior.obj <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.obj) - mcmc.obj <- mcmc(storepost = TRUE, ranperm = FALSE) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputpost", "check5") - checkTrue(!mcmcout@ranperm, "check6") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - ## Set hier = TRUE and storepost = TRUE - prior.obj <- priordefine(fdata.obj, model.obj) - mcmcout <- mixturemcmc(fdata.obj, model.obj, - prior.obj, mcmc.obj) - checkTrue(class(mcmcout) == "mcmcoutputhierpost", "check7") - checkTrue(!mcmcout@ranperm, "check8") - checkEquals(NROW(mcmcout@par$lambda), mcmcout@M) - checkEquals(NCOL(mcmcout@par$lambda), mcmcout@model@K) - checkEquals(NROW(mcmcout@log$mixlik), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixlik), 1) - checkEquals(NROW(mcmcout@log$mixprior), mcmcout@M) - checkEquals(NCOL(mcmcout@log$mixprior), 1) - checkEquals(NROW(mcmcout@weight), mcmcout@M) - checkEquals(NCOL(mcmcout@weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@S), fdata.obj@N) - checkEquals(NCOL(mcmcout@S), mcmc.obj@storeS) - checkEquals(NROW(mcmcout@NK), mcmcout@M) - checkEquals(NCOL(mcmcout@NK), mcmcout@model@K) - checkEquals(NROW(mcmcout@clust), fdata.obj@N) - checkEquals(NCOL(mcmcout@clust), 1) - checkEquals(NROW(mcmcout@ST), mcmcout@M) - checkEquals(NCOL(mcmcout@ST), 1) - checkEquals(NROW(mcmcout@post$par$a), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$a), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$par$b), mcmcout@M) - checkEquals(NCOL(mcmcout@post$par$b), mcmcout@model@K) - checkEquals(NROW(mcmcout@post$weight), mcmcout@M) - checkEquals(NCOL(mcmcout@post$weight), mcmcout@model@K) - checkEquals(NROW(mcmcout@hyper$b), mcmcout@M) - checkEquals(NCOL(mcmcout@hyper$b), 1) -} - - - diff --git a/inst/unitTests/runit.model.R b/inst/unitTests/runit.model.R deleted file mode 100644 index 5880783..0000000 --- a/inst/unitTests/runit.model.R +++ /dev/null @@ -1,198 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -## Testing ## -"test.model" <- function() -{ - ## Check default ## - model.obj <- model() - checkTrue(all(is.na(model.obj@T)), "check2") - checkTrue(!model.obj@indicfix, "check3") - checkEquals(model.obj@K, 1) - checkEquals(model.obj@r, 1) - checkEquals(model.obj@dist, "poisson") - checkEquals(model.obj@indicmod, "multinomial") -} - -"test.model.check.dist" <- function() -{ - ## Check Exception - checkException(model(dist = "Gamma"), "check1") - checkException(model(indicmod = "binomial"), "check2") -} - -"test.model.check.K" <- function() -{ - ## Check Exception ## - checkException(model(K = -1), "check1") - ## Check model with K = 1 - model.obj <- model(K = 1) - checkTrue(all(is.na(model.obj@weight)), "check2") - ## Check model with K = 2 - model.obj <- model(K = 2) - checkTrue(!all(is.na(model.obj@weight)), "check3") - ## Check model with K = 2 and weight - wgt <- matrix(1/3, nrow = 1, ncol = 3) - checkException(model(K = 2, weight = wgt), "check4") -} - -"test.model.check.r" <- function() -{ - ## Check exception - checkException(model(r = 2)) - checkException(model(dist = "binomial", r = 2), "check1") - checkException(model(dist = "normult", r = 1), "check2") -} - -"test.model.valid.T" <- function() -{ - ## Check exception - reps <- matrix("", nrow = 10, ncol = 1) - checkException(model(T = reps), "check1") - reps <- matrix(0, nrow = 10, ncol = 1) - checkException(model(T = reps), "check2") -} - -"test.model.valid.weight" <- function() -{ - ## Check exception - wgt <- matrix("", nrow = 1, ncol = 2) - checkException(model(K = 2, weight = wgt), "check1") - ## Check K = 1 - wgt <- matrix(1/2, nrow = 1, ncol = 2) - checkException(model(K = 1, weight = wgt), "check2") - storage.mode(wgt) <- "integer" - checkException(model(weight = wgt), "check3") -} - -"test.model.valid.par.poisson" <- function() -{ - ## Check exceptions - pars <- list(mu = c(1, 2)) - checkException(model(par = pars), "check1") - ## Check K = 2 - pars <- list(lambda = 1) - checkException(model(K = 2, par = pars), "check2") - ## Check with weight - pars <- list(lambda = c(4, 5)) - wgt <- matrix(1/3, nrow = 1, ncol = 3) - checkException(model(par = pars, weight = wgt), "check3") - ## Check non-numeric - pars <- list(lambda = "") - checkException(model(par = pars), "check4") - ## Check negative - pars <- list(lambda = c(-2, 1)) - checkException(model(K = 2, par = pars), "check5") -} - -## Setters -"test.model.setDist" <- function() -{ - ## Default - model.obj <- model() - checkException(setDist(model.obj) <- "Gamma", "check1") -} - -"test.model.setK" <- function() -{ - ## Default - model.obj <- model() - checkException(setK(model.obj) <- -1, "check1") -} - -"test.model.setWeight" <- function() -{ - ## Default - model.obj <- model() - wgt <- matrix(1/2, nrow = 1, ncol = 2) - setWeight(model.obj) <- wgt - checkTrue(hasWeight(model.obj), "check1") - ## NA - setWeight(model.obj) <- matrix() - checkTrue(all(is.na(model.obj@weight)), "check2") - ## Exception - wgt <- matrix("") - checkException(setWeight(model.obj) <- wgt, "check3") -} - -"test.model.setPar" <- function() -{ - ## Default ## - model.obj <- model() - pars <- list(mu = 1) - setPar(model.obj) <- pars - checkEquals(length(model.obj@par), 1) - checkTrue("mu" %in% names(model.obj@par), "check1") - checkEquals(model.obj@par$mu, 1) - ## Excpetions (turn warnings into errors) - model.obj <- model() - options(warn = 2) - checkException(setPar(model.obj) <- pars, "check2") - pars <- list(lambda = -1) - checkException(setPar(model.obj) <- pars, "check3") - setK(model.obj) <- 2 - pars <- list(lambda = c(2, 3)) - setPar(model.obj) <- pars - options(warn = 1) -} - -"test.model.setT" <- function() -{ - ## Default - model.obj <- model() - reps <- as.integer(c(4, 5, 1)) - setT(model.obj) <- reps - checkTrue(!all(is.na(model.obj@T)), "check1") - checkEquals(model.obj@T[1], 4) - ## Exception - reps <- matrix("") - checkException(setT(model.obj) <- reps, "check2") -} - -"test.model.hasweight" <- function() -{ - ## Default ## - model.obj <- model() - checkTrue(!hasWeight(model.obj), "check1") - checkException(hasWeight(model.obj, verbose = TRUE), "check2") - ## Check K = 2 - model.obj <- model(K = 2) - checkTrue(hasWeight(model.obj), "check3") -} - -"test.model.haspar" <- function() -{ - ## Default - model.obj <- model() - checkTrue(!hasPar(model.obj), "check1") - setK(model.obj) <- 2 - pars <- list(lambda = c(4, 5)) - setPar(model.obj) <- pars - checkTrue(hasPar(model.obj), "check2") - ## Exception - model.obj <- model() - checkException(hasPar(model.obj, verbose = TRUE), "check3") - pars <- list(mu = 1) - setPar(model.obj) <- pars - checkException(hasPar(model.obj, verbose = TRUE), "check4") -} - -"test.model.hasT" <- function() -{ - ## default - model.obj <- model() - checkTrue(!hasT(model.obj), "check1") - reps <- matrix(2, nrow = 1, ncol = 10) - storage.mode(reps) <- "integer" - setT(model.obj) <- reps - checkTrue(hasT(model.obj), "check2") -} - -## implemented later when normult model is implemented -## test.model.mixturemar ## diff --git a/inst/unitTests/runit.modelmoments.R b/inst/unitTests/runit.modelmoments.R deleted file mode 100644 index a3a8c3b..0000000 --- a/inst/unitTests/runit.modelmoments.R +++ /dev/null @@ -1,42 +0,0 @@ -### --- Test Setup --- ### - -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -## Start Testing ## - -"test.modelmoments.poisson" <- function() -{ - ## Default - model.obj <- model() - checkException(mom <- modelmoments(model.obj), "check1") - pars <- list(lambda = 112) - setPar(model.obj) <- pars - mom <- modelmoments(model.obj) - checkTrue("mean" %in% slotNames(mom), "check2") - checkTrue("var" %in% slotNames(mom), "check3") - checkTrue("factorial" %in% slotNames(mom), "check4") - checkTrue("over" %in% slotNames(mom), "check5") - checkTrue("zero" %in% slotNames(mom), "check6") - checkEquals(NROW(mom@mean), 1) - checkEquals(NCOL(mom@mean), 1) - checkEquals(nrow(mom@var), 1) - checkEquals(ncol(mom@var), 1) - checkEquals(dim(mom@factorial)[1], 4) - checkEquals(dim(mom@factorial)[2], 1) - checkEquals(NROW(mom@over), 1) - checkEquals(NCOL(mom@over), 1) - checkEquals(NROW(mom@zero), 1) - checkEquals(NCOL(mom@zero), 1) - ## Check K = 2 - setK(model.obj) <- 2 - setPar(model.obj) <- list(lambda = c(4, 5)) - mom <- modelmoments(model.obj) - setWeight(model.obj) <- matrix() - checkException(modelmoments(model.obj), "check2") -} - diff --git a/inst/unitTests/runit.prior.R b/inst/unitTests/runit.prior.R deleted file mode 100644 index 73654f9..0000000 --- a/inst/unitTests/runit.prior.R +++ /dev/null @@ -1,81 +0,0 @@ -if(TRUE) { - ## Not really needed, but can be handy - ## when writing tests - library("RUnit") - library("finmix") -} - -".setUp.y" <- function() -{ - ## Get path ## - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == FALSE) { - data.path <- file.path(getwd(), "..", - "data", "poisson.data.csv") - } else { - data.path <- system.file(package = pkg, - 'data/poisson.data.csv') - } - read.csv(data.path, header = FALSE, sep = ",") -} - -## Testing -"test.prior.default" <- function() -{ - prior.obj <- prior() - checkTrue(class(prior.obj) == "prior", "check1") - checkTrue("weight" %in% slotNames(prior.obj), "check2") - checkTrue("par" %in% slotNames(prior.obj), "check3") - checkTrue("type" %in% slotNames(prior.obj), "check4") - checkTrue("hier" %in% slotNames(prior.obj), "check5") - checkTrue(all(is.na(prior.obj@weight)), "check6") - checkEquals(length(prior.obj@par), 0) - checkTrue(prior.obj@hier, "check7") - checkTrue(prior.obj@type == "independent", "check8") -} - -"test.prior.poisson" <- function() -{ - ## Setup - y <- .setUp.y() - fdata.obj <- fdata(y = y) - model.obj <- model(dist = "poisson", K = 2) - prior.obj <- priordefine(fdata.obj, model.obj) - checkTrue("weight" %in% slotNames(prior.obj), "check1") - checkTrue("type" %in% slotNames(prior.obj), "check2") - checkTrue("par" %in% slotNames(prior.obj), "check3") - checkTrue("hier" %in% slotNames(prior.obj), "check4") - checkEquals(dim(prior.obj@weight), c(1, 2)) - checkEquals(length(prior.obj@par), 4) - checkTrue(prior.obj@hier, "check5") - checkTrue(prior.obj@type == "condconjugate", "check6") - checkTrue(is.list(prior.obj@par), "check7") - checkTrue("a" %in% names(prior.obj@par), "check8") - checkTrue("b" %in% names(prior.obj@par), "check9") - checkTrue("g" %in% names(prior.obj@par), "check10") - checkTrue("G" %in% names(prior.obj@par), "check11") - checkEquals(length(prior.obj@par$a), 2) - checkEquals(length(prior.obj@par$b), 2) - checkEquals(length(prior.obj@par$g), 1) - checkEquals(length(prior.obj@par$G), 1) - ## Check with no hier - prior.var <- prior(hier = FALSE) - prior.obj <- priordefine(fdata.obj, model.obj, - varargin = prior.var) - checkTrue(is.list(prior.obj@par), "check12") - checkTrue("a" %in% names(prior.obj@par), "check13") - checkTrue("b" %in% names(prior.obj@par), "check14") - checkTrue(!"g" %in% names(prior.obj@par), "check15") - checkTrue(!"G" %in% names(prior.obj@par), "check16") - checkEquals(length(prior.obj@par$a), 2) - checkEquals(length(prior.obj@par$b), 2) - ## Check exceptions - fdata.obj <- fdata() - checkException(priordefine(fdata.obj, model.obj), "check17") - fdata.obj <- fdata(y = y) - model.obj <- model(dist = "normult", K = 2) - checkException(priordefine(fdata.obj, model.obj), "check18") - model.obj <- model(dist = "poisson", K = 2) - checkException(priordefine(fdata.obj, model.obj, - varargin = model.obj), "check19") -} diff --git a/man/Summary-mcmcestfix-method.Rd b/man/Summary-mcmcestfix-method.Rd new file mode 100644 index 0000000..fa4b9d6 --- /dev/null +++ b/man/Summary-mcmcestfix-method.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{Summary,mcmcestfix-method} +\alias{Summary,mcmcestfix-method} +\title{Shows an advanced summary of an \code{mcmcestfix} object.} +\usage{ +\S4method{Summary}{mcmcestfix}(x, ..., na.rm = FALSE) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +A console output listing the formatted slots and summary +information about each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcestfix} object gives an advanced overview +of the \code{mcmcestfix} object. +} +\details{ +Note, this method is so far only implemented for mixtures of Poisson +distributions. +} diff --git a/man/Summary-mcmcestind-method.Rd b/man/Summary-mcmcestind-method.Rd new file mode 100644 index 0000000..f8c3008 --- /dev/null +++ b/man/Summary-mcmcestind-method.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestind.R +\name{Summary,mcmcestind-method} +\alias{Summary,mcmcestind-method} +\title{Shows an advanced summary of an \code{mcmcestind} object.} +\usage{ +\S4method{Summary}{mcmcestind}(x, ..., na.rm = FALSE) +} +\arguments{ +\item{object}{An \code{mcmcestind} object.} +} +\value{ +A console output listing the formatted slots and summary +information about each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcestind} object gives an advanced overview +of the \code{mcmcestind} object. +} +\details{ +Note, this method is so far only implemented for mixtures of Poisson +distributions. +} diff --git a/man/binomialmodelmoments-class.Rd b/man/binomialmodelmoments-class.Rd new file mode 100644 index 0000000..81ca8a3 --- /dev/null +++ b/man/binomialmodelmoments-class.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/binomialmodelmoments.R +\docType{class} +\name{binomialmodelmoments-class} +\alias{binomialmodelmoments-class} +\alias{.binomialmodelmoments} +\alias{show,binomialmodelmoments-method} +\title{Finmix \code{binomialmodelmoments} class} +\usage{ +\S4method{show}{binomialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{binomialmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Defines a class that holds modelmoments for a finite mixture of Binomial +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link{modelmoments}}. + +This is a class that directly inherits from the \code{dmodelmoments} class. + +Calling \code{\link[=show]{show()}} on an \code{binomialmodelmoments} object gives an overview +of the moments of an binomial finite mixture. +} +\section{Methods (by generic)}{ +\itemize{ +\item \code{show}: Shows a summary of an object +}} + +\seealso{ +\itemize{ +\item \link{modelmoments_class} for the base class for model moments +\item \code{\link{modelmoments}} for the constructor of \code{modelmoments} classes +\item \code{\link{dmodelmoments-class}} class for the parent class +} +} diff --git a/man/cdatamoments_class.Rd b/man/cdatamoments_class.Rd new file mode 100644 index 0000000..3dc9be8 --- /dev/null +++ b/man/cdatamoments_class.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\docType{class} +\name{cdatamoments_class} +\alias{cdatamoments_class} +\alias{.cdatamoments} +\title{Finmix \code{cdatamoments} class} +\description{ +Stores moments of an \link[=fdata_class]{fdata} object containing continuous data. +The \code{fdata} object is stored in the parent \link[=datamoments_class]{datamoments} +class. +} +\section{Slots}{ + +\describe{ +\item{\code{higher}}{An array containing the four higher centralized moments of the +continuous data stored in the \code{fdata} object.} + +\item{\code{skewness}}{A vector storing the skewness of the continuous data in the +corresponding \code{fdata} object.} + +\item{\code{kurtosis}}{A vector storing the kurtosis of the continuous data in the +corresponding \code{fdata} object.} + +\item{\code{corr}}{A matrix containing the correlations between the data dimensions +in case of multivariate data (i.e. slot \code{r} in the \code{fdata} object is +larger than one).} + +\item{\code{smoments}}{A \code{csdatamoments} object, if the \code{fdata} object also holds +indicators. \code{NULL}, if no indicators are present in the \code{fdata} object.} +}} + +\seealso{ +\itemize{ +\item \link[=datamoments_class]{datamoments} for the parent class +\item \link[=ddatamoments_class]{ddatamoments} for the corresponding class for +discrete data +\item \link[=csdatamoments_class]{csdatamoments} for the contained class if indicators +are present in the \code{fdata} object +} +} diff --git a/man/cmodelmoments.Rd b/man/cmodelmoments.Rd new file mode 100644 index 0000000..a1647fb --- /dev/null +++ b/man/cmodelmoments.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmodelmoments.R +\docType{class} +\name{cmodelmoments} +\alias{cmodelmoments} +\alias{.cmodelmoments} +\title{Finmix \code{cmodelmoments} class} +\description{ +This class defines the general theoretical moments of a finite mixture model +with continuous data. +} +\section{Slots}{ + +\describe{ +\item{\code{higher}}{An array containing the four higher centralized moments of the +(in case of multivariate data marginal) finite mixture.} + +\item{\code{skewness}}{A vector containing the skewness(es) of the finite mixture +model.} + +\item{\code{kurtosis}}{A vector containing the kurtosis(es) of the finite mixture +model.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of any \code{modelmoments} inherited class +} +} diff --git a/man/csdatamoments_class.Rd b/man/csdatamoments_class.Rd new file mode 100644 index 0000000..75aff5f --- /dev/null +++ b/man/csdatamoments_class.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\docType{class} +\name{csdatamoments_class} +\alias{csdatamoments_class} +\alias{.csdatamoments} +\title{Finmix \code{csdatamoments} class} +\description{ +Stores moments for indicators of continuous data. Inherited directly from +the \link[=sdatamoments_class]{sdatamoments} class. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A vector storing the between-group heterogeneity.} + +\item{\code{W}}{A vector storing the within-group heterogeneity.} + +\item{\code{T}}{A vector storing the total variance.} + +\item{\code{R}}{A numeric storing the coefficient of determination for univariate +data.} + +\item{\code{Rdet}}{A numeric storing the coefficient of determination using the +trace for multivariate data.} + +\item{\code{Rtr}}{A numeric storing the coefficient of determination using the +determinants for multivariate data.} +}} + +\seealso{ +\itemize{ +\item \link[=datamoments_class]{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +\item \link[=csdatamoments_class]{sdatamoments} for the corresponding class defining +moments for data from a discrete-valued finite mixture +} +} diff --git a/man/dataclass.Rd b/man/dataclass.Rd new file mode 100644 index 0000000..497050a --- /dev/null +++ b/man/dataclass.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{dataclass} +\alias{dataclass} +\title{Finmix \code{dataclass} constructor} +\usage{ +dataclass(fdata = NULL, model = NULL, simS = FALSE) +} +\arguments{ +\item{fdata}{An \code{fdata} object containing observations in slot \verb{@y} and +indicators in slot \verb{@S}.} + +\item{model}{A \code{model} object containing parameters in slot \verb{@par} and +and weights in slot \verb{@weight}.} + +\item{simS}{A logical defining, if the indicators \code{S} should be simulated.} +} +\value{ +A \code{dataclass} object containing the classification matrix, +model log-likelihood, entropy and indicators, if the latter have been +simulated. +} +\description{ +Calling \code{\link[=dataclass]{dataclass()}} classifies data using a fully specified mixture model. +Henceforth, the finite mixture model \code{model} must be fully specified, i.e. +containing parameters in slot \verb{@par}, weights in slot \verb{@weight} and +indicators in slot \verb{@S} of the corresponding \code{fdata} object. +} +\seealso{ +\itemize{ +\item \link[=dataclass_class]{dataclass} for the class definition +} + +#' @references +Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" +} diff --git a/man/dataclass_class.Rd b/man/dataclass_class.Rd new file mode 100644 index 0000000..789520c --- /dev/null +++ b/man/dataclass_class.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\docType{class} +\name{dataclass_class} +\alias{dataclass_class} +\alias{.dataclass} +\title{Finmix \code{dataclass} class} +\description{ +Stores objects to classify observations using a fully specified mixture +model. If the indicators a finite mixture model is fully specified as then +the likelihood can be calculated for each observation depending on the +component it stems from. +} +\section{Slots}{ + +\describe{ +\item{\code{logpy}}{An array containing the logarithmized} + +\item{\code{prob}}{An array storing the probability classification matrix that +defines for each observation the probability of belonging to component +\code{k}. Henceforth, each row sums to one. The dimension of this array is +\verb{N x K}.} + +\item{\code{mixlik}}{A numeric storing the logarithm of the mixture likelihood +evaluated at certain parameters \code{par} from a finmix \code{model} object and +corresponding \code{weights}.} + +\item{\code{entropy}}{A numeric storing the entropy of the classification.} + +\item{\code{loglikcd}}{An array storing the logarithm of the conditional likelihood +of each component parameter, if indicators have not been simulated. The +array has dimension \verb{1 x K}.} + +\item{\code{postS}}{A numeric storing the posterior probability of the indicators +\code{S} in the data, if indicators have been simulated.} +}} + +\references{ +Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" +} +\seealso{ +\itemize{ +\item \link[=fdata_class]{fdata} for the class holding the data +\item \link[=model_class]{model} for the class defining a finite mixture model +\item \code{\link[=dataclass]{dataclass()}} for the constructor of this class +} +} diff --git a/man/datamoments.Rd b/man/datamoments.Rd new file mode 100644 index 0000000..1eedc77 --- /dev/null +++ b/man/datamoments.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/datamoments.R +\name{datamoments} +\alias{datamoments} +\title{Constructor for \code{datamoments} classes} +\usage{ +datamoments(value = fdata()) +} +\arguments{ +\item{value}{An \code{fdata} object with at least slot \code{y} non-empty.} +} +\value{ +An \code{datamoments} object containing the data moments for slot \code{y} +and if available slot \code{S}. +} +\description{ +Calling \code{\link[=datamoments]{datamoments()}} generates the datamoments for an \code{fdata} object. +Depending on the type of data either an \code{cdatamoments} or \code{ddatamoments} +object is generated. If in addition the \code{fdata} object containes fixed +indicators, these \code{datamoments} object also hold an \code{sdatamoments} class to +store the data moments of these indicators. +} +\examples{ +# Create an fdata class with Poisson data. +f_data <- fdata(rpois(100, 312), sim=TRUE) +# Compute the data moments. +datamoments(f_data) + +} +\seealso{ +\itemize{ +\item \link{datamoments} class for all slots of this class +\item \link{cdatamoments} for the class for continuous data +\item \link{ddatamoments} for the class for discrete data +} +} diff --git a/man/datamoments_class.Rd b/man/datamoments_class.Rd new file mode 100644 index 0000000..26b22fb --- /dev/null +++ b/man/datamoments_class.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R, R/csdatamoments.R, +% R/datamoments.R +\docType{class} +\name{getB,normultmodelmoments-method} +\alias{getB,normultmodelmoments-method} +\alias{getB,csdatamoments-method} +\alias{datamoments_class} +\alias{.datamoments} +\title{Getter method of \code{normultmodelmoments} class.} +\usage{ +\S4method{getB}{normultmodelmoments}(object) + +\S4method{getB}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. + +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. + +Returns the \code{B} slot. + +Stores moments of a corresponding \code{fdata} object. +} +\section{Functions}{ +\itemize{ +\item \code{getB,normultmodelmoments-method}: Getter method for slot \code{B} + +\item \code{getB,csdatamoments-method}: +}} + +\section{Slots}{ + +\describe{ +\item{\code{mean}}{A numeric storing the mean of the slot \code{y} in the \code{fdata} object.} + +\item{\code{var}}{A matrix storing the variance(s and covariances) of the \code{y} slot +in the \code{fdata} object.} + +\item{\code{VIRTUAL}}{Virtual class containing further data moments.} +}} + +\examples{ +f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getB(f_moments) + +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getB(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} + +\itemize{ +\item \link[=datamoments_class]{datamoments} for the base class for model moments +\item \link[=datamoments]{datamoments()} for the constructor of the \code{datamoments} +class family +\item \link[=sdatamoments_class]{csdatamoments} for the class definition +\item \link[=sdatamoments]{sdatamoments()} for the constructor of the class +} + +\itemize{ +\item \link{cdatamoments} for data moments of continuous data +\item \link{ddatamoments} for data moments of discrete data +\item \link{sdatamoments} for data moments of the indicators +} +} diff --git a/man/ddatamoments_class.Rd b/man/ddatamoments_class.Rd new file mode 100644 index 0000000..14e8bf2 --- /dev/null +++ b/man/ddatamoments_class.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\docType{class} +\name{ddatamoments_class} +\alias{ddatamoments_class} +\alias{.ddatamoments} +\title{Finmix \code{ddatamoments} class} +\description{ +Stores moments of an \link[=fdata_class]{fdata} object containing discrete data. +The \code{fdata} object is stored in the parent \link[=datamoments_class]{datamoments} +class. +} +\section{Slots}{ + +\describe{ +\item{\code{factorial}}{An array containing the first four factorial moments of the +discrete data stored in the \code{fdata} object.} + +\item{\code{over}}{A vector storing the overdispersion of the discrete data in the +corresponding \code{fdata} object.} + +\item{\code{zero}}{A vector storing the fractions of zeros in the observed data. <} + +\item{\code{smoments}}{An \code{sdatamoments} object, if the \code{fdata} object also holds +indicators. \code{NULL}, if no indicators are present in the \code{fdata} object.} +}} + +\seealso{ +\itemize{ +\item \link[=datamoments_class]{datamoments} for the parent class +\item \link[=ddatamoments_class]{ddatamoments} for the corresponding class for +continuous data +\item \link[=sdatamoments_class]{sdatamoments} for the contained class if indicators +are present in the \code{fdata} object +} +} diff --git a/man/ddirichlet_cc.Rd b/man/ddirichlet_cc.Rd new file mode 100644 index 0000000..690aa22 --- /dev/null +++ b/man/ddirichlet_cc.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{ddirichlet_cc} +\alias{ddirichlet_cc} +\title{Computes the density of the Dirichlet distribution} +\usage{ +ddirichlet_cc(values, par) +} +\arguments{ +\item{values}{A matrix of dimension \verb{M x K} for which the log-density +should be calculated.} + +\item{par}{A vector of dimension \verb{K x 1} containing the Dirichlet +parameters.} +} +\value{ +A vector of Dirichlet density values. +} +\description{ +For each shape and rate parameter pair the Dirichlet density is +computed. Inside the function the unsafe access functions of Armadillo +\code{at()} and \code{unsafe_col()} are used, so now boundary check is performed. +In each step the \code{lgammafn()} function from Rcpp's \code{R} namespace is used. +At this time unused. +} diff --git a/man/dgamma_cc.Rd b/man/dgamma_cc.Rd new file mode 100644 index 0000000..e358bb6 --- /dev/null +++ b/man/dgamma_cc.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{dgamma_cc} +\alias{dgamma_cc} +\title{Computes the density of the Gamma distribution} +\usage{ +dgamma_cc(values, shape, rate) +} +\arguments{ +\item{values}{A matrix of dimension \verb{M x K} for which the density +should be calculated.} + +\item{shape}{A vector of dimension \verb{K x 1} with Gamma shape parameters.} + +\item{rate}{A vector of dimension \verb{K x 1} with Gamma rate parameters.} +} +\value{ +A matrix of Gamma density values for each pair of parameters +in a column. +} +\description{ +For each shape and rate parameter pair the gamma density is computed. +Inside the function the unsafe access functions of Armadillo \code{at()} and +\code{unsafe_col()} are used, so now boundary check is performed. In each step +the \code{lngamma()} function from Rcpp's \code{R} namespace is used. At this time +unused. +} diff --git a/man/dmodelmoments.Rd b/man/dmodelmoments.Rd new file mode 100644 index 0000000..2aad5a1 --- /dev/null +++ b/man/dmodelmoments.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dmodelmoments.R +\docType{class} +\name{dmodelmoments} +\alias{dmodelmoments} +\alias{.dmodelmoments} +\title{Finmix \code{dmodelmoments} class} +\description{ +This class defines the general theoretical moments of a finite mixture model +with discrete data. +} +\section{Slots}{ + +\describe{ +\item{\code{over}}{A numeric containing the over-dispersion.} + +\item{\code{factorial}}{An array containing the first four factorial moments.} + +\item{\code{zero}}{An numeric cotaining the excess zeros.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of any \code{modelmoments} inherited class +} +} diff --git a/man/dot-generateMomentsNormal.Rd b/man/dot-generateMomentsNormal.Rd new file mode 100644 index 0000000..c3a59f9 --- /dev/null +++ b/man/dot-generateMomentsNormal.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{.generateMomentsNormal} +\alias{.generateMomentsNormal} +\title{Generate model moments for an normal mixture} +\usage{ +.generateMomentsNormal(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object to contain all calculated +moments.} +} +\value{ +An \code{normalmodelmoments} object containing all moments of the +normal mixture distributions. +} +\description{ +Only called implicitly. generates all moments of an normal mixture +distribution. +} +\keyword{internal} diff --git a/man/dstud.Rd b/man/dstud.Rd new file mode 100644 index 0000000..e52d548 --- /dev/null +++ b/man/dstud.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/distributions.R +\name{dstud} +\alias{dstud} +\title{Density function of a Student-t distribution} +\usage{ +dstud(x, mu, sigma, df) +} +\arguments{ +\item{x}{A vector of valued for which the density should be calculated.} + +\item{mu}{A vector containing the mean of the distribution.} + +\item{sigma}{A vector containing the standard deviation of the distribution.} + +\item{df}{A vector containing the degrees of freedom of the distribution.} +} +\value{ +The density of the Student-t distribution for the values of \code{x}. +} +\description{ +Unused at this moment. +} +\keyword{internal} diff --git a/man/exponentialmodelmoments.Rd b/man/exponentialmodelmoments.Rd new file mode 100644 index 0000000..2ed4cde --- /dev/null +++ b/man/exponentialmodelmoments.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\docType{class} +\name{exponentialmodelmoments} +\alias{exponentialmodelmoments} +\alias{.exponentialmodelmoments} +\title{Finmix \code{exponentialmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of exponential +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments_class} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/extract-mcmcoutputfix-numeric-method.Rd b/man/extract-mcmcoutputfix-numeric-method.Rd new file mode 100644 index 0000000..a5dc40a --- /dev/null +++ b/man/extract-mcmcoutputfix-numeric-method.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{extract,mcmcoutputfix,numeric-method} +\alias{extract,mcmcoutputfix,numeric-method} +\title{Extracts samples from \code{mcmcoutput} object of a multivariate Normal mixture} +\usage{ +\S4method{extract}{mcmcoutputfix,numeric}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object from MCMC sampling of a multivariate +Normal mixture model.} + +\item{index}{An numeric indicating which dimension of the multivariate +mixture should be extracted.} +} +\value{ +An object class \code{mcmcextract} containing all samples of an extracted +dimension. +} +\description{ +Extracts samples from \code{mcmcoutput} object of a multivariate Normal mixture +} diff --git a/man/fdata.Rd b/man/fdata.Rd index da44ed9..30fbb25 100644 --- a/man/fdata.Rd +++ b/man/fdata.Rd @@ -1,228 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R \name{fdata} -\docType{class} - -\alias{class:fdata} -\alias{fdata} - -%accessor -\alias{getY, fdata-method} -\alias{setY<-, fdata-method} -\alias{getColY, fdata-method} -\alias{getRowY, fdata-method} -\alias{getN, fdata-method} -\alias{setN<-, fdata-method} -\alias{getR, fdata-method} -\alias{setR<-, fdata-method} -\alias{getS, fdata-method} -\alias{setS<-, fdata-method} -\alias{getColS, fdata-method} -\alias{getRowS, fdata-method} -\alias{getBycolumn, fdata-method} -\alias{setBycolumn<-, fdata-method} -\alias{getName, fdata-method} -\alias{setName<-, fdata-method} -\alias{getType, fdata-method} -\alias{setType<-, fdata-method} -\alias{getSim, fdata-method} -\alias{setSim<-, fdata-method} -\alias{getExp, fdata-method} -\alias{setExp<-, fdata-method} -\alias{getColExp, fdata-method} -\alias{getRowExp, fdata-method} -\alias{getY, fdata-method} -\alias{setY<-, fdata-method} -\alias{getT, fdata-method} -\alias{setT<-, fdata-method} -\alias{getColT, fdata-method} -\alias{getRowT, fdata-method} - -% constructor \alias{fdata} +\title{Constructs an \code{fdata} object} +\usage{ +fdata( + y = matrix(), + N = 1, + r = 1, + S = matrix(), + bycolumn = TRUE, + name = character(), + type = "discrete", + sim = FALSE, + exp = matrix(), + T = matrix() +) +} +\arguments{ +\item{y}{A matrix containing the observations for finite mixture estimation. +Can be by column or row depending on the slot \code{bycolumn}.} -% checking -\alias{hasY, fdata-method} -\alias{hasS, fdata-method} -\alias{hasExp, fdata-method} -\alias{hasT, fdata-method} +\item{N}{An integer holding the number of observations.} -% show -\alias{show, fdata-method} +\item{r}{An integer defining the dimension of the data. Only for multivariate +distributions like \code{normult} or \code{studmult} the dimension is +larger one.} -% plot -\alias{plot, fdata-method} +\item{S}{A matrix containing the indicators of the data. If the \code{fdata} class +contains indicators estimation is performed with a fixed indicator +approach.} -\title{Finmix Data} -\description{ - The \code{fdata} class stores the data for finite mixture distributions. -} +\item{bycolumn}{A logical indicating if the data in \code{y} and \code{S} is sorted by +by column (\code{TRUE}) or row (\code{FALSE}).} -\details{ - The \code{fdata} class is constructed by calling its constructor - \code{fdata()}. All arguments in the constructor are optional. -} +\item{name}{A character specifying a name for the data. Optional.} -\section{Constructor}{ - \describe{\code{fdata(y = matrix(), N = 1, r = 1, S = matrix(), - bycolumn = TRUE, name = character(), type = "discrete", - sim = FALSE, exp = matrix(), T = matrix())}: +\item{type}{A character specifying the data type: either \code{discrete} for +discrete data or \code{continuous} for continuous data. The two data types are +treated differently when calculating data moments.} - Constructs an \code{fdata} object from the input arguments. All - arguments are optional. If provided, arguments \code{y}, \code{S}, - \code{exp} and \code{T} must be of type \code{matrix}. +\item{sim}{A logical indicating, if the data was simulated.} - To construct an empty \code{fdata} object the constructor can be - without any argument provided: \code{fdata()}. - } -} +\item{exp}{A matrix containing the \emph{exposures} of Poisson data.} -\section{Accessors}{ -In the following code snippets, \code{x} is an \code{fdata} object and the symbol -\code{@} represents a slot of this \code{S4} object. - \describe{ - \item{}{\code{getY(x)}, \code{setY(x)<-}: - Get and set the \code{matrix} containing the observations - \code{@y} in \code{x}. In case the setter is called the number - of observations \code{@N} and the variable dimension \code{r} - are set automatically. - } - \item{}{\code{getColY(x)}, \code{getRowY(x)}: - Get the \code{matrix} of observations in \code{@y} of \code{x} either - sorted by row or by column. - } - \item{}{\code{getS(x)}, \code{setS(x)<-}: - Get and set the indicator \code{matrix} in \code{@S} of \code{x}. - Indicators are stored as \code{integer} and must be of dimension - \code{@N x 1} in case of \code{@bycolumn = TRUE} or of dimension - \code{1 x @N} in case of \code{@bycolumn = FALSE}. Certain safe - guards check for consistency with the remaining slots of \code{x}. - } - \item{}{\code{getColS(x)}, \code{getRowS(x)}: - Get the \code{matrix} of indicators in \code{@S} of \code{x} either - sorted by row or by column. - } - \item{}{\code{getN(x)}, \code{setN(x)<-}: - Get and set the number of observations in \code{@N} of the - \code{matrix} of observations in \code{@y}. The number of - observations is stored as an \code{integer} and certain safe guards - check for consistency with the remaining slots of \code{x}. - } - \item{}{\code{getR(x)}, \code{setR(x)<-}: - Get and set the dimension of variables in \code{@r} of - the \code{matrix} of observations in \code{@y} of \code{x}. - The dimension of variables is stored as an \code{integer} and certain - safe guards check for consistency with the remaining slots of - \code{x}. For univariate distributions \code{@r} must be \code{1} - and for multivariate distributions \code{@r} must be \code{>1}. - } - \item{}{\code{getBycolumn(x)}, \code{setBycolumn(x)<-}: - Get and set the ordering \code{@bycolumn} of observations in the - \code{matrix} of \code{@y} in \code{x}. The ordering is stored - as a \code{logical} and must be either \code{TRUE} or \code{FALSE}. - If \code{@bycolumn} is set to \code{TRUE} observations in the - \code{matrix} of \code{@y} are ordered in columns, otherwise - observations are ordered in rows. Certain safe guards check for - consistency with the remaining slots. - } - \item{}{\code{getType(x)}, \code{setType(x)<-}: - Get and set the data type \code{@type} of the observations in the - \code{matrix} of \code{@y}. The data type is stored as \code{character} - and it must be either \code{discrete} or \code{continuous}. The - data type determines the behavior of certain function calls. - } - \item{}{\code{getSim(x)}, \code{setSim(x)<-}: - Get and set the simulation indicator in \code{@sim}. This slot - indicates if the observations in the \code{matrix} of \code{@y} - were simulated. The simulation indicator is stored as \code{logical} - and must be either \code{TRUE} or \code{FALSE}. - } - \item{}{\code{getName(x)}, \code{setName(x)<-}: - Get and set the name of the data in \code{@name} of \code{x}. The - name is optional and set as \code{character()} if no name is - provided by the user. - } - \item{}{\code{getExp(x)}, \code{setExp(x)<-}: - Get and set the \code{matrix} of data exposures \code{@exp} in \code{x}. - This is optional and becomes only relevant in case a \code{poisson} - mixture is fitted to the data. Certain safe guards check for - consistency with the remaining slots of \code{x}. In case \code{@y}, - \code{@S} and \code{@T} are empty, the number of observations \code{@N} - and the dimension of variables \code{@r} are set automatically. - } - \item{}{\code{getColExp(x)}, \code{getRowExp(x)}: - Get the \code{matrix} of exposures in \code{@exp} of \code{x} either - sorted by row or by column. - } - \item{}{\code{getT(x)}, \code{setT(x)<-}: - Get and set the repetitions \code{matrix} in \code{@T} of \code{x}. - Repetitions are optional and become only relevant in case a - \code{binomial} mixture is fitted to the data. Repetitions are stored as - \code{integer} in \code{x}. Certain safe guards check - for consistency with the remaining slots of \code{x}. In case \code{@y}, - \code{@S} and \code{@exp} are emoty, the number of observations \code{@N} - and the dimension of variables \code{@r} are set automatically. - } - \item{}{\code{getColT(x)}, \code{getRowT(x)}: - Get the \code{matrix} of repetitions in \code{@T} of \code{x} either - sorted by row or by column. - } - } +\item{T}{A matrix containing the (optional) repetitions of binomial or Poisson +data. Must be of type integer.} } - -\section{Checking}{ - In the following code snippets, \code{x} is an \code{fdata} object and the symbol - \code{@} represents a slot of this \code{S4} object. - \describe{ - \item{}{\code{hasY(x, verbose = FALSE)}: - Checks wether \code{@y} of \code{x} is empty. Returns \code{TRUE}, if - \code{@y} contains \code{matrix} with not all entries \code{NA}, - otherwise it returns \code{FALSE}. If \code{verbose} is set to - \code{TRUE} an error is thrown in case of \code{@y} being empty. - } - \item{}{\code{hasS(x, verbose = FALSE)}: - Checks wether \code{@S} of \code{x} is empty. Returns \code{TRUE}, if - \code{@S} contains \code{matrix} with not all entries \code{NA}, - otherwise it returns \code{FALSE}. If \code{verbose} is set to - \code{TRUE} an error is thrown in case of \code{@S} being empty. - } - \item{}{\code{hasExp(x, verbose = FALSE)}: - Checks wether \code{@exp} of \code{x} is empty. Returns \code{TRUE}, if - \code{@exp} contains \code{matrix} with not all entries \code{NA}, - otherwise it returns \code{FALSE}. If \code{verbose} is set to - \code{TRUE} an error is thrown in case of \code{@exp} being empty. - } - \item{}{\code{hasT(x, verbose = FALSE)}: - Checks wether \code{@T} of \code{x} is empty. Returns \code{TRUE}, if - \code{@T} contains \code{matrix} with not all entries \code{NA}, - otherwise it returns \code{FALSE}. If \code{verbose} is set to - \code{TRUE} an error is thrown in case of \code{@T} being empty. - } - } +\description{ +Calling \code{\link[=fdata]{fdata()}} constructs an \code{fdata} object. Can be called without +arguments. } +\examples{ +# Call the constructor without arguments. +f_data <- fdata() -\section{Plotting}{ - \describe{\code{plot(x, dev = TRUE)}: - - Plots the observations in \code{@y} of \code{x}. In case the data - type \code{@type} of \code{x} is \code{discrete} a \code{\link{barplot}} - is used for visualizing. In case the data type is \code{continuous} a - histogram is plotted by using \code{\link{hist}}. If the dimension of - variables \code{@r} is equal to \code{2} a bivariate Kernel density is - plotted using \code{\link{bkde2D}} from package \code{\link{KernSmooth}} - for the Kernel density estimates, \code{\link{persp}} for a persepctive - plot of the denisty and \code{\link{contour}} for a corresponding - contour plot. In case the dimension of variables \code{@r} is \code{>2}, - histograms are plotted for all variables and \code{\link{pairs}} is used - for scatterplots of all pairs of data. +# Create simulated data. +f_data <- fdata(y = rpois(100, 312), sim = TRUE) - If argument \code{dev = FALSE} no graphical device is opened and the - user is able to store all plots to a file using \code{\link{pdf}}, - \code{\link{png}}, etc. - } } -\author{ Lars Simon Zehnder } -\examples{ - fdata.obj <- fdata(y = rpois(100, 312), sim = TRUE) - fdata.obj +\seealso{ +\link{fdata} class that describes the slots and the getters, setters and +and checkers } -\keyword{classes} -\keyword{methods} diff --git a/man/fdata_class.Rd b/man/fdata_class.Rd new file mode 100644 index 0000000..586684d --- /dev/null +++ b/man/fdata_class.Rd @@ -0,0 +1,586 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\docType{class} +\name{fdata_class} +\alias{fdata_class} +\alias{.fdata} +\alias{plot,fdata,missing-method} +\alias{show,fdata-method} +\alias{hasY,fdata-method} +\alias{hasExp,fdata-method} +\alias{hasT,fdata-method} +\alias{getColY,fdata-method} +\alias{getRowY,fdata-method} +\alias{getColS,fdata-method} +\alias{getRowS,fdata-method} +\alias{getColExp,fdata-method} +\alias{getRowExp,fdata-method} +\alias{getColT,fdata-method} +\alias{getRowT,fdata-method} +\alias{getY,fdata-method} +\alias{getN,fdata-method} +\alias{getR,fdata-method} +\alias{getS,fdata-method} +\alias{getBycolumn,fdata-method} +\alias{getName,fdata-method} +\alias{getType,fdata-method} +\alias{getSim,fdata-method} +\alias{getExp,fdata-method} +\alias{getT,fdata-method} +\alias{setY<-,fdata-method} +\alias{setN<-,fdata-method} +\alias{setR<-,fdata-method} +\alias{setS<-,fdata-method} +\alias{setBycolumn<-,fdata-method} +\alias{setName<-,fdata-method} +\alias{setType<-,fdata-method} +\alias{setSim<-,fdata-method} +\alias{setExp<-,fdata-method} +\alias{setT<-,fdata-method} +\title{Finmix fdata class} +\usage{ +\S4method{plot}{fdata,missing}(x, y, dev = TRUE, ...) + +\S4method{show}{fdata}(object) + +\S4method{hasY}{fdata}(object, verbose = FALSE) + +\S4method{hasExp}{fdata}(object, verbose = FALSE) + +\S4method{hasT}{fdata}(object, verbose = FALSE) + +\S4method{getColY}{fdata}(object) + +\S4method{getRowY}{fdata}(object) + +\S4method{getColS}{fdata}(object) + +\S4method{getRowS}{fdata}(object) + +\S4method{getColExp}{fdata}(object) + +\S4method{getRowExp}{fdata}(object) + +\S4method{getColT}{fdata}(object) + +\S4method{getRowT}{fdata}(object) + +\S4method{getY}{fdata}(object) + +\S4method{getN}{fdata}(object) + +\S4method{getR}{fdata}(object) + +\S4method{getS}{fdata}(object) + +\S4method{getBycolumn}{fdata}(object) + +\S4method{getName}{fdata}(object) + +\S4method{getType}{fdata}(object) + +\S4method{getSim}{fdata}(object) + +\S4method{getExp}{fdata}(object) + +\S4method{getT}{fdata}(object) + +\S4method{setY}{fdata}(object) <- value + +\S4method{setN}{fdata}(object) <- value + +\S4method{setR}{fdata}(object) <- value + +\S4method{setS}{fdata}(object) <- value + +\S4method{setBycolumn}{fdata}(object) <- value + +\S4method{setName}{fdata}(object) <- value + +\S4method{setType}{fdata}(object) <- value + +\S4method{setSim}{fdata}(object) <- value + +\S4method{setExp}{fdata}(object) <- value + +\S4method{setT}{fdata}(object) <- value +} +\arguments{ +\item{x}{An \code{fdata} object. Cannot be empty.} + +\item{y}{Unused.} + +\item{dev}{A logical indicating if the plot should be output via a graphical +device.} + +\item{...}{Further arguments passed to the plotting functions \code{hist} or +\code{barplot}.} + +\item{object}{An \code{fdata} objects, whose slot \code{T} should be set.} + +\item{verbose}{A logical indicating, if the function should print out +messages.} + +\item{value}{A matrix that should be set as \code{T} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +A console output listing the slots and summary information about +each of them. + +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{y} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. + +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{exp} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. + +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{T} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. + +The \code{y} slot of the \code{object} as a column-ordered matrix. + +The \code{y} slot of the \code{object} as a row-ordered matrix. + +The \code{S} slot of the \code{object} as a column-ordered matrix. + +The \code{S} slot of the \code{object} as a row-ordered matrix. + +The \code{exp} slot of the \code{object} as a column-ordered matrix. + +The \code{exp} slot of the \code{object} as a row-ordered matrix. + +The \code{T} slot of the \code{object} as a column-ordered matrix. + +The \code{T} slot of the \code{object} as a row-ordered matrix. + +The \code{y} slot of the \code{object} in the order defined \code{bycolumn}. + +The \code{N} slot of the \code{object}. + +The \code{r} slot of the \code{object}. + +The \code{S} slot of the \code{object} in the order defined \code{bycolumn}. + +The \code{bycolumn} slot of the \code{object}. + +The \code{name} slot of the \code{object}. + +The \code{type} slot of the \code{object}. + +The \code{sim} slot of the \code{object}. + +The \code{exp} slot of the \code{object} in the order defined \code{bycolumn}. + +The \code{T} slot of the \code{object} in the order defined \code{bycolumn}. + +The \code{fdata} object with slot \code{y} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{y}. + +The \code{fdata} object with slot \code{N} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{N}. + +The \code{fdata} object with slot \code{R} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{R}. + +The \code{fdata} object with slot \code{S} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{S}. + +The \code{fdata} object with slot \code{bycolumn} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{bycolumn}. + +The \code{fdata} object with slot \code{name} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{name}. + +The \code{fdata} object with slot \code{type} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{type}. + +The \code{fdata} object with slot \code{sim} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{sim}. + +The \code{fdata} object with slot \code{exp} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{exp}. + +The \code{fdata} object with slot \code{T} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{T}. +} +\description{ +The \link{fdata} class holds the data for finite mixture distributions. + +\code{\link[=plot]{plot()}} plots the data in an \link{fdata} object by either a histogram in case of +continuous data or a barplot in case of discrete data. + +Calling \code{\link[=show]{show()}} on an \code{fdata} object gives an overview of the different +slots and dimensions. + +\code{\link[=hasY]{hasY()}} checks, if the object contains \code{y} data. + +\code{\link[=hasY]{hasY()}} checks, if the object contains \code{exp} data. + +\code{\link[=hasY]{hasY()}} checks, if the object contains \code{T} data. + +Returns the \code{y} slot as a column-ordered matrix. + +Returns the \code{y} slot as a row-ordered matrix. + +Returns the \code{S} slot as a column-ordered matrix. + +Returns the \code{S} slot as a row-ordered matrix. + +Returns the \code{exp} slot as a column-ordered matrix. + +Returns the \code{exp} slot as a row-ordered matrix. + +Returns the \code{T} slot as a column-ordered matrix. + +Returns the \code{T} slot as a row-ordered matrix. + +Returns the \code{y} slot in the order defined by the slot \code{bycolumn}. + +Returns the \code{N} slot of an \code{fdata} object. + +Returns the \code{r} slot of an \code{fdata} object. + +Returns the \code{S} slot in the order defined by the slot \code{bycolumn}. + +Returns the \code{bycolumn} slot of an \code{fdata} object. + +Returns the \code{name} slot of an \code{fdata} object. + +Returns the \code{type} slot of an \code{fdata} object. + +Returns the \code{sim} slot of an \code{fdata} object. + +Returns the \code{exp} slot in the order defined by the slot \code{bycolumn}. + +Returns the \code{T} slot in the order defined by the slot \code{bycolumn}. + +Sets the slot \code{y} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{N} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{R} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{S} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{bycolumn} of an \code{fdata} object and validates the slot data +before setting. + +Sets the slot \code{name} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{type} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{sim} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{exp} of an \code{fdata} object and validates the slot data before +setting. + +Sets the slot \code{T} of an \code{fdata} object and validates the slot data before +setting. +} +\section{Functions}{ +\itemize{ +\item \code{plot,fdata,missing-method}: + +\item \code{show,fdata-method}: + +\item \code{hasY,fdata-method}: + +\item \code{hasExp,fdata-method}: + +\item \code{hasT,fdata-method}: + +\item \code{getColY,fdata-method}: + +\item \code{getRowY,fdata-method}: + +\item \code{getColS,fdata-method}: + +\item \code{getRowS,fdata-method}: + +\item \code{getColExp,fdata-method}: + +\item \code{getRowExp,fdata-method}: + +\item \code{getColT,fdata-method}: + +\item \code{getRowT,fdata-method}: + +\item \code{getY,fdata-method}: + +\item \code{getN,fdata-method}: + +\item \code{getR,fdata-method}: + +\item \code{getS,fdata-method}: + +\item \code{getBycolumn,fdata-method}: + +\item \code{getName,fdata-method}: + +\item \code{getType,fdata-method}: + +\item \code{getSim,fdata-method}: + +\item \code{getExp,fdata-method}: + +\item \code{getT,fdata-method}: + +\item \code{setY<-,fdata-method}: + +\item \code{setN<-,fdata-method}: + +\item \code{setR<-,fdata-method}: + +\item \code{setS<-,fdata-method}: + +\item \code{setBycolumn<-,fdata-method}: + +\item \code{setName<-,fdata-method}: + +\item \code{setType<-,fdata-method}: + +\item \code{setSim<-,fdata-method}: + +\item \code{setExp<-,fdata-method}: + +\item \code{setT<-,fdata-method}: +}} + +\section{Slots}{ + +\describe{ +\item{\code{y}}{A matrix containing the observations for finite mixture estimation. +Can be by column or row depending on the slot \code{bycolumn}.} + +\item{\code{N}}{An integer holding the number of observations.} + +\item{\code{r}}{An integer defining the dimension of the data. Only for multivariate +distributions like \code{normult} or \code{studmult} the dimension is +larger one.} + +\item{\code{S}}{A matrix containing the indicators of the data. If the \code{fdata} class +contains indicators estimation is performed with a fixed indicator +approach.} + +\item{\code{bycolumn}}{A logical indicating if the data in \code{y} and \code{S} is sorted by +by column (\code{TRUE}) or row (\code{FALSE}).} + +\item{\code{name}}{A character specifying a name for the data. Optional.} + +\item{\code{type}}{A character specifying the data type: either \code{discrete} for +discrete data or \code{continuous} for continuous data. The two data types are +treated differently when calculating data moments.} + +\item{\code{sim}}{A logical indicating, if the data was simulated.} + +\item{\code{exp}}{A matrix containing the \emph{exposures} of Poisson data.} + +\item{\code{T}}{A matrix containing the (optional) repetitions of binomial or Poisson +data. Must be of type integer.} +}} + +\examples{ +# Generate Poisson data and plot it. +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +plot(f_data) + +# Generate some Poisson data and show the `fdata` object +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +show(f_data) + +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasY(f_data) + +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasExp(f_data) + +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasT(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColY(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowY(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColS(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowS(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColExp(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowExp(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColT(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowT(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getY(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getN(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getR(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getS(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getBycolumn(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getName(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getType(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getSim(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getExp(f_data) + +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getT(f_data) + +f_data <- fdata() +setY(f_data) <- rpois(100, 312) + +f_data <- fdata() +setN(f_data) <- as.integer(100) + +f_data <- fdata() +setR(f_data) <- as.integer(2) + +# Generate an empty fdata object. +f_data <- fdata() +setS(f_data) <- matrix(sample.int(4, 100, replace = TRUE)) + +# Generate an empty fdata object. +f_data <- fdata() +setBycolumn(f_data) <- TRUE + +# Generate an empty fdata object. +f_data <- fdata() +setName(f_data) <- "poisson_data" + +# Generate an empty fdata object. +f_data <- fdata() +setType(f_data) <- "discrete" + +# Generate an empty fdata object. +f_data <- fdata() +setSim(f_data) <- TRUE + +# Generate an empty fdata object. +f_data <- fdata() +setExp(f_data) <- matrix(rep(100, 100)) + +# Generate an empty fdata object. +f_data <- fdata() +setT(f_data) <- matrix(rep(100, 100)) + +} +\seealso{ +\link{fdata} class + +\link{fdata} class for an overview of the slots + +\link{fdata} class for an overview of its slots + +\link{fdata} class for an overview of its slots + +\link{fdata} class for an overview of its slots + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class + +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/finmix-package.Rd b/man/finmix-package.Rd deleted file mode 100644 index 9adc36b..0000000 --- a/man/finmix-package.Rd +++ /dev/null @@ -1,44 +0,0 @@ -\name{finmix-package} -\alias{finmix-package} -\alias{finmix} -\docType{package} -\title{ -What the package does (short line) -~~ package title ~~ -} -\description{ -More about what it does (maybe more than one line) -~~ A concise (1-5 lines) description of the package ~~ -} -\details{ -\tabular{ll}{ -Package: \tab finmix\cr -Type: \tab Package\cr -Version: \tab 0.1\cr -Date: \tab 2013-07-05\cr -License: \tab GPL >= 3\cr -} -~~ An overview of how to use the package, including the most important ~~ -~~ functions ~~ -} -\author{ -Lars Simon Zehnder - -Maintainer: Lars Simon Zehnder -} -\references{ -~~ Literature or other references for background information ~~ -} -~~ Optionally other standard keywords, one per line, from file KEYWORDS in ~~ -~~ the R documentation directory ~~ -\keyword{ package } - -\seealso{ -~~ Optional links to other man pages, e.g. ~~ -~~ \code{\link[:-package]{}} ~~ -} -\usage{ -data(y. = matrix(), ) -} -\examples{ -} diff --git a/man/generateMoments-normalmodelmoments-method.Rd b/man/generateMoments-normalmodelmoments-method.Rd new file mode 100644 index 0000000..264827d --- /dev/null +++ b/man/generateMoments-normalmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{generateMoments,normalmodelmoments-method} +\alias{generateMoments,normalmodelmoments-method} +\title{Generate moments for normal mixture} +\usage{ +\S4method{generateMoments}{normalmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object.} +} +\value{ +An \code{normalmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +normal mixture distribution. +} +\keyword{internal} diff --git a/man/generatePrior-prior-method.Rd b/man/generatePrior-prior-method.Rd new file mode 100644 index 0000000..2c0a734 --- /dev/null +++ b/man/generatePrior-prior-method.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{generatePrior,prior-method} +\alias{generatePrior,prior-method} +\title{Generates \code{prior} object} +\usage{ +\S4method{generatePrior}{prior}(object, fdata, model, varargin, prior.wagner, s) +} +\arguments{ +\item{object}{A \code{prior} object to store the prior parameters and weights.} + +\item{fdata}{An \code{fdata} object holding the data. Observations in slot \verb{@y} +must be existent.} + +\item{model}{A \code{model} object specifying the finite mixture model.} + +\item{varargin}{\code{NULL} or a \code{prior} object. This enables the user to pass in +an already constructed prior object that gets then completed.} + +\item{prior.wagner}{A logical indicating, if the prior from Wagner (2007) +should be used in case of an exponential mixture model.} + +\item{s}{A numeric specifying the standard deviation \code{s} for the +Metropolis-Hastings proposal.} +} +\description{ +Calling \code{\link[=generatePrior]{generatePrior()}} generates the \code{prior} object when \code{\link[=priordefine]{priordefine()}} +had been called. When this function is called all checks have been passed +and \code{prior} construction can take place. +} +\seealso{ +\itemize{ +\item \link[=prior-class]{prior} for the class definition +\item \code{\link[=priordefine]{priordefine()}} for the advanced class constructor using this method +} +} +\keyword{internal} diff --git a/man/getMperm-mcmcpermfix-method.Rd b/man/getMperm-mcmcpermfix-method.Rd new file mode 100644 index 0000000..1c43dcf --- /dev/null +++ b/man/getMperm-mcmcpermfix-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfix.R +\name{getMperm,mcmcpermfix-method} +\alias{getMperm,mcmcpermfix-method} +\alias{mcmcpermfix_class,} +\alias{mcmcpermfixhier_class,} +\alias{mcmcpermfixpost_class,} +\alias{mcmcpermfixhierpost} +\title{Getter method of \code{mcmcpermfix} class.} +\usage{ +\S4method{getMperm}{mcmcpermfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfix} object.} +} +\value{ +The \code{Mperm} slot of the \code{object}. +} +\description{ +Returns the \code{Mperm} slot. +} +\examples{ +\dontrun{getMperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \code{\link{mcmcoutputpermfix_class}} for the inheriting class +\item \code{\link{mcmcpermute}} for function permuting MCMC samples +} +} diff --git a/man/graphic_funs.Rd b/man/graphic_funs.Rd new file mode 100644 index 0000000..47daa02 --- /dev/null +++ b/man/graphic_funs.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/graphic_func.R +\name{graphic_funs} +\alias{graphic_funs} +\alias{.check.grDevice} +\title{Checks if graphical device has \code{title} option} +\usage{ +.check.grDevice() +} +\value{ +\code{TRUE} if \code{title} option exists. +} +\description{ +For internal use only. +} diff --git a/man/groupmoments.Rd b/man/groupmoments.Rd new file mode 100644 index 0000000..7df9370 --- /dev/null +++ b/man/groupmoments.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{groupmoments} +\alias{groupmoments} +\title{Finmix \code{groupmoments} class constructor} +\usage{ +groupmoments(value = fdata()) +} +\arguments{ +\item{value}{An \code{fdata} object containing observations in slot \code{y} and +indicators in slot \code{S}.} +} +\value{ +A \code{groupmoments} object containing component-specific moments of the +\code{fdata} object. +} +\description{ +Calling \code{\link[=groupmoments]{groupmoments()}} creates an object holding various +component-specific moments. These moments can only constructed if the +\link[=fdata_class]{fdata} object contains in addition to observations also +indicators defining from which component a certain observation stems. +} +\seealso{ +\itemize{ +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=groupmments_class]{groupmoments} for the definition of the \code{groupmoments} +class +\item \link[=datamoments_class]{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +} +} diff --git a/man/groupmoments_class.Rd b/man/groupmoments_class.Rd new file mode 100644 index 0000000..84c916f --- /dev/null +++ b/man/groupmoments_class.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\docType{class} +\name{groupmoments_class} +\alias{groupmoments_class} +\alias{.groupmoments} +\title{Finmix \code{groupmoments} class} +\description{ +Stores moments for finite mixture component distributions. These are only +available, if the data contains in addition to observations also indicators +defining to which component a certain observation belongs. These indicators +are stored in an \link[=fdata_class]{fdata} object in the slot \code{S}. +} +\section{Slots}{ + +\describe{ +\item{\code{NK}}{An array containing the group sizes for each component.} + +\item{\code{mean}}{A matrix containing the group averages for each component.} + +\item{\code{WK}}{An array containing the within-group variability. For multivariate +data this is an array of dimension \verb{K x r x r} and for univariate +data this is simply an array of dimension \verb{1 x K}.} + +\item{\code{var}}{An array containing the within-group (co)variance. For multivariate +data this is an array of dimension \verb{K x r x r} and for univariate +data this is simply an array of dimension \verb{1 x K}.} + +\item{\code{fdata}}{An \link[=fdata_class]{fdata} object containing the data.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +\item \link[=datamoments_class]{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +} +} diff --git a/man/hasPar-model-method.Rd b/man/hasPar-model-method.Rd new file mode 100644 index 0000000..64d00f8 --- /dev/null +++ b/man/hasPar-model-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{hasPar,model-method} +\alias{hasPar,model-method} +\title{Checks for parameters.} +\usage{ +\S4method{hasPar}{model}(object, verbose = FALSE) +} +\arguments{ +\item{verbose}{A logical indicating, if the function should give a print out.} + +\item{model}{An S4 model object.} +} +\value{ +A matrix with repetitions. Can be empty, if no repetitions are set. +} +\description{ +\code{hasPar} checks if the model has parameters defined. +} +\examples{ +\dontrun{ +if(hasPar(model)) {simulate(model)} +} + +} +\seealso{ +\code{model} +} diff --git a/man/hasS-fdata-method.Rd b/man/hasS-fdata-method.Rd new file mode 100644 index 0000000..9a820b7 --- /dev/null +++ b/man/hasS-fdata-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{hasS,fdata-method} +\alias{hasS,fdata-method} +\title{Checker method for \code{S} slot of an \code{fdata} object.} +\usage{ +\S4method{hasS}{fdata}(object, verbose = FALSE) +} +\arguments{ +\item{object}{An \code{fdata} object.} + +\item{verbose}{A logical indicating, if the function should print out +messages.} +} +\value{ +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{S} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. +} +\description{ +\code{\link[=hasY]{hasY()}} checks, if the object contains \code{S} data. +} +\examples{ +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasS(f_data) + +} +\seealso{ +\link{fdata} class for an overview of its slots +} diff --git a/man/hasT-model-method.Rd b/man/hasT-model-method.Rd new file mode 100644 index 0000000..abb064c --- /dev/null +++ b/man/hasT-model-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{hasT,model-method} +\alias{hasT,model-method} +\title{Checks for repetitions.} +\usage{ +\S4method{hasT}{model}(object, verbose = FALSE) +} +\arguments{ +\item{verbose}{A logical indicating if the function should give a print out.} + +\item{model}{An S4 model object.} +} +\value{ +A logical. \code{TRUE} if repetitions are existent in the model. If +values of slot \code{T} are \code{NA} it returns \code{FALSE}. +} +\description{ +\code{hasT} chwecks if the model object possesses repetitions. +} +\examples{ +\dontrun{ +if(hasT(model)) {cat('Has repetitions.')} +} + +} +\seealso{ +\code{model} +} diff --git a/man/hungarian_cc.Rd b/man/hungarian_cc.Rd new file mode 100644 index 0000000..590bc58 --- /dev/null +++ b/man/hungarian_cc.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{hungarian_cc} +\alias{hungarian_cc} +\title{Compute the hungarian matrix} +\usage{ +hungarian_cc(cost) +} +\arguments{ +\item{cost}{A matrix containing the costs for each row source and column +target.} +} +\value{ +An integer matrix defining the best solution to the assignment +problem. +} +\description{ +This function calls an implementation of the Hungarian algorithm by Munkres. +The Hungarian algorithm solves a weighted assignment problem on a bipartite +graph. Note, here this algorithm is used in the re-labeling algorithm by +Stephens (1997b). +} +\references{ +\itemize{ +\item Stephens, Matthew (1997b), "Dealing with Label-Switching in Mixture +Models", Journal of the Royal Statistical Society Series B, 62(4) +} +} +\seealso{ +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for the function that uses the re-labeling algorithm by +Stephens (1997b) +} +} diff --git a/man/initialize-mcmcoutputpermbase-method.Rd b/man/initialize-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..3379ece --- /dev/null +++ b/man/initialize-mcmcoutputpermbase-method.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{initialize,mcmcoutputpermbase-method} +\alias{initialize,mcmcoutputpermbase-method} +\title{Initializer of the \code{mcmcoutputpermbase} class} +\usage{ +\S4method{initialize}{mcmcoutputpermbase}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + relabel = character(), + weightperm = array(), + logperm = list(), + entropyperm = array(), + STperm = array(), + Sperm = array(), + NKperm = array() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{relabel}{A character specifying the relabeling algorithm used for +permuting the MCMC samples.} + +\item{weightperm}{An array of dimension \verb{Mperm x K} containing the +relabeled weight parameters.} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{entropyperm}{An \code{array} of dimension \verb{Mperm x 1} containing the +entropy for each MCMC permuted draw.} + +\item{STperm}{An \code{array} of dimension \verb{Mperm x 1} containing all permuted +MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation.} + +\item{Sperm}{An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} + +\item{NKperm}{} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermfix-method.Rd b/man/initialize-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..e5617e6 --- /dev/null +++ b/man/initialize-mcmcoutputpermfix-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{initialize,mcmcoutputpermfix-method} +\alias{initialize,mcmcoutputpermfix-method} +\title{Initializer of the \code{mcmcoutputpermfix} class} +\usage{ +\S4method{initialize}{mcmcoutputpermfix}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + logperm = list() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermfixhier-method.Rd b/man/initialize-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..3b05acd --- /dev/null +++ b/man/initialize-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{initialize,mcmcoutputpermfixhier-method} +\alias{initialize,mcmcoutputpermfixhier-method} +\title{Initializer of the \code{mcmcoutputpermfixhier} class} +\usage{ +\S4method{initialize}{mcmcoutputpermfixhier}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + logperm = list(), + hyperperm = list() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{hyperperm}{A named list containing the permuted parameters of the +hierarchical prior.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermfixhierpost-method.Rd b/man/initialize-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..88ebcc5 --- /dev/null +++ b/man/initialize-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{initialize,mcmcoutputpermfixhierpost-method} +\alias{initialize,mcmcoutputpermfixhierpost-method} +\title{Initializer of the \code{mcmcoutputpermfixhier} class} +\usage{ +\S4method{initialize}{mcmcoutputpermfixhierpost}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + logperm = list(), + hyperperm = list(), + postperm = list() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{hyperperm}{A named list containing the (permuted) parameters of the +hierarchical prior.} + +\item{postperm}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermhier-method.Rd b/man/initialize-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..a5bd121 --- /dev/null +++ b/man/initialize-mcmcoutputpermhier-method.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{initialize,mcmcoutputpermhier-method} +\alias{initialize,mcmcoutputpermhier-method} +\title{Initializer of the \code{mcmcoutputpermhier} class} +\usage{ +\S4method{initialize}{mcmcoutputpermhier}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + relabel = character(), + weightperm = array(), + logperm = list(), + entropyperm = array(), + STperm = array(), + Sperm = array(), + NKperm = array() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{relabel}{A character specifying the relabeling algorithm used for +permuting the MCMC samples.} + +\item{weightperm}{An array of dimension \verb{Mperm\\ x K} containing the +relabeled weight parameters.} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{entropyperm}{An \code{array} of dimension \verb{Mperm\\ x 1} containing the +entropy for each MCMC permuted draw.} + +\item{STperm}{An \code{array} of dimension \verb{Mperm\\ x 1} containing all permuted +MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation.} + +\item{NKperm}{An \code{array} of dimension \verb{Mperm\\ x K} containing the numbers +of observations assigned to each component.} + +\item{An}{\code{array} of dimension \verb{N\\ x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermhierpost-method.Rd b/man/initialize-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..4cb3954 --- /dev/null +++ b/man/initialize-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{initialize,mcmcoutputpermhierpost-method} +\alias{initialize,mcmcoutputpermhierpost-method} +\title{Initializer of the \code{mcmcoutputpermhierpost} class} +\usage{ +\S4method{initialize}{mcmcoutputpermhierpost}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + relabel = character(), + weightperm = array(), + logperm = list(), + hyperperm = list(), + postperm = list(), + entropyperm = array(), + STperm = array(), + Sperm = array(), + NKperm = array() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{relabel}{A character specifying the relabeling algorithm used for +permuting the MCMC samples.} + +\item{weightperm}{An array of dimension \verb{Mperm x K} containing the +relabeled weight parameters.} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{hyperperm}{A named list containing the (permuted) parameters of the +hierarchical prior.} + +\item{postperm}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} + +\item{entropyperm}{An \code{array} of dimension \verb{Mperm x 1} containing the +entropy for each MCMC permuted draw.} + +\item{STperm}{An \code{array} of dimension \verb{Mperm x 1} containing all permuted +MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation.} + +\item{NKperm}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +of observations assigned to each component.} + +\item{An}{\code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermpost-method.Rd b/man/initialize-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..7e650df --- /dev/null +++ b/man/initialize-mcmcoutputpermpost-method.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{initialize,mcmcoutputpermpost-method} +\alias{initialize,mcmcoutputpermpost-method} +\title{Initializer of the \code{mcmcoutputpermpost} class} +\usage{ +\S4method{initialize}{mcmcoutputpermpost}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + relabel = character(), + weightperm = array(), + logperm = list(), + postperm = list(), + entropyperm = array(), + STperm = array(), + Sperm = array(), + NKperm = array() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{relabel}{A character specifying the relabeling algorithm used for +permuting the MCMC samples.} + +\item{weightperm}{An array of dimension \verb{Mperm x K} containing the +relabeled weight parameters.} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{postperm}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} + +\item{entropyperm}{An \code{array} of dimension \verb{Mperm x 1} containing the +entropy for each MCMC permuted draw.} + +\item{STperm}{An \code{array} of dimension \verb{Mperm x 1} containing all permuted +MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation.} + +\item{NKperm}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +of observations assigned to each component.} + +\item{An}{\code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-normalmodelmoments-method.Rd b/man/initialize-normalmodelmoments-method.Rd new file mode 100644 index 0000000..8453988 --- /dev/null +++ b/man/initialize-normalmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{initialize,normalmodelmoments-method} +\alias{initialize,normalmodelmoments-method} +\title{Initializer of the \code{normalmodelmoments} class} +\usage{ +\S4method{initialize}{normalmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-sdatamoments-method.Rd b/man/initialize-sdatamoments-method.Rd new file mode 100644 index 0000000..c954785 --- /dev/null +++ b/man/initialize-sdatamoments-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\name{initialize,sdatamoments-method} +\alias{initialize,sdatamoments-method} +\title{Initializer of the \code{sdatamoments} class} +\usage{ +\S4method{initialize}{sdatamoments}(.Object, ..., value = fdata()) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \link[=fdata_class]{fdata} object containing the observations.} +} +\description{ +Only used implicitly. The initializer calls the constructor for a +\link[=groupmoments_class]{groupmoments} object. to generate in the initialization +step the moments for a passed-in \code{fdata} object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/lddirichlet_cc.Rd b/man/lddirichlet_cc.Rd new file mode 100644 index 0000000..25b533f --- /dev/null +++ b/man/lddirichlet_cc.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{lddirichlet_cc} +\alias{lddirichlet_cc} +\title{Computes the log density of the Dirichlet distribution} +\usage{ +lddirichlet_cc(values, par) +} +\arguments{ +\item{values}{A matrix of dimension \verb{M x K} for which the log-density +should be calculated.} + +\item{par}{A vector of dimension \verb{K x 1} containing the Dirichlet +parameters.} +} +\value{ +A vector of Dirichlet log-density values. +} +\description{ +For each shape and rate parameter pair the log-Dirichlet density is +computed. Inside the function the unsafe access functions of Armadillo +\code{at()} and \code{unsafe_col()} are used, so now boundary check is performed. +In each step the \code{lgammafn()} function from Rcpp's \code{R} namespace is used. +At this time unused. +} diff --git a/man/ldgamma_cc.Rd b/man/ldgamma_cc.Rd new file mode 100644 index 0000000..52489a3 --- /dev/null +++ b/man/ldgamma_cc.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{ldgamma_cc} +\alias{ldgamma_cc} +\title{Computes the log density of the Gamma distribution} +\usage{ +ldgamma_cc(values, shape, rate) +} +\arguments{ +\item{values}{A matrix of dimension \verb{M x K} for which the log-density +should be calculated.} + +\item{shape}{A vector of dimension \verb{K x 1} with Gamma shape parameters.} + +\item{rate}{A vector of dimension \verb{K x 1} with Gamma rate parameters.} +} +\value{ +A matrix of Gamma log-density values for each pair of parameters +in a column. +} +\description{ +For each shape and rate parameter pair the log gamma density is computed. +Inside the function the unsafe access functions of Armadillo \code{at()} and +\code{unsafe_col()} are used, so now boundary check is performed. In each step +the \code{lngamma()} function from Rcpp's \code{R} namespace is used. At this time +unused. +} diff --git a/man/mcmc.Rd b/man/mcmc.Rd new file mode 100644 index 0000000..1a94528 --- /dev/null +++ b/man/mcmc.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{mcmc} +\alias{mcmc} +\title{Constructor for \code{mcmc} class} +\usage{ +mcmc( + burnin = 0, + M = 5000, + startpar = TRUE, + storeS = 1000, + storepost = TRUE, + ranperm = TRUE, + storeinv = TRUE +) +} +\arguments{ +\item{burnin}{An integer defining the number of steps in the burn-in phase of +Gibbs-sampling.} + +\item{M}{An integer defining the number of steps in Gibbs-sampling to be +stored.} + +\item{startpar}{A logical indicating, if starting by sampling the +parameters. If \code{FALSE} sampling starts by sampling the indicators \code{S}.} + +\item{storeS}{An integer specifying how many of the last sampled indicators +should be stored in the output.} + +\item{storepost}{A logical indicating if the posterior probabilities should +be stored. This becomes for example important for specific relabeling +algorithms, but also for analysis.} + +\item{ranperm}{A logical indicating, if random permutation should be used. If +\code{TRUE} the parameters are permutated randomly between the number of +components after each sampling step in MCMC.} + +\item{storeinv}{A logical indicating if the inverse variance-covariance +matrices for multivariate normal or Student-t mixtures should be stored.} +} +\value{ +An object of class \code{mcmc} containing all hyper-parameters for MCMC +sampling. +} +\description{ +Calling \code{\link[=mcmc]{mcmc()}} constructs an object of class \code{mcmc} that specifies the +hyper-parameters for the MCMC procedure. Each MCMC sampling needs an \code{mcmc} +object that specifies the way, how MCMC sampling should be performed and +what kind and how much of data should be stored. +} +\examples{ +f_mcmc <- mcmc() + +} +\seealso{ +\itemize{ +\item \link[=mcmc_class]{mcmc} for the definition of the \code{mcmc} class +\item \code{\link[=mcmcstart]{mcmcstart()}} for setting up all objects for MCMC sampling +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for running MCMC sampling for finite mixture models +} +} diff --git a/man/mcmc_binomial_cc.Rd b/man/mcmc_binomial_cc.Rd new file mode 100644 index 0000000..f62ba9a --- /dev/null +++ b/man/mcmc_binomial_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_binomial_cc} +\alias{mcmc_binomial_cc} +\title{Performs MCMC sampling for mixtures of Binomial distributions} +\usage{ +mcmc_binomial_cc(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{model_S4}{A \code{model} object specifying the Binomial finite mixture +model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} + +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a Binomial mixture +model. In addition an \code{mcmcoutput} object is given that stores the output +of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code on +so-called "mixin" layers that help to design a software by organizing code +into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_class.Rd b/man/mcmc_class.Rd new file mode 100644 index 0000000..b9cf284 --- /dev/null +++ b/man/mcmc_class.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\docType{class} +\name{mcmc_class} +\alias{mcmc_class} +\alias{.mcmc} +\title{Finmix \code{mcmc} class} +\description{ +This class defines hyper-parameters for the MCMC procedure. This is a main +class of the \code{finmix} package that must be defined for estimating a finite +mixture model. +} +\section{Slots}{ + +\describe{ +\item{\code{burnin}}{An integer defining the number of steps in the burn-in phase of +Gibbs-sampling.} + +\item{\code{M}}{An integer defining the number of steps in Gibbs-sampling to be +stored.} + +\item{\code{startpar}}{A logical indicating, if starting by sampling the +parameters. If \code{FALSE} sampling starts by sampling the indicators \code{S}.} + +\item{\code{storeS}}{An integer specifying how many of the last sampled indicators +should be stored in the output.} + +\item{\code{storepost}}{A logical indicating if the posterior probabilities should +be stored. This becomes for example important for specific relabeling +algorithms, but also for analysis.} + +\item{\code{ranperm}}{A logical indicating, if random permutation should be used. If +\code{TRUE} the parameters are permutated randomly between the number of +components after each sampling step in MCMC.} + +\item{\code{storeinv}}{A logical indicating if the inverse variance-covariance +matrices for multivariate normal or Student-t mixtures should be stored.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmc]{mcmc()}} for the class constructor +\item \code{\link[=mcmcstart]{mcmcstart()}} for completion of slots +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for further information about the MCMC sampling +} +} diff --git a/man/mcmc_condpoisson_cc.Rd b/man/mcmc_condpoisson_cc.Rd new file mode 100644 index 0000000..a746b4f --- /dev/null +++ b/man/mcmc_condpoisson_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_condpoisson_cc} +\alias{mcmc_condpoisson_cc} +\title{Performs MCMC sampling for mixtures of conditional Poisson distributions} +\usage{ +mcmc_condpoisson_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the conditional Poisson finite mixture +model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a conditional Poisson +mixture model. In addition an \code{mcmcoutput} object is given that stores the +output of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code +on so-called "mixin" layers that help to design a software by organizing +code into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_exponential_cc.Rd b/man/mcmc_exponential_cc.Rd new file mode 100644 index 0000000..bb01073 --- /dev/null +++ b/man/mcmc_exponential_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_exponential_cc} +\alias{mcmc_exponential_cc} +\title{Performs MCMC sampling for mixtures of Exponential distributions} +\usage{ +mcmc_exponential_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the Exponential finite mixture +model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a Exponential mixture +model. In addition an \code{mcmcoutput} object is given that stores the output +of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code on +so-called "mixin" layers that help to design a software by organizing code +into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_normal_cc.Rd b/man/mcmc_normal_cc.Rd new file mode 100644 index 0000000..5357e33 --- /dev/null +++ b/man/mcmc_normal_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_normal_cc} +\alias{mcmc_normal_cc} +\title{Performs MCMC sampling for mixtures of Normal distributions} +\usage{ +mcmc_normal_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the Normal finite mixture +model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a Normal mixture +model. In addition an \code{mcmcoutput} object is given that stores the output +of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code on +so-called "mixin" layers that help to design a software by organizing code +into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_normult_cc.Rd b/man/mcmc_normult_cc.Rd new file mode 100644 index 0000000..9536ab2 --- /dev/null +++ b/man/mcmc_normult_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_normult_cc} +\alias{mcmc_normult_cc} +\title{Performs MCMC sampling for mixtures of multivariate Normal distributions} +\usage{ +mcmc_normult_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the multivariate Normal finite +mixture model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a multivariate Normal +mixture model. In addition an \code{mcmcoutput} object is given that stores the +output of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code +on so-called "mixin" layers that help to design a software by organizing +code into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_poisson_cc.Rd b/man/mcmc_poisson_cc.Rd new file mode 100644 index 0000000..b6f5acd --- /dev/null +++ b/man/mcmc_poisson_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_poisson_cc} +\alias{mcmc_poisson_cc} +\title{Performs MCMC sampling for mixtures of Poisson distributions} +\usage{ +mcmc_poisson_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the Poisson finite mixture +model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a Poisson mixture +model. In addition an \code{mcmcoutput} object is given that stores the output +of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code on +so-called "mixin" layers that help to design a software by organizing code +into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_student_cc.Rd b/man/mcmc_student_cc.Rd new file mode 100644 index 0000000..2849380 --- /dev/null +++ b/man/mcmc_student_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_student_cc} +\alias{mcmc_student_cc} +\title{Performs MCMC sampling for mixtures of Student-t distributions} +\usage{ +mcmc_student_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the Student-t finite mixture +model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{A \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a Student-t mixture +model. In addition an \code{mcmcoutput} object is given that stores the output +of MCMC sampling in R memory. Note that \code{finmix} relies in C++ code on +so-called "mixin" layers that help to design a software by organizing code +into layers that build upon each others and enable modularity in MCMC +sampling by allowing to combine different sampling designs, e.g. with or +without a hierarchical prior, with fixed indicators or storing posterior +density parameters. See for more information on mixin layers Smaragdakis +and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmc_studmult_cc.Rd b/man/mcmc_studmult_cc.Rd new file mode 100644 index 0000000..feef610 --- /dev/null +++ b/man/mcmc_studmult_cc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mcmc_studmult_cc} +\alias{mcmc_studmult_cc} +\title{Performs MCMC sampling for mixtures of multivariate Student-t distributions} +\usage{ +mcmc_studmult_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) +} +\arguments{ +\item{data_S4}{An \code{fdata} object storing the observations and indicators.} + +\item{model_S4}{A \code{model} object specifying the multivariate Student-t +finite mixture model.} + +\item{prior_S4}{A \code{prior} object specifying the prior distribution for MCMC +sampling.} + +\item{mcmc_S4}{An \code{mcmc} object specifying the hyper-parameters for MCMC +sampling.} + +\item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC +sampling using R memory.} +} +\value{ +An \code{mcmcoutput} object containing the results from MCMC sampling +and using the R memory from the input argument \code{mcmcoutput_S4}. +} +\description{ +For internal usage only. This function gets passed the \code{fdata}, \code{model}, +\code{prior}, \code{mcmc} objects to perform MCMC sampling for a multivriate +Student-t mixture model. In addition an \code{mcmcoutput} object is given that +stores the output of MCMC sampling in R memory. Note that \code{finmix} relies +in C++ code on so-called "mixin" layers that help to design a software by +organizing code into layers that build upon each others and enable +modularity in MCMC sampling by allowing to combine different sampling +designs, e.g. with or without a hierarchical prior, with fixed indicators +or storing posterior density parameters. See for more information on mixin +layers Smaragdakis and Butory (1998). +} +\references{ +\itemize{ +\item Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +Berlin, Heidelberg. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +} +} diff --git a/man/mcmcest_class.Rd b/man/mcmcest_class.Rd new file mode 100644 index 0000000..f5b49ed --- /dev/null +++ b/man/mcmcest_class.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R, R/mcmcestind.R +\docType{class} +\name{mcmcest_class} +\alias{mcmcest_class} +\alias{.mcmcestfix} +\alias{mcmcestind-class} +\alias{.mcmcestind} +\title{Finmix \code{mcmcestfix} class} +\description{ +This class stores the point estimators for component parameters and weights +as well as corresponding information from MCMC sampling. Three point +estimators are calculated: the maximum a posterior (MAP), the Bayesian +maximum likelihood (BML) and the Identified ergodic average (IEAVG). See +Fr\"uhwirth-Schnatter (2006) for detailed information about how these +estimators are defined. + +This class stores the point estimators for component parameters and weights +as well as corresponding information from MCMC sampling. Three point +estimators are calculated: the maximum a posterior (MAP), the Bayesian +maximum likelihood (BML) and the Identified ergodic average (IEAVG). See +Fr\"uhwirth-Schnatter (2006) for detailed information about how these +estimators are defined. + +Note that this class inherits almost all of its slots from the \code{mcmcestfix} +class, the corresponding class for fixed indicators. +} +\section{Functions}{ +\itemize{ +\item \code{mcmcestind-class}: Finmix \code{mcmcestind} class +}} + +\section{Slots}{ + +\describe{ +\item{\code{dist}}{A character specifying the distribution family of the mixture +model used in MCMC sampling.} + +\item{\code{K}}{An integer specifying the number of components in the mixture model.} + +\item{\code{indicmod}}{A character specifying the indicator model. At this moment +only a multinomial model can be chosen.} + +\item{\code{burnin}}{An integer specifying the number of iterations in the burn-in +phase of MCMC sampling.} + +\item{\code{M}}{An integer specifying the number of iterations to store in MCMC +sampling.} + +\item{\code{ranperm}}{A logical specifying, if random permutation has been used +during MCMC sampling.} + +\item{\code{relabel}}{A character specifying the re-labeling algorithm used during +parameter estimation for the identified ergodic average.} + +\item{\code{map}}{A named list containing the parameter estimates of the MAP. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{bml}}{A named list containing the parameter estimates of the BML. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{A}}{named list containing the parameter estimates of the IEAVG. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{sdpost}}{A named list containing the standard deviations of the +parameter estimates from the posterior distributions.} + +\item{\code{eavg}}{A named list containing the estimates of the ergodic average. The +element \code{par} is a list and contains the component parameter estimates and +\code{weight} contains the weight estimates. The difference between the EAVG +and the IEAVG is that the IEAVG is based on re-labeled samples.} +}} + +\seealso{ +\itemize{ +\item \link[=mcmcest_class]{mcmcestind} for the equivalent class for models with +unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} to calculate point estimates +} + +\itemize{ +\item \link[=mcmcest_class]{mcmcestfix} for the parent class with fixed indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} to calculate point estimates +} +} diff --git a/man/mcmcestimate.Rd b/man/mcmcestimate.Rd new file mode 100644 index 0000000..96de3aa --- /dev/null +++ b/man/mcmcestimate.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestimate.R +\name{mcmcestimate} +\alias{mcmcestimate} +\title{Calculate point estimators from MCMC samples} +\usage{ +mcmcestimate( + mcmcout, + method = "kmeans", + fdata = NULL, + permOut = FALSE, + opt_ctrl = list(max_iter = 200L) +) +} +\arguments{ +\item{mcmcout}{An \code{mcmcoutput} object containing the sampled parameters and +informaiton about the finite mixture model.} + +\item{method}{A character defining the re-labeling method in case of a model +with unknown indicators. For most distributions there exists only a single +choice, namely "kmeans". For Poisson and Binomial distributions the +re-labeling algorithms "Stephens1997a" and "Stephens1997b" can be chosen.} + +\item{fdata}{An \code{fdata} model containing the observations. Optional.} + +\item{permOut}{A logical indicating, if the permuted MCMC samples should be +returned as well. Optional.} + +\item{opt_ctrl}{A list with an element \code{max_iter} controlling the number of +iterations in case the "Stephens1997a" re-labeling algorithm is chosen.} +} +\value{ +An \code{mcmcest} object cotnaining the point estimates together with +additional information about the underlying finite mixture model, MCMC +sampling hyper-parameters and the data. In case \code{permOut} is set to +\code{TRUE}, the output of this function is a named list with an \code{mcmcest} +object containing parameter estimates and in addition an \code{mcmcoutputperm} +object containing the permuted (re-labeled) MCMC samples. +} +\description{ +Calling \code{\link[=mcmcestimate]{mcmcestimate()}} calculates the following point estimates from the +MCMC samples: +\itemize{ +\item MAP: The maximum a posterior estimates are defined as the mode of the +(joint) posterior density. +\item BML: The Bayesian maximum likelihood estimator is based on the mixture +log-likelihood function and defines the mode of this function. +\item EAVG: The ergodic average is calculated as an average over the MCMC traces +of component parameters and weights (in case of unknown parameters). +\item IEAVG: The identified ergodic average is defined similar to the EAVG, +however, in contrast to the latter it is based on re-labeled MCMC traces. +This is especially important in case of random permutation during MCMC +sampling as component parameters then have to be re-assigned to their +(probably) correct component. +} + +For a more detailed outlay of point estimators from Bayesian mixture model +estimation, see Fr\"uhwirth-Schnatter (2006). +} +\seealso{ +\itemize{ +\item \link[=mcmcest_class]{mcmcestfix} for object storing the parameter estimates in +case of fixed indicators +\item \link[=mcmcest_class]{mcmcestfix} for object storing the parameter estimates in +case of unknown indicators +\item \link[=mcmcoutputperm_class]{mcmcoutputperm} for classes storing re-labeled +MCMC samples +} +} diff --git a/man/mcmcoutput-class.Rd b/man/mcmcoutput-class.Rd new file mode 100644 index 0000000..719c1cb --- /dev/null +++ b/man/mcmcoutput-class.Rd @@ -0,0 +1,10 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\docType{class} +\name{mcmcoutput-class} +\alias{mcmcoutput-class} +\title{Finmix \code{mcmcoutput} class union} +\description{ +This class union is set to dispatch methods for \code{mcmcoutput} objects from +MCMC sampling. +} diff --git a/man/mcmcoutput_class.Rd b/man/mcmcoutput_class.Rd new file mode 100644 index 0000000..4dae5a9 --- /dev/null +++ b/man/mcmcoutput_class.Rd @@ -0,0 +1,1207 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R, R/mcmcoutputfixhier.R, +% R/mcmcoutputfixpost.R, R/mcmcoutputfixhierpost.R, R/mcmcoutputbase.R, +% R/mcmcoutputhier.R, R/mcmcoutputpost.R, R/mcmcoutputhierpost.R +\docType{class} +\name{mcmcoutput_class} +\alias{mcmcoutput_class} +\alias{.mcmcoutputfix} +\alias{plotTraces,mcmcoutputfix-method} +\alias{plotHist,mcmcoutputfix-method} +\alias{plotDens,mcmcoutputfix-method} +\alias{plotPointProc,mcmcoutputfix-method} +\alias{plotSampRep,mcmcoutputfix-method} +\alias{plotPostDens,mcmcoutputfix-method} +\alias{mcmcoutputfixhier-class} +\alias{.mcmcoutputfixhier} +\alias{plotTraces,mcmcoutputfixhier-method} +\alias{plotHist,mcmcoutputfixhier-method} +\alias{plotDens,mcmcoutputfixhier-method} +\alias{plotPointProc,mcmcoutputfixhier-method} +\alias{plotSampRep,mcmcoutputfixhier-method} +\alias{plotPostDens,mcmcoutputfixhier-method} +\alias{mcmcoutputfixpost-class} +\alias{.mcmcoutputfixpost} +\alias{plotTraces,mcmcoutputfixpost-method} +\alias{plotHist,mcmcoutputfixpost-method} +\alias{plotDens,mcmcoutputfixpost-method} +\alias{plotPointProc,mcmcoutputfixpost-method} +\alias{plotSampRep,mcmcoutputfixpost-method} +\alias{plotPostDens,mcmcoutputfixpost-method} +\alias{mcmcoutputfixhierpost-class} +\alias{.mcmcoutputfixhierpost} +\alias{plotHist,mcmcoutputfixhierpost-method} +\alias{plotTraces,mcmcoutputbase-method} +\alias{plotHist,mcmcoutputbase-method} +\alias{plotDens,mcmcoutputbase-method} +\alias{plotPointProc,mcmcoutputbase-method} +\alias{plotSampRep,mcmcoutputbase-method} +\alias{plotPostDens,mcmcoutputbase-method} +\alias{plotPostDens,mcmcoutputhier-method} +\alias{show,mcmcoutputpost-method} +\alias{plotPostDens,mcmcoutputpost-method} +\alias{plotTraces,mcmcoutputhierpost-method} +\alias{plotHist,mcmcoutputhierpost-method} +\alias{plotDens,mcmcoutputhierpost-method} +\alias{plotPostDens,mcmcoutputhierpost-method} +\title{Finmix \code{mcmcoutput} base class for fixed indicators} +\usage{ +\S4method{plotTraces}{mcmcoutputfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputfix}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputfix}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputfix}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputfix}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputfix}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputfixhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputfixhier}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputfixhier}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputfixhier}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputfixhier}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputfixhier}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputfixpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputfixpost}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputfixpost}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputfixpost}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputfixpost}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputfixpost}(x, dev = TRUE, ...) + +\S4method{plotHist}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputhier}(x, dev = TRUE, ...) + +\S4method{show}{mcmcoutputpost}(object) + +\S4method{plotPostDens}{mcmcoutputpost}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputhierpost}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} + +\item{object}{An \code{ mcmcoutputpost} object.} +} +\value{ +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point process of the MCMC samples. + +Sampling representation of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point process of the MCMC samples. + +Sampling representation of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point process of the MCMC samples. + +Sampling representation of the MCMC samples. + +Posterior densities of the MCMC samples. + +Histograms of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point processes of the MCMC samples. + +Sampling representations of the MCMC samples. + +Posterior densities of the MCMC samples. + +Posterior densities of the MCMC samples. + +A console output listing the slots and summary information about +each of them. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Posterior densities of the MCMC samples. +} +\description{ +This class defines the basic slots for the MCMC sampling output for a +fixed indicator model. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +This class stores in addition to the information from its parent class +\code{mcmcoutputfix} also the sampled parameters from the hierarchical prior. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{0}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +The \code{mcmcoutputfixpost} class inherits from the \code{mcmcoutputfix} class and +adds a slot to store the parameters of the posterior distribution from which +the component parameters are drawn. The storage of posterior parameters is +controlled by the slot \code{storepost} in the \link[=mcmc_class]{mcmc} class. If set +to \code{TRUE} posterior parameters are stored in the output of the MCMC sampling. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. If \code{lik} is set to \code{0} the parameters of the components and the +posterior parameters are plotted together with \code{K-1} weights. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfix}. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfix}. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note that this methid calls the equivalent method from the parent class +\code{mcmcoutputfix}. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this methid calls the equivalent method from the parent class +\code{mcmcoutputfix}. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method calls the equivalent method of the parent class +\code{mcmcoutputfix}. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this methid calls the equivalent method of the parent class +\code{mcmcoutputfix}. + +This class inherits from the \code{mcmcoutputfixhier} class and adds posterior +density parameters to the MCMC sampling output. The storage of posterior +parameters is controlled by the slot \code{storepost} in the \link[=mcmc_class]{mcmc} +class. If set to \code{TRUE} posterior parameters are stored in the output of the +MCMC sampling. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{0}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Calling \code{\link[=show]{show()}} on an \code{ mcmcoutputpost} object gives an overview +of the \code{ mcmcoutputpost} object. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s If \code{lik} is set to \code{0} the parameters of the components and the +posterior parameters are plotted together with \code{K-1} weights. + +Note that this method calls the equivalent method from the parent class. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method calls the equivalent method of the parent class. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note that this method calls the equivalent method of the parent class. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method calls the equivalent method of the parent class. +} +\section{Functions}{ +\itemize{ +\item \code{plotTraces,mcmcoutputfix-method}: + +\item \code{plotHist,mcmcoutputfix-method}: + +\item \code{plotDens,mcmcoutputfix-method}: + +\item \code{plotPointProc,mcmcoutputfix-method}: + +\item \code{plotSampRep,mcmcoutputfix-method}: + +\item \code{plotPostDens,mcmcoutputfix-method}: + +\item \code{mcmcoutputfixhier-class}: + +\item \code{plotTraces,mcmcoutputfixhier-method}: + +\item \code{plotHist,mcmcoutputfixhier-method}: + +\item \code{plotDens,mcmcoutputfixhier-method}: + +\item \code{plotPointProc,mcmcoutputfixhier-method}: + +\item \code{plotSampRep,mcmcoutputfixhier-method}: + +\item \code{plotPostDens,mcmcoutputfixhier-method}: + +\item \code{mcmcoutputfixpost-class}: + +\item \code{plotTraces,mcmcoutputfixpost-method}: + +\item \code{plotHist,mcmcoutputfixpost-method}: + +\item \code{plotDens,mcmcoutputfixpost-method}: + +\item \code{plotPointProc,mcmcoutputfixpost-method}: + +\item \code{plotSampRep,mcmcoutputfixpost-method}: + +\item \code{plotPostDens,mcmcoutputfixpost-method}: + +\item \code{mcmcoutputfixhierpost-class}: + +\item \code{plotHist,mcmcoutputfixhierpost-method}: + +\item \code{plotTraces,mcmcoutputbase-method}: + +\item \code{plotHist,mcmcoutputbase-method}: + +\item \code{plotDens,mcmcoutputbase-method}: + +\item \code{plotPointProc,mcmcoutputbase-method}: + +\item \code{plotSampRep,mcmcoutputbase-method}: + +\item \code{plotPostDens,mcmcoutputbase-method}: + +\item \code{plotPostDens,mcmcoutputhier-method}: + +\item \code{show,mcmcoutputpost-method}: Shows a short summary of the object's slots + +\item \code{plotPostDens,mcmcoutputpost-method}: + +\item \code{plotTraces,mcmcoutputhierpost-method}: + +\item \code{plotHist,mcmcoutputhierpost-method}: + +\item \code{plotDens,mcmcoutputhierpost-method}: + +\item \code{plotPostDens,mcmcoutputhierpost-method}: +}} + +\section{Slots}{ + +\describe{ +\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} + +\item{\code{burnin}}{An integer defining the number of iterations in the burn-in +phase of MCMC sampling. These number of sampling steps are not stored +in the output.} + +\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed +with random permutations of components.} + +\item{\code{par}}{A named list containing the sampled component parameters.} + +\item{\code{log}}{A named list containing the values of the mixture log-likelihood, +mixture prior log-likelihood, and the complete data posterior +log-likelihood.} + +\item{\code{model}}{The \code{model} object that specifies the finite mixture model for +whcih MCMC sampling has been performed.} + +\item{\code{prior}}{The \code{prior} object defining the prior distributions for the +component parameters that has been used in MCMC sampling.} + +\item{\code{hyper}}{A list storing the sampled parameters from the hierarchical +prior.} + +\item{\code{post}}{A named list containing a list \code{par} that contains the posterior +parameters as named arrays.} + +\item{\code{post}}{A named list containing a named list \code{par} with arrays for the +posterior density parameters.} +}} + +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) +} + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputfix} for the parent class`` +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputfix} for the parent class +\item \link[=mcmcoutput_class]{mcmcoutputpost} for the corresponding class for unknown +indicators. +\item \link[=mcmc_class]{mcmc} for the class defining the MCMC hyper-parameters +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \link[=mcmc_class]{mcmc} class +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputfixhier} for the parent class +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=mcmc_class]{mcmc} for the class defining the MCMC hyper-parameters +\item \code{\link[=mcmc]{mcmc()}} for the \code{mcmc} class constructor +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} diff --git a/man/mcmcoutputbase-class.Rd b/man/mcmcoutputbase-class.Rd new file mode 100644 index 0000000..31387ef --- /dev/null +++ b/man/mcmcoutputbase-class.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\docType{class} +\name{mcmcoutputbase-class} +\alias{mcmcoutputbase-class} +\alias{.mcmcoutputbase} +\title{Finmix \code{mcmcoutput} base class for unknown indicators} +\description{ +This class defines the basic slots for the MCMC sampling output when +indicators are not known. It inherits from the +\link[=mcmcoutput_class]{mcmcoutfix}. +} +\section{Slots}{ + +\describe{ +\item{\code{weight}}{An \code{array} of dimension \verb{M x K} containing the sampled +weights.} + +\item{\code{entropy}}{An \code{array} of dimension \verb{M x 1} containing the entropy +for each MCMC draw.} + +\item{\code{ST}}{An \code{array} of dimension \verb{M x 1} containing all MCMC states, +for the last observation in slot \verb{@y} of the \code{fdata} object passed in to +\code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the +last indicator of this observation.} + +\item{\code{S}}{An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} indicators sampled. \code{storeS} is defined in the slot \verb{@storeS} of +the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} + +\item{\code{NK}}{An \code{array} of dimension \verb{M x K} containing the number of +observations assigned to each component for each MCMC draw.} + +\item{\code{clust}}{An \code{array} of dimension \verb{N x 1} containing the recent +indicators defining the last "clustering" of observations into the +mixture components.} +}} + diff --git a/man/mcmcoutputhier-class.Rd b/man/mcmcoutputhier-class.Rd new file mode 100644 index 0000000..d8186b7 --- /dev/null +++ b/man/mcmcoutputhier-class.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\docType{class} +\name{mcmcoutputhier-class} +\alias{mcmcoutputhier-class} +\alias{.mcmcoutputhier} +\title{Finmix \code{mcmcoutputhier} class} +\description{ +This class inherits from the \code{mcmcoutputbase} class and stores draws from +MCMC sampling with unknown indicators and an hierarchical prior. It adds to +its parent class a slot for storing the parameters of the hierarchical prior. + +To use an hierarchical prior in MCMC sampling the \code{prior} object needs to +have set slot \verb{@hier} to \code{TRUE}. +} +\section{Slots}{ + +\describe{ +\item{\code{hyper}}{A named list containing the arrays with parameters from the +hierarchical prior.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputbase} for the parent class +\item \linkS4class{prior} for the class specifying the prior distribution +\item \code{\link[=prior]{prior()}} for the \code{prior} class constructor +\item \code{\link[=priordefine]{priordefine()}} for the advanced \code{prior} class constructor +} +} diff --git a/man/mcmcoutputhierpost-class.Rd b/man/mcmcoutputhierpost-class.Rd new file mode 100644 index 0000000..5090a13 --- /dev/null +++ b/man/mcmcoutputhierpost-class.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\docType{class} +\name{mcmcoutputhierpost-class} +\alias{mcmcoutputhierpost-class} +\alias{.mcmcoutputhierpost} +\alias{show,mcmcoutputhierpost-method} +\title{Finmix \code{mcmcoutputhierpost} class} +\usage{ +\S4method{show}{mcmcoutputhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +This class stores samples from bayesian estimation with hierarchical prior +and unknown indicators. It inherits from \code{mcmcoutputhier} and adds to it a +slot to store the parameters from the posterior density. For a model with +unknown indicators the slot \verb{@indicfix} in the \code{model} object specifying +the finite mixture model must be set to \code{FALSE} (default). Sampling with a +hierarchical prior is activated by setting the slot \verb{@hier} in the \code{prior} +object to \code{TRUE} (default). Finally, to store parameters for the posterior +density the hyper-parameter \code{storepost} in the \code{mcmc} object must be set to +\code{TRUE} (default). + +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputhierpost} object gives an overview +of the \code{mcmcoutputhierpost} object. +} +\section{Functions}{ +\itemize{ +\item \code{show,mcmcoutputhierpost-method}: SHows a short summary of the object's +slots +}} + +\section{Slots}{ + +\describe{ +\item{\code{post}}{A named list containing a named list \code{par} that contains arrays +storing the sampled posterior density parameters.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputhier} for the parent class +\item \linkS4class{prior} for the class specifying the prior distribution +\item \code{\link[=prior]{prior()}} for the \code{prior} class constructor +\item \code{\link[=priordefine]{priordefine()}} for the advanced \code{prior} class constructor +\item \linkS4class{mcmc} for the class defining the hyper-parameters +\item \code{\link[=mcmc]{mcmc()}} for the \code{mcmc} class constructor +\item \linkS4class{model} for the \code{model} class definition +\item \code{\link[=model]{model()}} for the \code{model} class constructor +} +} diff --git a/man/mcmcoutputperm_class.Rd b/man/mcmcoutputperm_class.Rd new file mode 100644 index 0000000..6757677 --- /dev/null +++ b/man/mcmcoutputperm_class.Rd @@ -0,0 +1,1555 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R, R/mcmcoutputpermfixhier.R, +% R/mcmcoutputpermfixhierpost.R, R/mcmcoutputpermbase.R, +% R/mcmcoutputpermhier.R, R/mcmcoutputpermpost.R, R/mcmcoutputpermhierpost.R +\docType{class} +\name{plotTraces,mcmcoutputpermfix-method} +\alias{plotTraces,mcmcoutputpermfix-method} +\alias{plotHist,mcmcoutputpermfix-method} +\alias{plotDens,mcmcoutputpermfix-method} +\alias{plotPointProc,mcmcoutputpermfix-method} +\alias{plotSampRep,mcmcoutputpermfix-method} +\alias{plotPostDens,mcmcoutputpermfix-method} +\alias{plotTraces,mcmcoutputpermfixhier-method} +\alias{plotHist,mcmcoutputpermfixhier-method} +\alias{plotDens,mcmcoutputpermfixhier-method} +\alias{plotPostDens,mcmcoutputpermfixhier-method} +\alias{plotTraces,mcmcoutputpermfixhierpost-method} +\alias{plotHist,mcmcoutputpermfixhierpost-method} +\alias{plotDens,mcmcoutputpermfixhierpost-method} +\alias{plotPointProc,mcmcoutputpermfixhierpost-method} +\alias{plotSampRep,mcmcoutputpermfixhierpost-method} +\alias{plotPostDens,mcmcoutputpermfixhierpost-method} +\alias{plotTraces,mcmcoutputpermbase-method} +\alias{plotHist,mcmcoutputpermbase-method} +\alias{plotDens,mcmcoutputpermbase-method} +\alias{plotPointProc,mcmcoutputpermbase-method} +\alias{plotSampRep,mcmcoutputpermbase-method} +\alias{plotPostDens,mcmcoutputpermbase-method} +\alias{plotTraces,mcmcoutputpermhier-method} +\alias{plotHist,mcmcoutputpermhier-method} +\alias{plotDens,mcmcoutputpermhier-method} +\alias{plotPointProc,mcmcoutputpermhier-method} +\alias{plotSampRep,mcmcoutputpermhier-method} +\alias{plotPostDens,mcmcoutputpermhier-method} +\alias{plotTraces,mcmcoutputpermpost-method} +\alias{plotHist,mcmcoutputpermpost-method} +\alias{plotDens,mcmcoutputpermpost-method} +\alias{plotPointProc,mcmcoutputpermpost-method} +\alias{plotSampRep,mcmcoutputpermpost-method} +\alias{plotPostDens,mcmcoutputpermpost-method} +\alias{mcmcoutputpermhierpost-class} +\alias{.mcmcoutputpermhierpost} +\alias{plotTraces,mcmcoutputpermhierpost-method} +\alias{plotHist,mcmcoutputpermhierpost-method} +\alias{plotDens,mcmcoutputpermhierpost-method} +\alias{plotPointProc,mcmcoutputpermhierpost-method} +\alias{plotSampRep,mcmcoutputpermhierpost-method} +\alias{plotPostDens,mcmcoutputpermhierpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputpermfixhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputpermfixhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputpermbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputpermhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermhier}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermhier}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermhier}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermhier}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermhier}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputpermpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermpost}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermpost}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermpost}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermpost}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermpost}(x, dev = TRUE, ...) + +\S4method{plotTraces}{mcmcoutputpermhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Sampling represetnation of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point process of the MCMC samples. + +Sampliing representations of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point process of the MCMC samples. + +Sampling representation of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Posterior densities of the MCMC samples. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled component parameters +from MCMC sampling. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled component parameters +from MCMC sampling. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. If a hierarchical prior +has been used in sampling its parameters are plotted alongside the other +parameters. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mictures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the hierarchical +prior are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. In addition the parameters of the hierarchical prior are +plotted. + +Note, this method is so far only implemented for mictures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. In addition, the parameters of the hierarchical prior +are plotted. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. + +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components, the posterior +parameters, and the parameters of the hierarchical prior are plotted +together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. In addition the parameters of the hierarchical prior are +plotted. + +Note, this method is so far only implemented for mictures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. In addition, the parameters of the hierarchical prior +are plotted. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. +} +\section{Functions}{ +\itemize{ +\item \code{plotTraces,mcmcoutputpermfix-method}: + +\item \code{plotHist,mcmcoutputpermfix-method}: + +\item \code{plotDens,mcmcoutputpermfix-method}: + +\item \code{plotPointProc,mcmcoutputpermfix-method}: + +\item \code{plotSampRep,mcmcoutputpermfix-method}: + +\item \code{plotPostDens,mcmcoutputpermfix-method}: + +\item \code{plotTraces,mcmcoutputpermfixhier-method}: + +\item \code{plotHist,mcmcoutputpermfixhier-method}: + +\item \code{plotDens,mcmcoutputpermfixhier-method}: + +\item \code{plotPostDens,mcmcoutputpermfixhier-method}: + +\item \code{plotTraces,mcmcoutputpermfixhierpost-method}: + +\item \code{plotHist,mcmcoutputpermfixhierpost-method}: + +\item \code{plotDens,mcmcoutputpermfixhierpost-method}: + +\item \code{plotPointProc,mcmcoutputpermfixhierpost-method}: + +\item \code{plotSampRep,mcmcoutputpermfixhierpost-method}: + +\item \code{plotPostDens,mcmcoutputpermfixhierpost-method}: + +\item \code{plotTraces,mcmcoutputpermbase-method}: + +\item \code{plotHist,mcmcoutputpermbase-method}: + +\item \code{plotDens,mcmcoutputpermbase-method}: + +\item \code{plotPointProc,mcmcoutputpermbase-method}: + +\item \code{plotSampRep,mcmcoutputpermbase-method}: + +\item \code{plotPostDens,mcmcoutputpermbase-method}: + +\item \code{plotTraces,mcmcoutputpermhier-method}: Plots traces of MCMC samples + +\item \code{plotHist,mcmcoutputpermhier-method}: + +\item \code{plotDens,mcmcoutputpermhier-method}: + +\item \code{plotPointProc,mcmcoutputpermhier-method}: + +\item \code{plotSampRep,mcmcoutputpermhier-method}: + +\item \code{plotPostDens,mcmcoutputpermhier-method}: + +\item \code{plotTraces,mcmcoutputpermpost-method}: + +\item \code{plotHist,mcmcoutputpermpost-method}: Plots histograms of MCMC samples + +\item \code{plotDens,mcmcoutputpermpost-method}: Plots densities of MCMC samples + +\item \code{plotPointProc,mcmcoutputpermpost-method}: Plots point process of MCMC samples + +\item \code{plotSampRep,mcmcoutputpermpost-method}: Plots sampling representations of MCMC +samples + +\item \code{plotPostDens,mcmcoutputpermpost-method}: Plots posterior densities of component +parameters + +\item \code{mcmcoutputpermhierpost-class}: Finmix \code{mcmcoutputpermhierpost} class + +\item \code{plotTraces,mcmcoutputpermhierpost-method}: + +\item \code{plotHist,mcmcoutputpermhierpost-method}: + +\item \code{plotDens,mcmcoutputpermhierpost-method}: + +\item \code{plotPointProc,mcmcoutputpermhierpost-method}: + +\item \code{plotSampRep,mcmcoutputpermhierpost-method}: + +\item \code{plotPostDens,mcmcoutputpermhierpost-method}: +}} + +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} + +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class +\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} diff --git a/man/mcmcoutputpermbase-class.Rd b/man/mcmcoutputpermbase-class.Rd new file mode 100644 index 0000000..117b25e --- /dev/null +++ b/man/mcmcoutputpermbase-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\docType{class} +\name{mcmcoutputpermbase-class} +\alias{mcmcoutputpermbase-class} +\alias{.mcmcoutputpermbase} +\title{Finmix \code{mcmcoutputpermbase} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class +\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputpermfix-class.Rd b/man/mcmcoutputpermfix-class.Rd new file mode 100644 index 0000000..ad56d2c --- /dev/null +++ b/man/mcmcoutputpermfix-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\docType{class} +\name{mcmcoutputpermfix-class} +\alias{mcmcoutputpermfix-class} +\alias{.mcmcoutputpermfix} +\title{Finmix \code{mcmcoutputpermfix} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputfix} for the parent class +\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputpermfixhier-class.Rd b/man/mcmcoutputpermfixhier-class.Rd new file mode 100644 index 0000000..4f31bae --- /dev/null +++ b/man/mcmcoutputpermfixhier-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\docType{class} +\name{mcmcoutputpermfixhier-class} +\alias{mcmcoutputpermfixhier-class} +\alias{.mcmcoutputpermfixhier} +\title{Finmix \code{mcmcoutputpermfixhier} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note this class inherits all slots from its parent classes. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputperm_class]{mcmcoutputpermfix} for the parent class +\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputpermfixhierpost-class.Rd b/man/mcmcoutputpermfixhierpost-class.Rd new file mode 100644 index 0000000..b1e0524 --- /dev/null +++ b/man/mcmcoutputpermfixhierpost-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\docType{class} +\name{mcmcoutputpermfixhierpost-class} +\alias{mcmcoutputpermfixhierpost-class} +\alias{.mcmcoutputpermfixhierpost} +\title{Finmix \code{mcmcoutputpermfixhierpost} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note this class inherits all slots from its parent classes. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputfixhierpost} for the parent class +\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputpermfixpost-class.Rd b/man/mcmcoutputpermfixpost-class.Rd new file mode 100644 index 0000000..03b8ffc --- /dev/null +++ b/man/mcmcoutputpermfixpost-class.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\docType{class} +\name{mcmcoutputpermfixpost-class} +\alias{mcmcoutputpermfixpost-class} +\alias{.mcmcoutputpermfixpost} +\title{Finmix \code{mcmcoutput} class for fixed indicators and posterior parameters} +\description{ +This class defines the storage of parameters of the posterior distribution. +It inherits from the +} diff --git a/man/mcmcoutputpermhier-class.Rd b/man/mcmcoutputpermhier-class.Rd new file mode 100644 index 0000000..f2c8240 --- /dev/null +++ b/man/mcmcoutputpermhier-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\docType{class} +\name{mcmcoutputpermhier-class} +\alias{mcmcoutputpermhier-class} +\alias{.mcmcoutputpermhier} +\title{Finmix \code{mcmcoutputpermhier} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class +\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputpermpost-class.Rd b/man/mcmcoutputpermpost-class.Rd new file mode 100644 index 0000000..11a6451 --- /dev/null +++ b/man/mcmcoutputpermpost-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\docType{class} +\name{mcmcoutputpermpost-class} +\alias{mcmcoutputpermpost-class} +\alias{.mcmcoutputpermpost} +\title{Finmix \code{mcmcoutputpermpost} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class +\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputpost-class.Rd b/man/mcmcoutputpost-class.Rd new file mode 100644 index 0000000..3064772 --- /dev/null +++ b/man/mcmcoutputpost-class.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\docType{class} +\name{mcmcoutputpost-class} +\alias{mcmcoutputpost-class} +\alias{.mcmcoutputpost} +\title{Finmix \code{mcmcoutputpost} class} +\description{ +This class inherits from the \code{mcmcoutputbase} class and adds posterior +density parameters to the MCMC sampling output. The storage of posterior +parameters is controlled by the slot \code{storepost} in the \link[=mcmc_class]{mcmc} +class. If set to \code{TRUE} posterior parameters are stored in the output of the +MCMC sampling. +} +\section{Slots}{ + +\describe{ +\item{\code{post}}{A named list containing a named list \code{par} with arrays for the +posterior density parameters.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputbase} for the parent class +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling for finite mixture modeling +} +} diff --git a/man/mcmcperm_class.Rd b/man/mcmcperm_class.Rd new file mode 100644 index 0000000..f2ae693 --- /dev/null +++ b/man/mcmcperm_class.Rd @@ -0,0 +1,135 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfixpost.R, R/mcmcpermind.R, +% R/mcmcpermindhier.R, R/mcmcpermindpost.R +\docType{class} +\name{mcmcpermfixpost-class} +\alias{mcmcpermfixpost-class} +\alias{.mcmcpermfixpost} +\alias{mcmcpermind-class} +\alias{.mcmcpermind} +\alias{mcmcpermindhier-class} +\alias{.mcmcpermindhier} +\alias{mcmcpermindpost-class} +\alias{.mcmcpermindpost} +\title{Finmix \code{mcmcpermfixpost} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the posterior densities. + +Note that for models with fixed indicators \code{weight}s do not get permuted. + +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. All this slots are inherited from +the parent class \code{mcmcpermfix}. In addition to these slots this class adds +permuted weights, permuted indicators as well as the entropies and number +of assigned observations per component. + +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the hierarchical prior. + +Note that for models with fixed indicators \code{weight}s do not get permuted. + +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the posterior densities. +} +\section{Functions}{ +\itemize{ +\item \code{mcmcpermfixpost-class}: + +\item \code{mcmcpermind-class}: + +\item \code{mcmcpermindhier-class}: + +\item \code{mcmcpermindpost-class}: +}} + +\section{Slots}{ + +\describe{ +\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} + +\item{\code{relabel}}{A character defining the used algorithm for relabeling.} + +\item{\code{weightperm}}{An array of dimension \verb{Mperm x K} containing the +relabeled weight parameters.} + +\item{\code{entropyperm}}{An \code{array} of dimension \verb{Mperm x 1} containing the +entropy for each MCMC permuted draw.} + +\item{\code{STperm}}{An \code{array} of dimension \verb{Mperm x 1} containing all permuted +MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation.} + +\item{\code{Sperm}}{An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} + +\item{\code{NKperm}}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +of observations assigned to each component.} + +\item{\code{hyperperm}}{A named list containing the (permuted) parameters of the +hierarchical prior.} + +\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class definition +\item \link[=mcmcperm_class]{mcmcpermindpost} for the corresponding class for models with +unknown indicators +} + +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \link[=mcmcperm_class]{mcmcperfix} for the corresponding class for models with +fixed indicators +} + +\itemize{ +\item \code{\link{mcmcpermute()}} for the calling function +\item \code{\link{mcmcpermind}} for the parent class definition +\item \code{\link{mcmcpermfixhier}} for the corresponding class for models with +fixed indicators +} + +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \link[=mcmcperm_class]{mcmcpermind} for the parent class definition +\item \link[=mcmcperm_class]{mcmcpermfixpost} for the corresponding class for models +with fixed indicators +} +} diff --git a/man/mcmcpermfix-class.Rd b/man/mcmcpermfix-class.Rd new file mode 100644 index 0000000..37702d6 --- /dev/null +++ b/man/mcmcpermfix-class.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfix.R +\docType{class} +\name{mcmcpermfix-class} +\alias{mcmcpermfix-class} +\alias{.mcmcpermfix} +\title{Finmix \code{mcmcpermfix} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that for models with fixed indicators \code{weight}s do not get permuted. +} +\section{Slots}{ + +\describe{ +\item{\code{Mperm}}{An integer storing the MCMC sample size after relabeling.} + +\item{\code{parperm}}{A named list containing the permuted component parameters.} + +\item{\code{logperm}}{A named list containing the mixture log-likelihood, the prior +log-likelihood, and the complete data posterior log-likelihood.} +}} + +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute}} for the calling function +\item \code{\link{mcmcpermind}} for the corresponding class for models with +unknown indicators +} +} +\concept{mcmcperm-classes} diff --git a/man/mcmcpermfixhier-class.Rd b/man/mcmcpermfixhier-class.Rd new file mode 100644 index 0000000..5b38a57 --- /dev/null +++ b/man/mcmcpermfixhier-class.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfixhier.R +\docType{class} +\name{mcmcpermfixhier-class} +\alias{mcmcpermfixhier-class} +\alias{.mcmcpermfixhier} +\title{Finmix \code{mcmcpermfixhier} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the hierarchical prior. + +Note that for models with fixed indicators \code{weight}s do not get permuted. +} +\section{Slots}{ + +\describe{ +\item{\code{hyperperm}}{A named list containing the (permuted) parameters of the +hierarchical prior.} +}} + +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute()}} for the calling function +\item \code{\link{mcmcpermfix-class}} for the parent class definition +\item \code{\link{mcmcpermindhier-class}} for the corresponding class for models +with unknown indicators +} +} diff --git a/man/mcmcpermfixhier-methods.Rd b/man/mcmcpermfixhier-methods.Rd new file mode 100644 index 0000000..619e63c --- /dev/null +++ b/man/mcmcpermfixhier-methods.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfixhier.R +\docType{methods} +\name{getHyperperm,mcmcpermfixpost-method} +\alias{getHyperperm,mcmcpermfixpost-method} +\alias{mcmcpermfixhierpost_class,} +\alias{mcmcoutputpermfixhier_class,} +\alias{mcmcpermoutputpermfixhierpost_class} +\title{Getter method of \code{mcmcpermfixhier} class.} +\usage{ +\S4method{getHyperperm}{mcmcpermfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfixhier} object.} +} +\value{ +The \code{hyperperm} slot of the \code{object}. +} +\description{ +Returns the \code{hyperperm} slot. +} +\examples{ +\dontrun{getHyperpem(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \code{\link{mcmcoutputpermfix-class}} for the inheriting class +\item \code{\link{mcmcpermute}} for function permuting MCMC samples +} +} diff --git a/man/mcmcpermute.Rd b/man/mcmcpermute.Rd new file mode 100644 index 0000000..d6ce700 --- /dev/null +++ b/man/mcmcpermute.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermute.R +\name{mcmcpermute} +\alias{mcmcpermute} +\title{Permute MCMC samples} +\usage{ +mcmcpermute( + mcmcout, + fdata = NULL, + method = "kmeans", + opt_ctrl = list(max_iter = 200L) +) +} +\description{ +This function +} diff --git a/man/mcmcstart.Rd b/man/mcmcstart.Rd new file mode 100644 index 0000000..fdf1096 --- /dev/null +++ b/man/mcmcstart.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcstart.R +\name{mcmcstart} +\alias{mcmcstart} +\title{Finmix default starting values} +\usage{ +mcmcstart(fdata, model, varargin) +} +\arguments{ +\item{fdata}{An \code{fdata} object containing the data.} + +\item{model}{A \code{model} object specifying the finite mixture model to be +estimated.} + +\item{varargin}{Either \code{NULL} or an \code{mcmc} object defining (possibly +non-default) hyper-parameters. If not provided a default \code{mcmc} object is +created internally and returned.} +} +\value{ +A list containing the \code{fdata} object, the \code{model} object and an +\code{mcmc} object all set up for MCMC sampling. +} +\description{ +Calling \code{\link[=mcmcstart]{mcmcstart()}} creates starting values for MCMC sampling. Starting +values are constructed for the indicators in the \code{fdata} argument and the +parameters in the \code{model} argument. In addition an \code{mcmc} object can be +provided in the \code{varargin} argument to set up all slots consistently for a +non-default setting of hyper-parameters. + +To assing the returned objects directly to existing names the assignment +operator \verb{\%\%=\%\%} can be used together with a formula concatenating each name +with a tilde \code{~}. See the examples. +} +\examples{ +# Specify a Poisson model. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Set up all objects for MCMC sampling. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model) + +} +\seealso{ +\itemize{ +\item \link[=fdata_class]{fdata} for the definition of the \code{fdata} class +\item \link[=model_class]{model} for the definition of the \code{model} class +\item \link[=mcmc_class]{mcmc} for the definition of the \code{mcmc} class +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for the starting MCMC sampling +} +} diff --git a/man/mixturemar-model-method.Rd b/man/mixturemar-model-method.Rd new file mode 100644 index 0000000..013daba --- /dev/null +++ b/man/mixturemar-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{mixturemar,model-method} +\alias{mixturemar,model-method} +\title{Returns the marginal distribution.} +\usage{ +\S4method{mixturemar}{model}(object, J) +} +\arguments{ +\item{object}{An S4 model object with a multivariate distribution.} + +\item{J}{An integer specifying the dimension for which the marginal +distribution should be returned.} +} +\value{ +An S4 model object with the marginal distribution for dimension +\code{J}. +} +\description{ +\code{mixturemar} returns the marginal distribution of a multivariate +mixture distribution. This can only be applied on S4 model objects with +\code{dist="normult"} or \code{dist="studmult"}. +} +\examples{ +\dontrun{ +mar_model <- mixturemar(f_model, 1) +} + +} +\seealso{ +\code{model} +} diff --git a/man/mixturemcmc.Rd b/man/mixturemcmc.Rd new file mode 100644 index 0000000..0da0682 --- /dev/null +++ b/man/mixturemcmc.Rd @@ -0,0 +1,115 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mixturemcmc.R +\name{mixturemcmc} +\alias{mixturemcmc} +\title{Performs MCMC sampling for finite mixture models} +\usage{ +mixturemcmc(fdata, model, prior, mcmc) +} +\arguments{ +\item{fdata}{An \code{fdata} object storing the observations in slot \verb{@y} and +the (starting) indicators in slot \verb{@S}. If sampling should start by +sampling the parameters the starting indicators must be defined.} + +\item{model}{A \code{model} object specifying the finite mixture model. If it +should be started by sampling the indicators starting parameters and +weights must be defined in slots \verb{@par} and \verb{@weight} respectively.} + +\item{prior}{A \code{prior} object specifying the prior distribution for Bayesian +estimation. This object must be fully specified regardless, if sampling +should start with the indicators or parameters. See \code{\link[=priordefine]{priordefine()}} for +choosing automatically a data dependent prior distribution.} + +\item{mcmc}{An \code{mcmc} object storing the hyper-parameters for MCMC sampling. +If slot \verb{@startpar} is \code{TRUE} sampling starts by sampling the parameters. +Henceforth, it needs starting indicators.} +} +\value{ +An object of class \link[=mcmcoutput_class]{mcmcoutput} storing the MCMC +sampling results. +} +\description{ +Calling \code{\link[=mixturemcmc]{mixturemcmc()}} performs MCMC sampling on the observations stored +in the \code{fdata} object for the finite mixture model defined in the \code{model} +object. MCMC sampling is performed with a Gibbs sampler for all finite +mixture models using a prior that must be defined in the \code{prior} object. +There are possibilities to control the MCMC sampling by hyperparameters +stored in the \code{mcmc} object. +} +\details{ +\subsection{Performance}{ + +This function is the central part of the \code{finmix} package. For MCMC sampling +it relies on high-performance C++ code using the \code{Rcpp} and \code{RcppArmadillo} +packages. More specifically, these packages simplify the usage of external +C++ code on the objects in \code{R} memory (enabled by \code{R}'s \code{C} interface). +Execution of MCMC sampling with the default of 10,000 iterations and a +burn-in of 1,000 iterations should finish in a few seconds. +} + +\subsection{Algorithms}{ + +The algorithms used here are for the most part specified in the excellent +book \emph{Finite Mixture and Markov Switching Models} by +Sylvia Fr\"uwirth-Schnatter. These algorithms rely on Gibbs sampling by +alternating between sampling the component and weight parameters of the +finite mixture model and the indicators of the data. Thereby, a so-called +random permutation is performed at each iteration of the algorithm, i.e. the +indicators \code{S} and the component and weight parameters are permuted by their +index. As explained by Fr\"uwirth-Schnatter (2006, Section 3.5.5) label +switching in estimation of finite mixture distributions has to be addressed +explicitly when Bayesian estimation is used. While in maximum likelihood +estimation this is of no concern because only one of the equivalent modes of +likelihood function needs to be found, Bayesian estimation needs to explore +the full mixture posterior distribution and label switching occurs randomly, +but frequently during MCMC sampling. to overcome these issues the sampler is +forced to switch labels in a controlled form by randomly permuting the +labels of the components. This results in a balanced label switching and as +a result the sampler explores the full mixture posterior more thoroughly +leading to more robust estimations. +\subsection{Starting by sampling the parameters}{ + +As laid out in the description of the input parameters sampling can start +either by sampling the indicators using starting parameters or by sampling +the parameters using starting indicators. The latter is for example applied, +if indicators are fixed (because they might be known). For starting by +sampling the parameters the slot \verb{@startpar} in the \code{mcmc} input argument +must be set to \code{TRUE} (default) and starting indicators must be present in +slot \verb{@S} of the \code{fdata} object. +} + +} +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the sampled model parameters. +getPar(f_output) + +} +\references{ +Fr\"uwirth-Schnatter, S. (2006), "Finite Mixture Models and Markov Switching +Models", Springer +} +\seealso{ +\itemize{ +\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \link[=model_class]{model} for the \code{model} class definition +\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \code{\link[=prior]{prior()}} for the \code{prior} class constructor +\item \code{\link[=priordefine]{priordefine()}} for the advanced class constructor of the \code{prior} class +\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \code{\link[=mcmc]{mcmc()}} for the \code{mcmc} class constructor +\item \code{\link[=mcmcstart]{mcmcstart()}} for defining starting parameters and/or indicators +} +} diff --git a/man/model.Rd b/man/model.Rd index da23127..8c27ee2 100644 --- a/man/model.Rd +++ b/man/model.Rd @@ -1,254 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R \name{model} -\docType{class} - -\alias{class:model} \alias{model} +\title{Constructor for the S4 model class} +\usage{ +model( + dist = "poisson", + r, + K, + weight = matrix(), + par = list(), + indicmod = "multinomial", + indicfix = FALSE, + T = matrix() +) +} +\arguments{ +\item{dist}{A character, defining the distribution family. Possible choices +are \code{"binomial"}, \code{"exponential"}, \code{"normal"}, +\code{"normult"}, \code{"poisson"}, \code{"student"}, and \code{"studmult"}.} -%accessor -\alias{getDist, model-method} -\alias{setDist<-, model-method} -\alias{getR, model-method} -\alias{setR<-, model-method} -\alias{getWeight, model-method} -\alias{setWeight<-, model-method} -\alias{getPar, model-method} -\alias{setPar<-, model-method} -\alias{getIndicmod, model-method} -\alias{setIndicmod<-, model-method} -\alias{getIndicfix, model-method} -\alias{setIndicfix<-, model-method} -\alias{getT, model-method} -\alias{setT<-, model-method} +\item{r}{An integer. Defines the vector dimension of a model. Is one for all +univariate distributions and larger than one for \code{"normult"} and +\code{"studmult"}.} -% constructor -\alias{model} +\item{K}{An integer, defining the number of components in the finite mixture. +Must be larger or equal to one.} -% checking -\alias{hasWeight, model-method} -\alias{hasPar, model-method} -\alias{hasT, model-method} +\item{weight}{A matrix, containing the weights of the finite mixture model. +The matrix must have dimension \code{1 x K} and weights must add to one +and must all be larger or equal to zero.} -% show -\alias{show, model-method} +\item{par}{A list containing the parameter vectors for the finite mixture +distribution. The list can contain more than one named parameter vector. +Depending on the distribution parameters must be defined in the list as +follows: a \code{K}-dimensional vector of probabilities named \code{"p"} for +a \code{"binomial"} model, a \code{K}-dimensional vector of positive rates +named \code{"lambda"} for an \code{"exponential"} model, +\code{K}-dimensional vectors of means named \code{"mu"} and variances named +\code{sigma} for a \code{"normal"} model, a \code{r x K}-dimensional +matrix of means named \code{"mu"} and a \code{K x r x r} dimensional +array of variance-covariance matrices named \code{"sigma"} for a +\code{"normult"} model, a \code{K}-dimensional vector of rates named +\code{"rates"} for a \code{"poisson"} model, \code{K}-dimensional vectors of +means named \code{"mu"}, variances named \code{sigma}, and degrees of freedom +named \code{"df"} for a \code{"student"} model, a +\code{r x K}-dimensional matrix of means named \code{"mu"}, a +\code{K x r x r} dimensional array of variance-covariance matrices +named \code{"sigma"}, and a \code{K}-dimensional vector of degrees of freedom +for a \code{"studmult"} model.} -% plot -\alias{plot, model-method} -\alias{plotPointProc, model-method} +\item{indicmod}{A character defining the indicator model used. For now only +\code{"multinomial"} is implemented.} -% tools -\alias{mixturemar, model-method} +\item{indicfix}{A logical. If \code{TRUE} the indicators are given and +therefore fixed.} -\title{Finmix Model} -\description{ - The \code{model} class the model for a finite mixture distribution. +\item{T}{A matrix containing the repetitions in case of a \code{"binomial"} or +\code{"poisson"} model. Must be positive integers.} } - -\details{ - The \code{model} class is constructed by calling its constructor - \code{model()}. All arguments in the constructor are optional. +\value{ +An S4 \code{model} object. } - -\section{Constructor}{ - \describe{\code{model(dist = "poisson", r, K, weight = matrix(), - par = list(), indicmod = "multinomial", indicfix = TRUE, - T = matrix())}: - - Constructs a \code{model} object from the input arguments. All - arguments are optional. If provided, argument \code{T} must be - of type \code{matrix}. - - To construct an empty \code{model} object the constructor can be - without any argument provided: \code{model()}. - } +\description{ +\code{model} creates a finite mixture model with given parameters. } - -\section{Accessors}{ -In the following code snippets, \code{x} is an \code{model} object and the symbol -\code{@} represents a slot of this \code{S4} object. - \describe{ - \item{}{\code{getDist(x)}, \code{setDist(x)<-}: - Get and set the distribution of the mixture model in \code{@dist} - of \code{x}. The following - distributions are implemented: \code{"poisson"}, \code{"binomial"}, - \code{"exponential"}, \code{"normal"}, \code{"student"}, - \code{"normult"} (multivariate Normal) and \code{"studmult"} - (multivariate Student-t). Only models with the same distributions - are implemented. - } - \item{}{\code{getR(x)}, \code{setR(x)<-}: - Get and set the dimension of variables in \code{@r} of \code{x}. - The dimension of variables is stored as an \code{integer} and certain - safe guards check for consistency with the remaining slots of - \code{x}. For univariate distributions (\code{"poisson"}, - \code{"binomial"}, \code{"exponential"}, \code{"normal"}, - \code{"student"}) \code{@r} must be \code{1} and for multivariate - distributions (\code{"normult"}, \code{"studmult"}) \code{@r} - must be \code{>1}. - } - \item{}{\code{getK(x)}, \code{setK(x)<-}: - Get and set the number of components in \code{@K} of \code{x}. - The number of components must be a positive integer. - It is stored as an \code{integer} and certain safe guards check - for validity. - } - \item{}{\code{getWeight(x)}, \code{setWeight(x)<-}: - Get and set the weights of the finite mixture model in \code{@weight} - of \code{x}. The weights must be a \code{1 x @K} \code{matrix} of type - \code{numeric} all \code{<1} and \code{>0} and must sum to \code{1}. - Certain safe guards check for validity and consistency with the remaining - slots of \code{x}. - } - \item{}{\code{getPar(x)}, \code{setPar(x)<-}: - Get and set the component parameters of the finite mixture model - in \code{@par} of \code{x}. If the setter is called parameters - must be provided in a \code{list} with appropriate naming regarding - the distribution of the model in slot \code{@dist}. The following - naming rules apply: - \itemize{ - \item \code{"poisson"}: A \code{vector} of positive Poisson - parameters with name \code{$lambda} in the \code{list}. - \item \code{"binomial"}: A \code{vector} of positive Binomial - parameters with name \code{$p} in the \code{list}. All - parameters must be \code{>0} and \code{<1}. - \item \code{"exponential"}: A \code{vector} of positive - Exponential parameters with name \code{$lambda} in the - \code{list}. - \item \code{"normal"}: A \code{vector} of means with name - \code{$mu} in the \code{list} and a \code{vector} of - standard deviations with name \code{$sigma} in the \code{list}. - All standard deviations must be positive. - \item \code{"student"}: A \code{vector} of location parameters - with name \code{$mu} in the \code{list} and a \code{vector} - of scale parameters with name \code{$sigma} in the \code{list}. - All scale parameters must be positive. In addition the - degrees of freedom must be provided as a \code{vector} - with name \code{$df} in the \code{list}. - \item \code{"normult"}: An \code{array} or \code{matrix} of - dimension \code{@r x @K} containing the means for each dimension - and component named \code{$mu} in the \code{list}. - Further, an \code{array} of dimension \code{@r x @r x @K} - containing the variance-covariance matrices named \code{$sigma} - in the \code{list}. All matrices must be stored as a \code{matrix} - and must be positive-definite. - \item \code{"studmult"}: An \code{array} or \code{matrix} of - dimension \code{@r x @K} containing the location parameters - for each dimension and component named \code{$mu} in the \code{list}. - Further, an \code{array} of dimension \code{@r x @r x @K} - containing the scale matrices named \code{$sigma} - in the \code{list}. All matrices must be stored as a \code{matrix} - and must be positive-definite. In addition, degrees of freedom - must be provided as a \code{vector} with name \code{$df} in - the \code{list}. - } - } - \item{}{\code{getIndicmod(x)}, \code{setIndicmod(x)<-}: - Get and set the indicator model in \code{@indicmod} of \code{x}. - Each finite mixture model has an underlying model for its indicators. - Right now only the model \code{"multinomial"} is implemented. - } - \item{}{\code{getIndicfix(x)}, \code{setIndicfix(x)<-}: - Get and set the indicator for a model with fixed indicators in - \code{@indicfix} of \code{x}. A finite mixture model can have - predefined indicators, either because they are observed or - estimated by pre-sample classification. This indicator slot - is stored as \code{logical} and must be either \code{TRUE} in - case fixed indicators are provided in the \code{\link{fdata}} - or \code{FALSE} if otherwise. - } - \item{}{\code{getT(x)}, \code{setT(x)<-}: - Get and set the repetitions \code{matrix} in \code{@T} of \code{x}. - Repetitions are optional and become only relevant in case the - distribution in \code{@dist} is set to \code{"binomial"}. - Repetitions must be stored in a \code{matrix} in case the - setter is called. - } - } +\details{ +This is a constructor that creates a class object and guides the user in +regard to the different parameters needed to define a finite mixture model. } +\examples{ +f_model <- model(dist = "poisson", K = 2, par = list(lambda = c(0.17, 0.2))) -\section{Checking}{ - In the following code snippets, \code{x} is an \code{model} object and the symbol - \code{@} represents a slot of this \code{S4} object. - \describe{ - \item{}{\code{hasWeight(x, verbose = FALSE)}: - Checks wether \code{@weight} of \code{x} is empty. Returns \code{TRUE}, - if \code{@weight} contains a \code{matrix} with not all entries - \code{NA} and dimension \code{1 x @K}, otherwise it returns \code{FALSE}. - If \code{verbose} is set to \code{TRUE} an error is thrown in case of - \code{@weight} being empty or having a wrong dimension. - } - \item{}{\code{hasPar(x, verbose = FALSE)}: - Checks wether \code{@par} of \code{x} is empty. Returns \code{TRUE}, if - \code{@par} contains a \code{list} with length appropriately named - entries of correct dimension. See \code{\link{setPar}} for defining - correct parameters for a finite mixture model. In case \code{@par} - is either empty or incorrectly specified the function returns \code{FALSE}. - If \code{verbose} is set to \code{TRUE} an error is thrown in case of - \code{@par} being empty or incorrectly specified. - } - \item{}{\code{hasT(x, verbose = FALSE)}: - Checks wether \code{@T} of \code{x} is empty. Returns \code{TRUE}, if - \code{@T} contains \code{matrix} with not all entries \code{NA}, - otherwise it returns \code{FALSE}. If \code{verbose} is set to - \code{TRUE} an error is thrown in case of \code{@T} being empty. - } - } } - -\section{Plotting}{ - \describe{\code{plot(x, dev = TRUE)}: - - Plots a model as specified by \code{x}. - The following types of plots are returned in regard to \code{@dist}: - \itemize{ - \item \code{"poisson"}: A barplot of the probabilities - over the range between minimum and maximum of the Poisson mixture - distribution. - \item \code{"binomial"}: A line diagram of the probabilities over - the range between and minimum and maximum of the Binomial mixture - distribution. - \item \code{"exponential"}: An density plot over the range - between minimum and maximum of the Exponential mixture - distribution. - \item \code{"normal"}: A density plot over the range between minimum - and maximum of the Normal mixture distribution. - \item \code{"student"}: A density plot over the range between minimum - and maximum of the Student-t distribution. - \item \code{"normult"}: In case the dimension of variables in - \code{@r} is equal to \code{2} a perspective plot and a contour - plot of the bivariate density of the bivariate Normal mixture - is returned. In case \code{@r} is \code{>2} contour plots for - all possible marginal Normal mixture models of dimension \code{2} - are returned. - \item \code{"studmult"}: In case the dimension of variables in - \code{@r} is equal to \code{2} a perspective plot and a contour - plot of the bivariate density of the bivariate Student-t mixture - is returned. In case \code{@r} is \code{>2} contour plot for - all possible marginal Student-t mixture models of dimension \code{2} - are returned. - } - If argument \code{dev = FALSE} no graphical device is opened and the - user is able to store all plots to a file using \code{\link{pdf}}, - \code{\link{png}}, etc. - } - \describe{\code{plotPointProc(x, dev = TRUE, ...)}: - - Plots the point process representation for the mixture model specified by - \code{x}. The following type of plots are returned in regard to \code{@dist}: - \itemize{ - \item \code{"poisson"}: A point plot, indicating the position of the - components and their corresponding weights by points of certain - sizes. - } - } +\seealso{ +\itemize{ +\item \link[=model_class]{model} for the class definition } -\author{ Lars Simon Zehnder } -\examples{ - model.obj <- model(dist = "binomial", K = 2, indicfix = TRUE) - model.obj - setT(model.obj) <- as.matrix(as.integer(100)) - setPar(model.obj) <- list(p = c(.3, .7)) - setWeight(model.obj) <- matrix(c(.1, .9), nrow = 1, ncol = 2) - plot(model.obj) } -\keyword{classes} -\keyword{methods} diff --git a/man/model_class.Rd b/man/model_class.Rd new file mode 100644 index 0000000..fc65105 --- /dev/null +++ b/man/model_class.Rd @@ -0,0 +1,193 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/model.R +\name{simulate} +\alias{simulate} +\alias{plotPointProc} +\alias{hasWeight} +\alias{hasT} +\alias{hasPar} +\alias{mixturemar} +\alias{getDist} +\alias{getR} +\alias{getK} +\alias{getWeight} +\alias{getPar} +\alias{getIndicmod} +\alias{getIndicfix} +\alias{getT} +\alias{setDist<-} +\alias{setR<-} +\alias{setK<-} +\alias{setWeight<-} +\alias{setPar<-} +\alias{setIndicmod<-} +\alias{setIndicfix<-} +\alias{setT<-} +\alias{hasWeight,model-method} +\alias{simulate,model-method} +\alias{model_class} +\title{Getter for weights} +\usage{ +simulate(model, N = 100, varargin, seed = 0) + +plotPointProc(x, dev = TRUE, ...) + +hasWeight(object, verbose = FALSE) + +hasT(object, verbose = FALSE) + +hasPar(object, verbose = FALSE) + +mixturemar(object, J) + +getDist(object) + +getR(object) + +getK(object) + +getWeight(object) + +getPar(object) + +getIndicmod(object) + +getIndicfix(object) + +getT(object) + +setDist(object) <- value + +setR(object) <- value + +setK(object) <- value + +setWeight(object) <- value + +setPar(object) <- value + +setIndicmod(object) <- value + +setIndicfix(object) <- value + +setT(object) <- value + +\S4method{hasWeight}{model}(object, verbose = FALSE) + +\S4method{simulate}{model}(model, N = 100, varargin, seed = 0) + +\S4method{getDist}{model}(object) + +\S4method{getR}{model}(object) + +\S4method{getK}{model}(object) + +\S4method{getWeight}{model}(object) + +\S4method{getPar}{model}(object) + +\S4method{getIndicmod}{model}(object) + +\S4method{getIndicfix}{model}(object) + +\S4method{getT}{model}(object) + +\S4method{setDist}{model}(object) <- value + +\S4method{setR}{model}(object) <- value + +\S4method{setK}{model}(object) <- value + +\S4method{setWeight}{model}(object) <- value + +\S4method{setPar}{model}(object) <- value + +\S4method{setIndicmod}{model}(object) <- value + +\S4method{setIndicfix}{model}(object) <- value + +\S4method{setT}{model}(object) <- value +} +\arguments{ +\item{model}{An S4 model object with specified parameters and weights.} + +\item{N}{An integer specifying the number of values to be simulated.} + +\item{varargin}{An S4 fdata object with specified variable dimensions.} + +\item{seed}{An integer specifying the seed for the RNG. +\code{r} and repetitions \code{T}.} + +\item{verbose}{A logical indicating, if the function should give a print out.} +} +\value{ +Matrix of weights. + +An S4 fdata object holding the simulated values. +} +\description{ +\code{hasWeight} returns the weight matrix. + +\code{simulate} simulates values for a specified mixture model in an +S4 \code{model} object. +} +\section{Functions}{ +\itemize{ +\item \code{simulate}: Simulates data from mixture model + +\item \code{plotPointProc}: Plots point process of mixture model + +\item \code{hasWeight}: Checker for slot \code{weight} of model class + +\item \code{hasT}: Checker for slot \code{T} of model class + +\item \code{hasPar}: Checker for slot \code{par} of model class + +\item \code{mixturemar}: Extract marginal distribution + +\item \code{getDist}: Getter for slot \code{dist} of model class + +\item \code{getR}: Getter for slot \code{r} of model class + +\item \code{getK}: Getter for slot \code{K} of model class + +\item \code{getWeight}: Getter for slot \code{weight} of model class + +\item \code{getPar}: Getter for slot \code{par} of model class + +\item \code{getIndicmod}: Getter for slot \code{indicmod} of model class + +\item \code{getIndicfix}: Getter for slot \code{indicfix} of model class + +\item \code{getT}: Getter for slot \code{T} of model class + +\item \code{setDist<-}: Setter for slot \code{dist} of model class + +\item \code{setR<-}: Setter for slot \code{r} of model class + +\item \code{setK<-}: Setter for slot \code{K} of model class + +\item \code{setWeight<-}: Setter for slot \code{weight} of model class + +\item \code{setPar<-}: Setter for slot \code{par} of model class + +\item \code{setIndicmod<-}: Setter for slot \code{indicmod} of model class + +\item \code{setIndicfix<-}: Setter for slot \code{indicfix} of model class + +\item \code{setT<-}: Setter for slot \code{T} of model class + +\item \code{simulate,model-method}: Simulates data from a finite mixture model +}} + +\examples{ +\dontrun{ +weight <- hasWeight(model) +} +\dontrun{ +f_data <- simulate(model, 100) +} +} +\seealso{ +\code{model}, \code{fdata} +} diff --git a/man/modelmoments-class.Rd b/man/modelmoments-class.Rd new file mode 100644 index 0000000..98823bd --- /dev/null +++ b/man/modelmoments-class.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{getB,exponentialmodelmoments-method} +\alias{getB,exponentialmodelmoments-method} +\title{Getter method of \code{exponentialmodelmoments} class.} +\usage{ +\S4method{getB}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\section{Methods (by generic)}{ +\itemize{ +\item \code{getB}: Getter method for slot \code{B} +}} + +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getB(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} diff --git a/man/modelmoments.Rd b/man/modelmoments.Rd new file mode 100644 index 0000000..56d906d --- /dev/null +++ b/man/modelmoments.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelmoments.R +\name{modelmoments} +\alias{modelmoments} +\title{Constructor of finmix \code{modelmoments} class} +\usage{ +modelmoments(model) +} +\arguments{ +\item{model}{A \code{model} object containing defined parameters in slot \code{par} +and defined weights in slot \code{weight}.} +} +\value{ +A \code{modelmoments} object with calculated moments of the finite +mixture model defined in the \code{model} object. +} +\description{ +Calling \code{\link[=modelmoments]{modelmoments()}} calculates the corresponding moments of the +finite mixture distribution defined in the \code{model} object. The \code{model} +object should contain parameters in slot \code{par} and weights in slot \code{weight}. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +modelmoments(f_model) + +} +\seealso{ +\itemize{ +\item \link{modelmoments_class} for all slots of the \code{modelmoments} class +} +} diff --git a/man/modelmoments_class.Rd b/man/modelmoments_class.Rd new file mode 100644 index 0000000..47f0ca9 --- /dev/null +++ b/man/modelmoments_class.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelmoments.R +\docType{class} +\name{modelmoments_class} +\alias{modelmoments_class} +\alias{getMean,modelmoments-method} +\alias{getVar,modelmoments-method} +\alias{getModel,modelmoments-method} +\title{Finmix \code{modelmoments} class} +\usage{ +\S4method{getMean}{modelmoments}(object) + +\S4method{getVar}{modelmoments}(object) + +\S4method{getModel}{modelmoments}(object) +} +\arguments{ +\item{object}{A \code{modelmoments} object.} +} +\value{ +The \code{mean} slot of the \code{object}. + +The \code{var} slot of the \code{object}. + +The \code{model} slot of the \code{object}. +} +\description{ +Defines a container to hold the moments of a finite mixture model. The +finmix \code{model} object should contains parameters and weights. + +Returns the \code{mean} slot of a \code{modelmoments} object. + +Returns the \code{var} slot of a \code{modelmoments} object. + +Returns the \code{model} slot of a \code{modelmoments} object. +} +\section{Functions}{ +\itemize{ +\item \code{getMean,modelmoments-method}: + +\item \code{getVar,modelmoments-method}: + +\item \code{getModel,modelmoments-method}: +}} + +\section{Slots}{ + +\describe{ +\item{\code{mean}}{A vector of component means.} + +\item{\code{var}}{An array of components variances or in case of multivariate +distributions covariance matrices.} + +\item{\code{model}}{The corresponding \code{model} object.} +}} + +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getMean(f_moments) + +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getVar(f_moments) + +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getModel(f_moments) + +} +\seealso{ +\itemize{ +\item \code{\link[=modelmoments]{modelmoments()}} the constructor of the \code{modelmoments} class +} + +\link{modelmoments_class} for all slots of the \code{modelmoments} class + +\link{modelmoments_class} for all slots of the \code{modelmoments} class + +\link{modelmoments_class} for all slots of the \code{modelmoments} class +} diff --git a/man/moments-mcmcoutputfix-method.Rd b/man/moments-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..b711bfe --- /dev/null +++ b/man/moments-mcmcoutputfix-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{moments,mcmcoutputfix-method} +\alias{moments,mcmcoutputfix-method} +\title{Computes multivariate Normal sample moments} +\usage{ +\S4method{moments}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfix} object containing all data from MCMC +sampling.} +} +\value{ +The moments on the samples of a multivariate Normal mixture. +} +\description{ +Calling \code{\link[=moments]{moments()}} calculates the sample moments for the samples of a +multivariate Normal mixture model. +} diff --git a/man/moments_cc.Rd b/man/moments_cc.Rd new file mode 100644 index 0000000..a77a263 --- /dev/null +++ b/man/moments_cc.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{moments_cc} +\alias{moments_cc} +\title{Calculate moments on samples of multivariate mixture models} +\usage{ +moments_cc(classS4) +} +\arguments{ +\item{classS4}{An \code{mcmcoutput} class containing the MCMC samples.} +} +\value{ +A named list with vectors containing the data moments for each +iteration in the MCMC sample. +} +\description{ +This function calculates the moments for MCMC samples of multivariate +mixture models. Moments like means, standard deviations, kurtosis and +skewness are computed for each iteration in MCMC sampling. The moments are +used when plotting the traces of an MCMC sample output. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{mcmcoutput} for the \code{mcmcoutput} class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \link[=mcmcoutput_class]{plotTraces} for the calling function +} +} diff --git a/man/normalmodelmoments.Rd b/man/normalmodelmoments.Rd new file mode 100644 index 0000000..066cf85 --- /dev/null +++ b/man/normalmodelmoments.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\docType{class} +\name{normalmodelmoments} +\alias{normalmodelmoments} +\alias{.normalmodelmoments} +\title{Finmix \code{normalmodelmoments} class} +\description{ +Defines a class that holds theoretical moments for a finite mixture of +normal distributions. Note that this class is not directly used, but +indirectly when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments_class} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/normultmodelmoments.Rd b/man/normultmodelmoments.Rd new file mode 100644 index 0000000..1134a7f --- /dev/null +++ b/man/normultmodelmoments.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\docType{class} +\name{normultmodelmoments} +\alias{normultmodelmoments} +\alias{.normultmodelmoments} +\title{Finmix \code{normultmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of normult +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments_class} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/permmoments_cc.Rd b/man/permmoments_cc.Rd new file mode 100644 index 0000000..7fca092 --- /dev/null +++ b/man/permmoments_cc.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{permmoments_cc} +\alias{permmoments_cc} +\title{Calculate moments on permuted samples of multivariate mixture models} +\usage{ +permmoments_cc(classS4) +} +\arguments{ +\item{classS4}{An \code{mcmcoutputperm} class containing the re-labeled MCMC +samples.} +} +\value{ +A named list with vectors containing the data moments for each +iteration in the re-labeled MCMC sample. +} +\description{ +This function calculates the moments for re-labeled MCMC samples of +multivariate mixture models. Moments like means, standard deviations, +kurtosis and skewness are computed for each iteration in MCMC sampling. The +moments are used when plotting the traces of an MCMC sample output. +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputperm_class]{mcmcoutputperm} for the \code{mcmcoutput} class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for re-labeling MCMC samples +\item \link[=mcmcoutputperm_class]{plotTraces} for the calling function +} +} diff --git a/man/plot-model-ANY-method.Rd b/man/plot-model-ANY-method.Rd new file mode 100644 index 0000000..629d041 --- /dev/null +++ b/man/plot-model-ANY-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{plot,model,ANY-method} +\alias{plot,model,ANY-method} +\title{Plots a model.} +\usage{ +\S4method{plot}{model,ANY}(x, y, dev = TRUE, ...) +} +\arguments{ +\item{x}{An S4 model object. Must have specified parameters and weights.} + +\item{y}{Unused.} + +\item{dev}{A logical indicating, if the plot should be shown in a graphical +device. Set to \code{FALSE}, if plotted to a file.} +} +\value{ +Density or barplot of the S4 model object. +} +\description{ +\code{plot} plots the density or probabilities of a fully specified mixture +model. +} +\examples{ +\dontrun{ +plot(f_model) +} + +} +\seealso{ +\code{model} +} diff --git a/man/plotDens-mcmcoutputfixhierpost-method.Rd b/man/plotDens-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..4124676 --- /dev/null +++ b/man/plotDens-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotDens,mcmcoutputfixhierpost-method} +\alias{plotDens,mcmcoutputfixhierpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotDens-mcmcoutputhier-method.Rd b/man/plotDens-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..df80d9a --- /dev/null +++ b/man/plotDens-mcmcoutputhier-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{plotDens,mcmcoutputhier-method} +\alias{plotDens,mcmcoutputhier-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotDens-mcmcoutputpost-method.Rd b/man/plotDens-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..11faf8d --- /dev/null +++ b/man/plotDens-mcmcoutputpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{plotDens,mcmcoutputpost-method} +\alias{plotDens,mcmcoutputpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotHist-mcmcoutputhier-method.Rd b/man/plotHist-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..f7f8338 --- /dev/null +++ b/man/plotHist-mcmcoutputhier-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{plotHist,mcmcoutputhier-method} +\alias{plotHist,mcmcoutputhier-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotHist-mcmcoutputpost-method.Rd b/man/plotHist-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..8b09c64 --- /dev/null +++ b/man/plotHist-mcmcoutputpost-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{plotHist,mcmcoutputpost-method} +\alias{plotHist,mcmcoutputpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotPointProc-mcmcoutputfixhierpost-method.Rd b/man/plotPointProc-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..a9c5ca8 --- /dev/null +++ b/man/plotPointProc-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotPointProc,mcmcoutputfixhierpost-method} +\alias{plotPointProc,mcmcoutputfixhierpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this methid calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-mcmcoutputhier-method.Rd b/man/plotPointProc-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..1b057dd --- /dev/null +++ b/man/plotPointProc-mcmcoutputhier-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{plotPointProc,mcmcoutputhier-method} +\alias{plotPointProc,mcmcoutputhier-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-mcmcoutputhierpost-method.Rd b/man/plotPointProc-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..e405e50 --- /dev/null +++ b/man/plotPointProc-mcmcoutputhierpost-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{plotPointProc,mcmcoutputhierpost-method} +\alias{plotPointProc,mcmcoutputhierpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method calls the equivalent method of the parent class. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-mcmcoutputpermfixhier-method.Rd b/man/plotPointProc-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..76a7dd9 --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{plotPointProc,mcmcoutputpermfixhier-method} +\alias{plotPointProc,mcmcoutputpermfixhier-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is so far only implemented for mixture models of Poisson +or Binomial distributons. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-mcmcoutputpost-method.Rd b/man/plotPointProc-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..879ddcb --- /dev/null +++ b/man/plotPointProc-mcmcoutputpost-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{plotPointProc,mcmcoutputpost-method} +\alias{plotPointProc,mcmcoutputpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{ mcmcoutputpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-model-method.Rd b/man/plotPointProc-model-method.Rd new file mode 100644 index 0000000..c414a40 --- /dev/null +++ b/man/plotPointProc-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{plotPointProc,model-method} +\alias{plotPointProc,model-method} +\title{Plots point process.} +\usage{ +\S4method{plotPointProc}{model}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An S4 model object with defined parameters and weigths.} + +\item{dev}{A logical indicating, if the plot should be shown in a graphical +device. Set to \code{FALSE}, if plotted to a file.} + +\item{y}{Unused.} +} +\value{ +A scatter plot of weighted parameters. +} +\description{ +\code{plotPointProc} plots the point process of an S4 model object that +defines a finite mixture model. Only available for Poisson mixtures so far. +} +\examples{ +\dontrun{ +plotPointProc(f_model) +} + +} +\seealso{ +\code{model} +} diff --git a/man/plotPostDens-mcmcoutputfixhierpost-method.Rd b/man/plotPostDens-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..125114e --- /dev/null +++ b/man/plotPostDens-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotPostDens,mcmcoutputfixhierpost-method} +\alias{plotPostDens,mcmcoutputfixhierpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method calls the equivalent method of the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputfixhierpost-method.Rd b/man/plotSampRep-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..2695693 --- /dev/null +++ b/man/plotSampRep-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotSampRep,mcmcoutputfixhierpost-method} +\alias{plotSampRep,mcmcoutputfixhierpost-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method calls the equivalent method of the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputhier-method.Rd b/man/plotSampRep-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..dd4fbaa --- /dev/null +++ b/man/plotSampRep-mcmcoutputhier-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{plotSampRep,mcmcoutputhier-method} +\alias{plotSampRep,mcmcoutputhier-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputhierpost-method.Rd b/man/plotSampRep-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..7b00d7a --- /dev/null +++ b/man/plotSampRep-mcmcoutputhierpost-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{plotSampRep,mcmcoutputhierpost-method} +\alias{plotSampRep,mcmcoutputhierpost-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method calls the equivalent method from the parent class. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputpermfixhier-method.Rd b/man/plotSampRep-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..dfc4f8d --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{plotSampRep,mcmcoutputpermfixhier-method} +\alias{plotSampRep,mcmcoutputpermfixhier-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputpost-method.Rd b/man/plotSampRep-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..8532ab0 --- /dev/null +++ b/man/plotSampRep-mcmcoutputpost-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{plotSampRep,mcmcoutputpost-method} +\alias{plotSampRep,mcmcoutputpost-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{ mcmcoutputpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotTraces-mcmcoutputfixhierpost-method.Rd b/man/plotTraces-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..9502e72 --- /dev/null +++ b/man/plotTraces-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotTraces,mcmcoutputfixhierpost-method} +\alias{plotTraces,mcmcoutputfixhierpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputfixhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. If \code{lik} is set to \code{0} the parameters of the components and the +posterior parameters are plotted together with \code{K-1} weights. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotTraces-mcmcoutputhier-method.Rd b/man/plotTraces-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..b108364 --- /dev/null +++ b/man/plotTraces-mcmcoutputhier-method.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{plotTraces,mcmcoutputhier-method} +\alias{plotTraces,mcmcoutputhier-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotTraces-mcmcoutputpost-method.Rd b/man/plotTraces-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..8d2553b --- /dev/null +++ b/man/plotTraces-mcmcoutputpost-method.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{plotTraces,mcmcoutputpost-method} +\alias{plotTraces,mcmcoutputpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/poissonmodelmoments.Rd b/man/poissonmodelmoments.Rd new file mode 100644 index 0000000..6527d51 --- /dev/null +++ b/man/poissonmodelmoments.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poissonmodelmoments.R +\docType{class} +\name{poissonmodelmoments} +\alias{poissonmodelmoments} +\alias{.poissonmodelmoments} +\title{Finmix \code{poissonmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of poisson +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments_class} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/prior-class.Rd b/man/prior-class.Rd new file mode 100644 index 0000000..c90ca92 --- /dev/null +++ b/man/prior-class.Rd @@ -0,0 +1,99 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\docType{class} +\name{prior-class} +\alias{prior-class} +\alias{.prior} +\alias{hasPriorPar,prior,model-method} +\alias{hasPriorWeight,prior,model-method} +\title{Finmix \code{prior} class} +\usage{ +\S4method{hasPriorPar}{prior,model}(object, model, verbose = FALSE) + +\S4method{hasPriorWeight}{prior,model}(object, model, verbose = FALSE) +} +\arguments{ +\item{object}{A \code{prior} object containing the specifications for the prior.} + +\item{model}{A \code{model} object containing the specifications for the model.} + +\item{verbose}{A logical indicating, if the output should be verbose.} +} +\description{ +The \code{prior} class stores the specifications for the prior distribution used +for Bayesian estimation of the finite mixture parameters and weights. There +exists next to the general constructor also an advanced constructor that +specifies a data dependent prior. See \code{\link[=priordefine]{priordefine()}} for this advanced +constructor. + +Calling \code{\link[=hasPriorPar]{hasPriorPar()}} checks if \code{model}-appropriate parameters are stored +in the \code{prior} object. + +Calling \code{\link[=hasPriorWeight]{hasPriorWeight()}} checks if \code{model}-appropriate weight parameters +are stored in the \code{prior} object. +} +\section{Functions}{ +\itemize{ +\item \code{hasPriorPar,prior,model-method}: Checks for parameters in \code{prior} object + +\item \code{hasPriorWeight,prior,model-method}: Checks for prior weights in \code{prior} object +}} + +\section{Slots}{ + +\describe{ +\item{\code{weight}}{A matrix storing the prior parameters for the \code{weight} of a +finite mixture model.} + +\item{\code{par}}{A list storing the prior parameters for the parameters of a finite +mixture model.} + +\item{\code{type}}{A character specifying what type of prior should be used in +Bayesian estimation. Either \code{"independent"} for an independent prior +distribution or \code{"condconjugate"} for a conditionally conjugate prior +distribution.} + +\item{\code{hier}}{A logical defining, if the used prior should be hierarchical. +Hierarchical prior are often more robust, but need an additional layer in +sampling, so computing costs increase.} +}} + +\examples{ +# Define a Poisson mixture model. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Call the default constructor. +f_prior <- prior() +# Check if the prior has appropriate parameters defined. +hasPriorPar(f_prior) +hasPriorPar(f_prior, TRUE) + +# Define a Poisson mixture model. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Call the default constructor. +f_prior <- prior() +# Check if the prior has appropriate parameters defined. +hasPriorWeight(f_prior) +hasPriorWeight(f_prior, TRUE) + +} +\references{ +\itemize{ +\item Frühwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" +} +} +\seealso{ +\itemize{ +\item \code{\link{prior}} for the general constructor of this class +\item \code{\link{priordefine}} for the advanced constructor of this class +} + +\itemize{ +\item \link[=prior-class]{prior} for the definition of the \code{prior} class +\item \link[=model_class]{model} for the definition of the \code{model} class +} + +\itemize{ +\item \link[=prior-class]{prior} for the definition of the \code{prior} class +\item \link[=model_class]{model} for the definition of the \code{model} class +} +} diff --git a/man/prior.Rd b/man/prior.Rd new file mode 100644 index 0000000..4e9c475 --- /dev/null +++ b/man/prior.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{prior} +\alias{prior} +\title{Constructor for \code{prior} class} +\usage{ +prior( + weight = matrix(), + par = list(), + type = c("independent", "condconjugate"), + hier = TRUE +) +} +\description{ +Calling \code{\link[=prior]{prior()}} constructs an object of class \link[=prior-class]{prior}. The +constructor can be called without providing any arguments, but the prior +has to be filled with appropriate parameters when MCMC sampling should be +performed. + +There exists next to the general constructor also an advanced constructor +that specifies a data dependent prior. See \code{\link[=priordefine]{priordefine()}} for this advanced +constructor. +} +\section{Slots}{ + +\describe{ +\item{\code{weight}}{A matrix storing the prior parameters for the \code{weight} of a +finite mixture model.} + +\item{\code{par}}{A list storing the prior parameters for the parameters of a finite +mixture model.} + +\item{\code{type}}{A character specifying what type of prior should be used in +Bayesian estimation. Either \code{"independent"} for an independent prior +distribution or \code{"condconjugate"} for a conditionally conjugate prior +distribution.} + +\item{\code{hier}}{A logical defining, if the used prior should be hierarchical. +Hierarchical prior are often more robust, but need an additional layer in +sampling, so computing costs increase.} +}} + +\examples{ +# Call the default constructor without any arguments. +f_prior <- prior() + +} +\references{ +\itemize{ +\item Fr\"uhwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" +} +} +\seealso{ +\itemize{ +\item \code{\link[=prior]{prior()}} for the general constructor of this class +\item \code{\link[=priordefine]{priordefine()}} for the advanced constructor of this class +} +} diff --git a/man/priordefine.Rd b/man/priordefine.Rd new file mode 100644 index 0000000..384b150 --- /dev/null +++ b/man/priordefine.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{priordefine} +\alias{priordefine} +\title{Advanced constructor for the \code{prior} class} +\usage{ +priordefine( + fdata = fdata(), + model = model(), + varargin = NULL, + prior.wagner = TRUE, + s = 5 +) +} +\arguments{ +\item{fdata}{An \code{fdata} object holding the data. Observations in slot \verb{@y} +must be existent.} + +\item{model}{A \code{model} object specifying the finite mixture model.} + +\item{varargin}{\code{NULL} or a \code{prior} object. This enables the user to pass in +an already constructed prior object that gets then completed.} + +\item{prior.wagner}{A logical indicating, if the prior from Wagner (2007) +should be used in case of an exponential mixture model.} + +\item{s}{A numeric specifying the standard deviation \code{s} for the +Metropolis-Hastings proposal.} +} +\value{ +A fully specified \code{prior} object. +} +\description{ +This constructor defines a data dependent prior with parameters by matching +moments. As a consequence it needs as inputs an \code{fdata} object and a \code{model} +object. The prior distributions chosen and the methods how parameters are +computed are described in Frühwirth-Schnatter (2006). +} +\examples{ +# Create a Poisson mixture model. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Use the advanced constructor to generate a prior. +f_prior <- priordefine(f_data, f_model) + +} +\references{ +\itemize{ +\item Fr\"uwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching +Models" +\item Wagner, H. (2007), "Bayesian analysis of mixtures of exponentials", +Journal of Applied Mathematics, Statistics and Informatics 3, 165-183 +} +} +\seealso{ +\itemize{ +\item \link[=prior-class]{prior} for the class definition +\item \code{\link[=prior]{prior()}} for the default constructor of the class +} +} diff --git a/man/qincol.Rd b/man/qincol.Rd new file mode 100644 index 0000000..0e88e4f --- /dev/null +++ b/man/qincol.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mincol.R +\name{qincol} +\alias{qincol} +\title{Convert a symmetric matrix into a vector} +\usage{ +qincol(m) +} +\arguments{ +\item{q}{A symmetric matrix or dimension \code{rxr}.} +} +\value{ +A vector of length \code{r(r+1)/2}. +} +\description{ +Calling \code{\link[=qincol]{qincol()}} on a symmetric matrix with dimension \code{rxr} converts +this matrix a vector of length \code{r(r+1)/2}. This function is used to +handle the MCMC sampling output from multivariate finite mixture models. To +save storage the symmetric variance-covariance matrices of multivariate +mixtures are stored vector form. If the covariance matrices are needed for +calculations the functions \code{\link[=qinmatr]{qinmatr()}} and \code{\link[=qinmatrmult]{qinmatrmult()}} helps to restore +these matrices from the storage vectors. +} +\examples{ +# Define a vector. +q <- rnorm(n = 6, mean = 0.5, sd = 2) +# Generate the symmetric matrix. +mat <- qinmatr(q) +# Convert the matrix back into the vector. +qincol(mat) + +} +\seealso{ +\itemize{ +\item \code{\link[=qinmatr]{qinmatr()}} for converting a single vector into a symmetric matrix +\item \code{\link[=qinmatrmult]{qinmatrmult()}} for converting multiple vectors into symmetric matrices +\item \code{\link[=qincolmult]{qincolmult()}} for converting multiple symmetric matrice into vectors +} +} diff --git a/man/qincolmult.Rd b/man/qincolmult.Rd new file mode 100644 index 0000000..d607222 --- /dev/null +++ b/man/qincolmult.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mincol.R +\name{qincolmult} +\alias{qincolmult} +\title{Convert multiple symmetric matrices into vectors} +\usage{ +qincolmult(a) +} +\arguments{ +\item{q}{A symmetric matrix or dimension \code{rxr}.} +} +\value{ +A vector of length \code{r(r+1)/2}. +} +\description{ +Calling \code{\link[=qincolmult]{qincolmult()}} on an array of symmetric matrices all with dimension +\code{rxr} converts these matrices into an array of vectors with length +\code{r(r+1)/2}. This function is used to handle the MCMC sampling output from +multivariate finite mixture models. To save storage the symmetric +variance-covariance matrices of multivariate mixtures are stored vector +form. If the covariance matrices are needed for calculations the functions +\code{\link[=qinmatr]{qinmatr()}} and \code{\link[=qinmatrmult]{qinmatrmult()}} helps to restore these matrices from the +storage vectors. +} +\examples{ +# Convert a matrix of vectors +matrices <- qinmatrmult(matrix(rnorm(36), nrow = 6)) +# Convert these matrices back into vectors. +qincolmult(matrices) + +} +\seealso{ +\itemize{ +\item \code{\link[=qinmatr]{qinmatr()}} for converting a single vector into a symmetric matrix +\item \code{\link[=qinmatrmult]{qinmatrmult()}} for converting multiple vectors into symmetric matrices +\item \code{\link[=qincol]{qincol()}} for converting a single symmetric matrix into a vector +} +} diff --git a/man/qinmatr.Rd b/man/qinmatr.Rd new file mode 100644 index 0000000..77a3b66 --- /dev/null +++ b/man/qinmatr.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mincol.R +\name{qinmatr} +\alias{qinmatr} +\title{Convert vector into matrix.} +\usage{ +qinmatr(q) +} +\arguments{ +\item{q}{A vector of dimension \verb{r(r+1)/2x1}.} +} +\value{ +A symmetric matrix of dimension \code{rxr}. +} +\description{ +Calling \code{\link[=qinmatr]{qinmatr()}} on a vector of dimension \verb{r(r+1)/2x1} +converts the vector into a symmetric matrix of dimension \code{rxr}. This +function is used to handle the MCMC sampling output from multivariate finite +mixture models. To save storage the symmetric variance-covariance matrices +of multivariate mixtures are stored vector form. If the covariance matrices +are needed for calculations this function helps to restore these matrices +from the storage vectors. +} +\examples{ +# Define a vector. +q <- rnorm(n = 6, mean = 0.5, sd = 2) +# Generate the symmetric matrix. +qinmatr(q) + +} +\seealso{ +\itemize{ +\item \code{\link[=qinmatrmult]{qinmatrmult()}} +\item \code{\link[=qincol]{qincol()}} +\item \code{\link[=qincolmult]{qincolmult()}} +} +} diff --git a/man/qinmatrmult.Rd b/man/qinmatrmult.Rd new file mode 100644 index 0000000..ee23a21 --- /dev/null +++ b/man/qinmatrmult.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mincol.R +\name{qinmatrmult} +\alias{qinmatrmult} +\title{Convert array of vectors into array of matrices.} +\usage{ +qinmatrmult(m) +} +\arguments{ +\item{q}{A matrix or array of vectors of dimension \verb{r(r+1)/2x1}.} +} +\value{ +An array of symmetric matrices, all of dimension \code{rxr}. +} +\description{ +Calling \code{\link[=qinmatrmult]{qinmatrmult()}} on multiple vectors of dimension \verb{r(r+1)/2x1} +converts these vectors into an array of symmetric matrices of dimension +\code{rxr}. This function is used to handle the MCMC sampling output from +multivariate finite mixture models. To save storage the symmetric +variance-covariance matrices of multivariate mixtures are stored vector +form. If the covariance matrices are needed for calculations this function +helps to restore these matrices from the storage vectors. +} +\examples{ +# Convert a matrix of vectors +qinmatrmult(matrix(rnorm(36), nrow = 6)) + +} +\seealso{ +\itemize{ +\item \code{\link[=qinmatr]{qinmatr()}} for converting a single vector into a symmetric matrix +\item \code{\link[=qincol]{qincol()}} for converting a symmetric matrix into a vector +\item \code{\link[=qincolmult]{qincolmult()}} for converting an array of symmetric matrices into vectors +} +} diff --git a/man/sdatamoments.Rd b/man/sdatamoments.Rd new file mode 100644 index 0000000..6bb5fdf --- /dev/null +++ b/man/sdatamoments.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\name{sdatamoments} +\alias{sdatamoments} +\title{Finmix \code{sdatamoments} constructor} +\usage{ +sdatamoments(value = fdata()) +} +\arguments{ +\item{value}{An \link[=fdata_class]{fdata} object containing the indicators for +which moments should be calculated.} +} +\value{ +If slot \code{type} of the argument \code{value} is \code{"discrete"} an +\code{sdatamoments} object is returned and if the slot is \code{"continuous"}, +a \code{csdatamoments} object is returned. +} +\description{ +Calling \code{\link[=sdatamoments]{sdatamoments()}} constructs an object of class \code{sdatamoments} or +\code{csdatamoments} depending on the \code{type} slot of the argument \code{value}. If +this slot is \code{"discrete"} an \code{sdatamoments} object is returned and if the +slot is \code{"continuous"}, a \code{csdatamoments} object is returned. +} +\seealso{ +\itemize{ +\item \link[=sdatamoments_class]{sdatamoments} for the class of indicator +moments for discrete data +\item \link[=csdatamoments_class]{csdatamoments} for the class of indicator moments +for continuous +\item \link[=groupmoments_class]{groupmoments} for the parent class## Copyright (C) 2013 Lars Simon Zehnder +} +} diff --git a/man/sdatamomentsOrNULL-class.Rd b/man/sdatamomentsOrNULL-class.Rd new file mode 100644 index 0000000..2d2656b --- /dev/null +++ b/man/sdatamomentsOrNULL-class.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\docType{class} +\name{sdatamomentsOrNULL-class} +\alias{sdatamomentsOrNULL-class} +\title{Finmix class union of \code{sdatamoments} and \code{NULL}} +\description{ +Defines a class union such that the object held by a child class can also +be \code{NULL}. +} +\keyword{internal} diff --git a/man/sdatamoments_class.Rd b/man/sdatamoments_class.Rd new file mode 100644 index 0000000..def9d12 --- /dev/null +++ b/man/sdatamoments_class.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\docType{class} +\name{sdatamoments_class} +\alias{sdatamoments_class} +\alias{.sdatamoments} +\alias{show,sdatamoments-method} +\title{Finmix \code{sdatamoments} class} +\usage{ +\S4method{show}{sdatamoments}(object) +} +\arguments{ +\item{object}{An \code{sdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Stores moments for indicators of discrete data. + +Calling \code{\link[=show]{show()}} on an \code{sdatamoments} object gives an overview +of the moments of a finite mixture with discrete data. +} +\section{Functions}{ +\itemize{ +\item \code{show,sdatamoments-method}: Shows a summary of an object +}} + +\section{Slots}{ + +\describe{ +\item{\code{gmoments}}{A \link[=groupmoments_class]{groupmoments} object storing the +moments for each mixture component.} + +\item{\code{fdata}}{An \link[=fdata_class]{fdata} object with data from a discrete valued +mixture distribution.} +}} + +\seealso{ +\itemize{ +\item \link[=datamoments_class]{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +\item \link[=groupmoments_class]{groupmoments} for the parent class +\item \link[=csdatamoments_class]{csdatamoments} for the corresponding class defining +moments for data from a continuous-valued finite mixture +} +} diff --git a/man/show-cdatamoments-method.Rd b/man/show-cdatamoments-method.Rd new file mode 100644 index 0000000..125f4de --- /dev/null +++ b/man/show-cdatamoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{show,cdatamoments-method} +\alias{show,cdatamoments-method} +\title{Shows a summary of a \code{cdatamoments} object.} +\usage{ +\S4method{show}{cdatamoments}(object) +} +\arguments{ +\item{object}{A \code{cdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{cdatamoments} object gives an overview +of the moments of a finit mixture with continuous data. +} diff --git a/man/show-csdatamoments-method.Rd b/man/show-csdatamoments-method.Rd new file mode 100644 index 0000000..e2f8ba0 --- /dev/null +++ b/man/show-csdatamoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{show,csdatamoments-method} +\alias{show,csdatamoments-method} +\title{Shows a summary of an \code{csdatamoments} object.} +\usage{ +\S4method{show}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{csdatamoments} object gives an overview +of the moments of a finite mixture with continuous data. +} diff --git a/man/show-dataclass-method.Rd b/man/show-dataclass-method.Rd new file mode 100644 index 0000000..78b123a --- /dev/null +++ b/man/show-dataclass-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{show,dataclass-method} +\alias{show,dataclass-method} +\title{Shows a summary of a \code{dataclass} object.} +\usage{ +\S4method{show}{dataclass}(object) +} +\arguments{ +\item{object}{A \code{dataclass} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{dataclass} object gives an overview +of the slots of this class. +} diff --git a/man/show-ddatamoments-method.Rd b/man/show-ddatamoments-method.Rd new file mode 100644 index 0000000..5fa0bb7 --- /dev/null +++ b/man/show-ddatamoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{show,ddatamoments-method} +\alias{show,ddatamoments-method} +\title{Shows a summary of a \code{ddatamoments} object.} +\usage{ +\S4method{show}{ddatamoments}(object) +} +\arguments{ +\item{object}{A \code{ddatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{ddatamoments} object gives an overview +of the moments of a finit mixture with continuous data. +} diff --git a/man/show-exponentialmodelmoments-method.Rd b/man/show-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..e2f336e --- /dev/null +++ b/man/show-exponentialmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{show,exponentialmodelmoments-method} +\alias{show,exponentialmodelmoments-method} +\title{Shows a summary of an \code{exponentialmodelmoments} object.} +\usage{ +\S4method{show}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{exponentialmodelmoments} object gives an overview +of the moments of an exponential finite mixture. +} diff --git a/man/show-groupmoments-method.Rd b/man/show-groupmoments-method.Rd new file mode 100644 index 0000000..5dcef81 --- /dev/null +++ b/man/show-groupmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{show,groupmoments-method} +\alias{show,groupmoments-method} +\title{Shows a summary of a \code{groupmoments} object.} +\usage{ +\S4method{show}{groupmoments}(object) +} +\arguments{ +\item{object}{A \code{groupmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{groupmoments} object gives an overview +of the moments of a finit mixture with continuous data. +} diff --git a/man/show-mcmc-method.Rd b/man/show-mcmc-method.Rd new file mode 100644 index 0000000..cb3015f --- /dev/null +++ b/man/show-mcmc-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{show,mcmc-method} +\alias{show,mcmc-method} +\title{Shows a summary of an \code{mcmc} object.} +\usage{ +\S4method{show}{mcmc}(object) +} +\arguments{ +\item{object}{A \code{mcmc} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmc} object gives an overview +of the \code{mcmc} object. +} diff --git a/man/show-mcmcestfix-method.Rd b/man/show-mcmcestfix-method.Rd new file mode 100644 index 0000000..5d443ac --- /dev/null +++ b/man/show-mcmcestfix-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{show,mcmcestfix-method} +\alias{show,mcmcestfix-method} +\title{Shows a summary of an \code{mcmcestfix} object.} +\usage{ +\S4method{show}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcestfix} object gives an overview +of the \code{mcmcestfix} object. +} diff --git a/man/show-mcmcestind-method.Rd b/man/show-mcmcestind-method.Rd new file mode 100644 index 0000000..879b374 --- /dev/null +++ b/man/show-mcmcestind-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestind.R +\name{show,mcmcestind-method} +\alias{show,mcmcestind-method} +\title{Shows a summary of an \code{mcmcestind} object.} +\usage{ +\S4method{show}{mcmcestind}(object) +} +\arguments{ +\item{object}{An \code{mcmcestind} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcestind} object gives an overview +of the \code{mcmcestind} object. +} diff --git a/man/show-mcmcoutputbase-method.Rd b/man/show-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..fe2c19f --- /dev/null +++ b/man/show-mcmcoutputbase-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{show,mcmcoutputbase-method} +\alias{show,mcmcoutputbase-method} +\title{Shows a summary of an \code{mcmcoutputbase} object.} +\usage{ +\S4method{show}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputbase} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputbase} object gives an overview +of the \code{mcmcoutputbase} object. +} diff --git a/man/show-mcmcoutputfix-method.Rd b/man/show-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..08b00a3 --- /dev/null +++ b/man/show-mcmcoutputfix-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{show,mcmcoutputfix-method} +\alias{show,mcmcoutputfix-method} +\title{Shows a summary of an \code{mcmcoutputfix} object.} +\usage{ +\S4method{show}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfix} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfix} object gives an overview +of the \code{mcmcoutputfix} object. +} diff --git a/man/show-mcmcoutputfixhier-method.Rd b/man/show-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..72ce4cf --- /dev/null +++ b/man/show-mcmcoutputfixhier-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{show,mcmcoutputfixhier-method} +\alias{show,mcmcoutputfixhier-method} +\title{Shows a summary of an \code{mcmcoutputfixhier} object.} +\usage{ +\S4method{show}{mcmcoutputfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixhier} object gives an overview +of the \code{mcmcoutputfixhier} object. +} diff --git a/man/show-mcmcoutputfixhierpost-method.Rd b/man/show-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..1f7eb0a --- /dev/null +++ b/man/show-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{show,mcmcoutputfixhierpost-method} +\alias{show,mcmcoutputfixhierpost-method} +\title{Shows a summary of an \code{mcmcoutputfixhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputfixhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixhierpost} object gives an overview +of the \code{mcmcoutputfixhierpost} object. +} diff --git a/man/show-mcmcoutputfixpost-method.Rd b/man/show-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..f5c2fb4 --- /dev/null +++ b/man/show-mcmcoutputfixpost-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{show,mcmcoutputfixpost-method} +\alias{show,mcmcoutputfixpost-method} +\title{Shows a summary of an \code{mcmcoutputfixpost} object.} +\usage{ +\S4method{show}{mcmcoutputfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixpost} object gives an overview +of the \code{mcmcoutputfixpost} object. +} diff --git a/man/show-mcmcoutputhier-method.Rd b/man/show-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..b29008c --- /dev/null +++ b/man/show-mcmcoutputhier-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{show,mcmcoutputhier-method} +\alias{show,mcmcoutputhier-method} +\title{Shows a summary of an \code{mcmcoutputhier} object.} +\usage{ +\S4method{show}{mcmcoutputhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputhier} object gives an overview +of the \code{mcmcoutputhier} object. +} diff --git a/man/show-mcmcoutputpermbase-method.Rd b/man/show-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..82e348b --- /dev/null +++ b/man/show-mcmcoutputpermbase-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{show,mcmcoutputpermbase-method} +\alias{show,mcmcoutputpermbase-method} +\title{Shows a summary of an \code{mcmcoutputpermbase} object.} +\usage{ +\S4method{show}{mcmcoutputpermbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermbase} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermbase} object gives an overview +of the \code{mcmcoutputpermbase} object. +} diff --git a/man/show-mcmcoutputpermfix-method.Rd b/man/show-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..423648b --- /dev/null +++ b/man/show-mcmcoutputpermfix-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{show,mcmcoutputpermfix-method} +\alias{show,mcmcoutputpermfix-method} +\title{Shows a summary of an \code{mcmcoutputpermfix} object.} +\usage{ +\S4method{show}{mcmcoutputpermfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfix} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfix} object gives an overview +of the \code{mcmcoutputpermfix} object. +} diff --git a/man/show-mcmcoutputpermfixhier-method.Rd b/man/show-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..a0b7978 --- /dev/null +++ b/man/show-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{show,mcmcoutputpermfixhier-method} +\alias{show,mcmcoutputpermfixhier-method} +\title{Shows a summary of an \code{mcmcoutputpermfixhier} object.} +\usage{ +\S4method{show}{mcmcoutputpermfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhier} object gives an overview +of the \code{mcmcoutputpermfixhier} object. +} diff --git a/man/show-mcmcoutputpermfixhierpost-method.Rd b/man/show-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..20e1f7c --- /dev/null +++ b/man/show-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{show,mcmcoutputpermfixhierpost-method} +\alias{show,mcmcoutputpermfixhierpost-method} +\title{Shows a summary of an \code{mcmcoutputpermfixhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermfixhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhierpost} object gives an overview +of the \code{mcmcoutputpermfixhierpost} object. +} diff --git a/man/show-mcmcoutputpermhier-method.Rd b/man/show-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..997b333 --- /dev/null +++ b/man/show-mcmcoutputpermhier-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{show,mcmcoutputpermhier-method} +\alias{show,mcmcoutputpermhier-method} +\title{Shows a summary of an \code{mcmcoutputpermhier} object.} +\usage{ +\S4method{show}{mcmcoutputpermhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermhier} object gives an overview +of the \code{mcmcoutputpermhier} object. +} diff --git a/man/show-mcmcoutputpermhierpost-method.Rd b/man/show-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..4c0b932 --- /dev/null +++ b/man/show-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{show,mcmcoutputpermhierpost-method} +\alias{show,mcmcoutputpermhierpost-method} +\title{Shows a summary of an \code{mcmcoutputpermhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermhierpost} object gives an overview +of the \code{mcmcoutputpermhierpost} object. +} diff --git a/man/show-mcmcoutputpermpost-method.Rd b/man/show-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..6805754 --- /dev/null +++ b/man/show-mcmcoutputpermpost-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{show,mcmcoutputpermpost-method} +\alias{show,mcmcoutputpermpost-method} +\title{Shows a summary of an \code{mcmcoutputpermpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermpost} object gives an overview +of the \code{mcmcoutputpermpost} object. +} diff --git a/man/show-model-method.Rd b/man/show-model-method.Rd new file mode 100644 index 0000000..4790c3a --- /dev/null +++ b/man/show-model-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{show,model-method} +\alias{show,model-method} +\title{Shows the model.} +\usage{ +\S4method{show}{model}(object) +} +\arguments{ +\item{object}{An S4 model object.} +} +\value{ +A print out of model information about all slots. +} +\description{ +\code{show} prints model information to the console. +} +\examples{ +\dontrun{ +show(f_model) +} + +} +\seealso{ +\code{model} +} diff --git a/man/show-normalmodelmoments-method.Rd b/man/show-normalmodelmoments-method.Rd new file mode 100644 index 0000000..d1336cd --- /dev/null +++ b/man/show-normalmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{show,normalmodelmoments-method} +\alias{show,normalmodelmoments-method} +\title{Shows a summary of an \code{normalmodelmoments} object.} +\usage{ +\S4method{show}{normalmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{normalmodelmoments} object gives an overview +of the moments of an normal finite mixture. +} diff --git a/man/show-normultmodelmoments-method.Rd b/man/show-normultmodelmoments-method.Rd new file mode 100644 index 0000000..84c3d18 --- /dev/null +++ b/man/show-normultmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{show,normultmodelmoments-method} +\alias{show,normultmodelmoments-method} +\title{Shows a summary of an \code{normultmodelmoments} object.} +\usage{ +\S4method{show}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{normultmodelmoments} object gives an overview +of the moments of an normult finite mixture. +} diff --git a/man/show-poissonmodelmoments-method.Rd b/man/show-poissonmodelmoments-method.Rd new file mode 100644 index 0000000..074702a --- /dev/null +++ b/man/show-poissonmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poissonmodelmoments.R +\name{show,poissonmodelmoments-method} +\alias{show,poissonmodelmoments-method} +\title{Shows a summary of an \code{poissonmodelmoments} object.} +\usage{ +\S4method{show}{poissonmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{poissonmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{poissonmodelmoments} object gives an overview +of the moments of an poisson finite mixture. +} diff --git a/man/show-prior-method.Rd b/man/show-prior-method.Rd new file mode 100644 index 0000000..1dbcbcd --- /dev/null +++ b/man/show-prior-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{show,prior-method} +\alias{show,prior-method} +\title{Shows a summary of a \code{prior} object.} +\usage{ +\S4method{show}{prior}(object) +} +\arguments{ +\item{object}{A \code{prior} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{prior} object gives an overview +of the slots of a \code{prior} object. +} diff --git a/man/show-studentmodelmoments-method.Rd b/man/show-studentmodelmoments-method.Rd new file mode 100644 index 0000000..f3901ad --- /dev/null +++ b/man/show-studentmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{show,studentmodelmoments-method} +\alias{show,studentmodelmoments-method} +\title{Shows a summary of an \code{studentmodelmoments} object.} +\usage{ +\S4method{show}{studentmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studentmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{studentmodelmoments} object gives an overview +of the moments of an student finite mixture. +} diff --git a/man/simulate.Rd b/man/simulate.Rd deleted file mode 100644 index 858926c..0000000 --- a/man/simulate.Rd +++ /dev/null @@ -1,73 +0,0 @@ -\name{simulate} -\alias{simulate} -\title{ -Simulate data from a finite mixture model -} -\description{ -Simulate data from a finite mixture model defined by a finmix 'model' object. Simulated data includes values and -indicators (allocations). The return value is an object of class \code{fdata} defined in the \code{finmix} package. -} -\usage{ -simulate(model, N = 100, varargin, seed = 0) -} - -\arguments{ - \item{model}{ - an S4 object of class \code{model} defined in the \code{finmix} package with fully specified parameters in - \code{@par}, weights in \code{@weight}, number of components in \code{@K} and distribution in - \code{@dist}. -} - \item{N}{ - number of values to be simulated. If \code{typeof(n) == "numeric"} \code{n} is rounded to the next - integer value. -} - \item{varargin}{ - an S4 object of class \code{fdata} defined in the \code{finmix} package; optional. - } - \item{seed}{ - The seed for the random generator. -} -} -\details{ - This function is an \code{S4} method of the \code{model} class in \code{finmix}. All slots of \code{model} - must be specified. - The function returns an \code{fdata} object with indicators in slot \code{@S} and values in slot - \code{@y}. Slot \code{@sim} is set to \code{TRUE} to indicate that the data was simulated. If an - \code{fdata} object is already provided in the argument \code{varargin}, this object gets the simulated - data assigned and is returned. - For a Binomial mixture model, i.e. \code{@dist == "binomial"} in \code{model}, repetitions are needed. - If not provided by \code{varargin} in slot \code{@T} repetitions are set all to 1. -} -\value{ - An S4 object of class \code{fdata} defined by the \code{finmix} package. -} - -\note{ - This function is a class method of the S4 \code{model} class defined in the \code{finmix} package. -} - - -\seealso{ -\code{\link{model}}, \code{\link{fdata}}, \code{\link{finmix}} -} -\examples{ -\dontrun{ - -## Simulate a Poisson model with 2 components -fm.model <- model(dist = "poisson", K = 2) -weight <- c(.3, .7) -setWeight(fm.model) <- weight -pars <- list(lambda = c(312, 80)) -setPar(fm.model) <- pars -fm.fdata <- simulate(fm.model, N = 1000, seed = 123456) - -## Simulate a Binomial model with 3 components -fm.model <- model(dist = "binomial", K = 3, - weight = c(.4, .6), - par = list(p = c(.2, .9))) -fm.fdata <- fdata(T = matrix(seq(1, 1000))) -RNGkind("Marsaglia-Multicarry") -sim.fdata <- simulate(fm.model, N = 1000, fm.fdata) - -} -} diff --git a/man/stephens1997a_binomial_cc.Rd b/man/stephens1997a_binomial_cc.Rd new file mode 100644 index 0000000..577ea8b --- /dev/null +++ b/man/stephens1997a_binomial_cc.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{stephens1997a_binomial_cc} +\alias{stephens1997a_binomial_cc} +\title{Relabeling algorithm from Stephens (1997a) for Binomial mixture models} +\usage{ +stephens1997a_binomial_cc(values1, values2, pars, perm) +} +\arguments{ +\item{values1}{A matrix containing the sampled component parameters \code{p}.} + +\item{values2}{A matrix containing the sampled weights.} + +\item{pars}{A vector containing the parameters of the posterior +distributions of the component parameters and weights. More specifically, +the parameters of the Dirichlet distribution for the weights and the shape +and rate parameters for the Beta distributions of the component +parameters.} + +\item{perm}{A matrix with all possible permutations of the labels.} +} +\value{ +A matrix of dimension \code{MxK} that holding the optimal labeling. +} +\description{ +For internal usage only. This function runs the re-labeling +algorithm from Stephens (1997a) for MCMC samples of a Binomial mixture +distribution. For optimization a Nelder-Mead-Algorithm from the NLopt +library is used. This is also the reason why the package depends on the +\code{nloptr} package which provides a header file for direct access to the C +routines. +} +\references{ +\itemize{ +\item Stephens, Matthew (1997a), Discussion of "On Bayesian Analysis of +Mixtures with an Unknown Number of Components", Journal of the Royal +Statistical Society: Series B (Statistical Methodology), 59: 731-792. +} +} +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute}} for the calling function +\item \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +Stephens (1997b) +\item \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +for mixtures of Binomial distributions +} +} diff --git a/man/stephens1997a_poisson_cc.Rd b/man/stephens1997a_poisson_cc.Rd new file mode 100644 index 0000000..5207ef5 --- /dev/null +++ b/man/stephens1997a_poisson_cc.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{stephens1997a_poisson_cc} +\alias{stephens1997a_poisson_cc} +\title{Relabeling algorithm from Stephens (1997a) for Poisson mixture models} +\usage{ +stephens1997a_poisson_cc(values1, values2, pars, perm) +} +\arguments{ +\item{values1}{A matrix containing the sampled component parameters +\code{lambda}.} + +\item{values2}{A matrix containing the sampled weights.} + +\item{pars}{A vector containing the parameters of the prior distributions +of the component parameters and weights. More specifically, the +parameters of the Dirichlet distribution for the weights and the +shape and rate parameters for the Gamma distributions of the component +parameters.} + +\item{perm}{A matrix with all possible permutations of the labels.} +} +\value{ +A matrix of dimension \code{MxK} that holding the optimal labeling. +} +\description{ +For internal usage only. This function runs the re-labeling algorithm from +Stephens (1997a) for MCMC samples of a Poisson mixture distribution. For +optimization a Nelder-Mead-Algorithm from the NLopt library is used. This +is also the reason why the package depends on the \code{nloptr} package which +provides a header file for direct access to the C routines. +} +\references{ +\itemize{ +\item Stephens, Matthew (1997a), Discussion of "On Bayesian Analysis of +Mixtures with an Unknown Number of Components", Journal of the Royal +Statistical Society: Series B (Statistical Methodology), 59: 731-792. +} +} +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute}} for the calling function +\item \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +Stephens (1997b) +\item \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +for mixtures of Binomial distributions +} +} diff --git a/man/stephens1997b_binomial_cc.Rd b/man/stephens1997b_binomial_cc.Rd new file mode 100644 index 0000000..1d183e1 --- /dev/null +++ b/man/stephens1997b_binomial_cc.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{stephens1997b_binomial_cc} +\alias{stephens1997b_binomial_cc} +\title{Relabeling algorithm from Stephens (1997b) for Binomial mixture models} +\usage{ +stephens1997b_binomial_cc(values, reps, comp_par, weight_par) +} +\arguments{ +\item{values}{A matrix of observations of dimension \code{Nx1}.} + +\item{comp_par}{An array of component parameter samples from MCMC sampling. +Dimension is \code{MxK}.} + +\item{weight}{An array of weight parameter samples from MCMC sampling. +Dimension is \code{MxK}.} + +\item{max_iter}{A signed integer specifying the number of iterations to be +run in optimization. Unused.} +} +\value{ +An integer matrix of dimension \code{MxK} that holding the optimal +labeling. +} +\description{ +For internal usage only. This function runs the re-labeling algorithm from +Stephens (1997b) for MCMC samples of a Binomial mixture distribution. +} +\references{ +\itemize{ +\item Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +distributions, DPhil Thesis, University of Oxford, Oxford. +} +} +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute}} for the calling function +\item \code{\link{stephens1997a_binomial_cc}} for the re-labeling algorithm from +Stephens (1997a) +\item \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +for mixtures of Poisson distributions +} +} diff --git a/man/stephens1997b_exponential_cc.Rd b/man/stephens1997b_exponential_cc.Rd new file mode 100644 index 0000000..97d669d --- /dev/null +++ b/man/stephens1997b_exponential_cc.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{stephens1997b_exponential_cc} +\alias{stephens1997b_exponential_cc} +\title{Relabeling algorithm from Stephens (1997b) for Exponential mixture models} +\usage{ +stephens1997b_exponential_cc(values, comp_par, weight_par) +} +\arguments{ +\item{values}{A matrix of observations of dimension \code{Nx1}.} + +\item{comp_par}{An array of component parameter samples from MCMC sampling. +Dimension is \code{MxK}.} + +\item{weight}{An array of weight parameter samples from MCMC sampling. +Dimension is \code{MxK}.} + +\item{max_iter}{A signed integer specifying the number of iterations to be +run in optimization. Unused.} +} +\value{ +An integer matrix of dimension \code{MxK} that holding the optimal +labeling. +} +\description{ +For internal usage only. This function runs the re-labeling algorithm from +Stephens (1997b) for MCMC samples of a Exponential mixture distribution. +} +\references{ +\itemize{ +\item Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +distributions, DPhil Thesis, University of Oxford, Oxford. +} +} +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute}} for the calling function +\item \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +for mixtures of Poisson distributions +\item \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +for mixtures of Binomial distributions +} +} diff --git a/man/stephens1997b_poisson_cc.Rd b/man/stephens1997b_poisson_cc.Rd new file mode 100644 index 0000000..5ab08d6 --- /dev/null +++ b/man/stephens1997b_poisson_cc.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{stephens1997b_poisson_cc} +\alias{stephens1997b_poisson_cc} +\title{Relabeling algorithm from Stephens (1997b) for Poisson mixture models} +\usage{ +stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter = 200L) +} +\arguments{ +\item{values}{A matrix of observations of dimension \code{Nx1}.} + +\item{comp_par}{An array of component parameter samples from MCMC sampling. +Dimension is \code{MxK}.} + +\item{max_iter}{A signed integer specifying the number of iterations to be +run in optimization. Unused.} + +\item{weight}{An array of weight parameter samples from MCMC sampling. +Dimension is \code{MxK}.} +} +\value{ +An integer matrix of dimension \code{MxK} that holding the optimal +labeling. +} +\description{ +For internal usage only. This function runs the re-labeling algorithm from +Stephens (1997b) for MCMC samples of a Poisson mixture distribution. +} +\references{ +\itemize{ +\item Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +distributions, DPhil Thesis, University of Oxford, Oxford. +} +} +\seealso{ +\itemize{ +\item \code{\link{mcmcpermute}} for the calling function +\item \code{\link{stephens1997a_poisson_cc}} for the re-labeling algorithm from +Stephens (1997a) +\item \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +for mixtures of Binomial distributions +} +} diff --git a/man/studentmodelmoments.Rd b/man/studentmodelmoments.Rd new file mode 100644 index 0000000..130bd81 --- /dev/null +++ b/man/studentmodelmoments.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\docType{class} +\name{studentmodelmoments} +\alias{studentmodelmoments} +\alias{.studentmodelmoments} +\title{Finmix \code{studentmodelmoments} class} +\description{ +Defines a class that holds theoretical moments for a finite mixture of +student distributions. Note that this class is not directly used, but +indirectly when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \code{\link{modelmoments_class}} for the base class for model moments +\item \code{\link{modelmoments}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/studmultmodelmoments-class.Rd b/man/studmultmodelmoments-class.Rd new file mode 100644 index 0000000..de873ae --- /dev/null +++ b/man/studmultmodelmoments-class.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{show,studmultmodelmoments-method} +\alias{show,studmultmodelmoments-method} +\title{Shows a summary of an \code{studmultmodelmoments} object.} +\usage{ +\S4method{show}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{studmultmodelmoments} object gives an overview +of the moments of an studmult finite mixture. +} +\section{Methods (by generic)}{ +\itemize{ +\item \code{show}: Shows a summary of an object +}} + diff --git a/man/studmultmodelmoments.Rd b/man/studmultmodelmoments.Rd new file mode 100644 index 0000000..df40ad9 --- /dev/null +++ b/man/studmultmodelmoments.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\docType{class} +\name{studmultmodelmoments} +\alias{studmultmodelmoments} +\alias{.studmultmodelmoments} +\title{Finmix \code{studmultmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of studmult +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments_class} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/subseq-mcmcoutputpost-array-method.Rd b/man/subseq-mcmcoutputpost-array-method.Rd new file mode 100644 index 0000000..fced7cf --- /dev/null +++ b/man/subseq-mcmcoutputpost-array-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{subseq,mcmcoutputpost,array-method} +\alias{subseq,mcmcoutputpost,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutputpost} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutputpost} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples +in the passed-in \code{mcmcoutputpost} object specfied by the index \code{array} in +\code{index}. This can be advantageous, if chains are non-stationary. For +successful MCMC sampling the chain must be converged to the target +distribution, the true distribution of parameters, weights and indicators. + +Note, this method calls the equivalent method of the parent class and then +adds to it the sub-chains for the parameters of the hierarchical prior. +} diff --git a/man/swapInd_cc.Rd b/man/swapInd_cc.Rd new file mode 100644 index 0000000..39fdeea --- /dev/null +++ b/man/swapInd_cc.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{swapInd_cc} +\alias{swapInd_cc} +\title{Swap values of stored indicators} +\usage{ +swapInd_cc(values, index) +} +\arguments{ +\item{values}{An integer matrix containing the last indicators stored in +MCMC sampling. The number of these last stored indicators is defined by +the hpyer-parameter \code{storeS} in the \code{mcmc} object.} + +\item{index}{An integer matrix defining the swapping scheme.} +} +\value{ +A matrix with swapped values. +} +\description{ +This function is used to swap elements in the stored indicators from MCMC +sampling. Note that this function reuses R memory and should therefore be +treated with caution. Do not use this function unless you really know what +you are doing. +} +\seealso{ +\itemize{ +\item \code{\link[=mcmc]{mcmc()}} for the hyper-parameter \code{storeS} +\item \link[=mcmcoutput_class]{swapElements()} for the calling method +\item \code{\link[=swapInteger_cc]{swapInteger_cc()}} for the equivalent function that swaps simple integer +matrices +\item \code{\link[=swap_3d_cc]{swap_3d_cc()}} for a function that swaps values in three-dimensional +arrays +} +} diff --git a/man/swapInteger_cc.Rd b/man/swapInteger_cc.Rd new file mode 100644 index 0000000..246dedd --- /dev/null +++ b/man/swapInteger_cc.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{swapInteger_cc} +\alias{swapInteger_cc} +\title{Swap values in an integer matrix} +\usage{ +swapInteger_cc(values, index) +} +\arguments{ +\item{values}{An integer matrix containing the values to swap.} + +\item{index}{An integer matrix containing the indices by which values +should be swapped.} +} +\value{ +An integer matrix containing the swapped values. +} +\description{ +This function swaps the values in an integer matrix column-wise defined +by the \code{index} matrix. This function is used mainly for the +\code{swapElements()}-method of MCMC samples to swap the indicator values. +} +\examples{ +values <- matrix(c(2, 4, 1, 3), nrow = 10, ncol = 2) +index <- matrix(c(1, 2), nrow = 10, ncol = 2) +swapInteger_cc(values, index) + +} +\seealso{ +\itemize{ +\item \code{\link[=swap_cc]{swap_cc()}} for the equivalent function for numeric values +\item \code{\link[=swap_3d_cc]{swap_3d_cc()}} for the equivalent function for three-dimensional arrays +} +} diff --git a/man/swapST_cc.Rd b/man/swapST_cc.Rd new file mode 100644 index 0000000..6d47113 --- /dev/null +++ b/man/swapST_cc.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{swapST_cc} +\alias{swapST_cc} +\title{Swap the \code{ST} slot in the MCMC output} +\usage{ +swapST_cc(values, index) +} +\arguments{ +\item{values}{An integer matrix containing the values to swap in R memory.} + +\item{index}{An integer matrix containing the swapping scheme.} +} +\value{ +An integer matrix with swapped values. +} +\description{ +This function is used to swap the elements in slot \code{ST} of an \code{mcmcoutput} +object (An MCMC sampling output). The main difference to the +\code{\link[=swapInteger_cc]{swapInteger_cc()}} function is that this function reuses memory from R. Do +only use this function, if you really know what you are doing. +} +\seealso{ +\itemize{ +\item \code{\link[=swapInteger_cc]{swapInteger_cc()}} for the equivalent function not using R memory +\item \code{\link[=swap_3d_cc]{swap_3d_cc()}} for an equivalent function for three-dimensional arrays +\item \link[=mcmcoutput_class]{swapElements()} for the calling method +} +} diff --git a/man/swap_3d_cc.Rd b/man/swap_3d_cc.Rd new file mode 100644 index 0000000..c177d20 --- /dev/null +++ b/man/swap_3d_cc.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{swap_3d_cc} +\alias{swap_3d_cc} +\title{Swap elements in a 3d array} +\usage{ +swap_3d_cc(values, index) +} +\arguments{ +\item{values}{An array of dimension \verb{M x r x K} of values to swap.} + +\item{index}{An integer matrix of dimension \verb{M x K}. containing the scheme +by which values should be swapped.} + +\item{A}{three-dimensional array with swapped values.} +} +\description{ +This function swaps the elements in a three-dimensional array by using the +scheme provided in the \code{index} matrix. +} +\examples{ +values <- array(rnorm(40), dim = c(10, 2, 2)) +index <- matrix(c(1,2), nrow = 10, ncol = 2) +swap_3d_cc(values, index) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{swapElements()} for the calling method +\item \code{\link[=swap_cc]{swap_cc()}} for the equivalent function for 2-dimensional arrays +} +} diff --git a/man/swap_cc.Rd b/man/swap_cc.Rd new file mode 100644 index 0000000..0846666 --- /dev/null +++ b/man/swap_cc.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{swap_cc} +\alias{swap_cc} +\title{Swaps values in each row} +\usage{ +swap_cc(values, index) +} +\arguments{ +\item{values}{A matrix containing the values to be swapped.} + +\item{index}{An integer matrix defining how values should be swapped.} +} +\value{ +A matrix with swapped values. +} +\description{ +This function swaps the values in each row of a matrix by permuting the +columns via the indices provided in the \code{index} matrix. All +\code{swapElements()}-methods use this function internally. The code is extended +to \verb{C++} using the packages \code{Rcpp} and \code{RcppArmadillo}. +} +\examples{ +values <- matrix(rnorm(10), nrow = 2) +index <- matrix(c(2,1), nrow = 5, ncol = 2) +swap_cc(values, index) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutput_class]{swapElements()} for the calling function +} +} diff --git a/man/unsass.Rd b/man/unsass.Rd new file mode 100644 index 0000000..ee2e392 --- /dev/null +++ b/man/unsass.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/unass.R +\name{unsass} +\alias{unsass} +\alias{\%=\%} +\title{Unstructuring assignments} +\usage{ +unsass(lhs, rhs) +} +\arguments{ +\item{lhs}{A \code{formula} chaining multiple objects (names) together by +\code{~}. These are the objects (names) the right-hand side should be +assigned to.} + +\item{rhs}{A \code{list} of objects that should be assigned to the left-hand +side \code{lhs}.} +} +\description{ +\code{unsass} assigns multiple objects in its argument +\code{rhs} (right-hand side) to multiple objects (names) chained in its +argument \code{lhs} (left-hand-side). + +This is a helper function to simplify the use of the package. The right-hand +side can be a function that returns multiple objects and the left-hand side +must be a formula with objects (names) chained by \code{~}. Assignment works +via \code{lhs \%=\% rhs}. +} +\examples{ +f_model <- model(K=2, dist= 'poisson', par=list(lambda=c(0.17, 0.12))) +f_data <- simulate(model) +mcmc <- mcmc() +(f_data~f_model~mcmc) \%=\% mcmcstart(f_data, f_model, mcmc) + +} +\seealso{ +\itemize{ +\item \code{\link{mcmcstart}} for generating starting parameters or indicators +} + +\itemize{ +\item \code{\link{unsass}} +} +} +\author{ +Barry Rowlingson (January, 2013) +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 6a6f611..5349b6e 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -13,308 +13,384 @@ Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); // swap_cc Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swap_cc(SEXP valuesSEXP, SEXP indexSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - - rcpp_result_gen = Rcpp::wrap(swap_cc(values, index)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_swap_cc(SEXP valuesSEXP, SEXP indexSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + rcpp_result_gen = Rcpp::wrap(swap_cc(values, index)); + return rcpp_result_gen; +END_RCPP } // swap_3d_cc Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swap_3d_cc(SEXP valuesSEXP, SEXP indexSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - - rcpp_result_gen = Rcpp::wrap(swap_3d_cc(values, index)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_swap_3d_cc(SEXP valuesSEXP, SEXP indexSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + rcpp_result_gen = Rcpp::wrap(swap_3d_cc(values, index)); + return rcpp_result_gen; +END_RCPP } // swapInteger_cc Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swapInteger_cc(SEXP valuesSEXP, SEXP indexSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - - rcpp_result_gen = Rcpp::wrap(swapInteger_cc(values, index)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_swapInteger_cc(SEXP valuesSEXP, SEXP indexSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + rcpp_result_gen = Rcpp::wrap(swapInteger_cc(values, index)); + return rcpp_result_gen; +END_RCPP } // swapInd_cc Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swapInd_cc(SEXP valuesSEXP, SEXP indexSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - - rcpp_result_gen = Rcpp::wrap(swapInd_cc(values, index)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_swapInd_cc(SEXP valuesSEXP, SEXP indexSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + rcpp_result_gen = Rcpp::wrap(swapInd_cc(values, index)); + return rcpp_result_gen; +END_RCPP } // swapST_cc Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix index); -RcppExport SEXP _finmix_swapST_cc(SEXP valuesSEXP, SEXP indexSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); - - rcpp_result_gen = Rcpp::wrap(swapST_cc(values, index)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_swapST_cc(SEXP valuesSEXP, SEXP indexSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type index(indexSEXP); + rcpp_result_gen = Rcpp::wrap(swapST_cc(values, index)); + return rcpp_result_gen; +END_RCPP } // ldgamma_cc Rcpp::NumericMatrix ldgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, Rcpp::NumericVector rate); -RcppExport SEXP _finmix_ldgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); - - rcpp_result_gen = Rcpp::wrap(ldgamma_cc(values, shape, rate)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_ldgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); + rcpp_result_gen = Rcpp::wrap(ldgamma_cc(values, shape, rate)); + return rcpp_result_gen; +END_RCPP } // dgamma_cc arma::mat dgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, Rcpp::NumericVector rate); -RcppExport SEXP _finmix_dgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); - - rcpp_result_gen = Rcpp::wrap(dgamma_cc(values, shape, rate)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_dgamma_cc(SEXP valuesSEXP, SEXP shapeSEXP, SEXP rateSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type shape(shapeSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type rate(rateSEXP); + rcpp_result_gen = Rcpp::wrap(dgamma_cc(values, shape, rate)); + return rcpp_result_gen; +END_RCPP } // lddirichlet_cc Rcpp::NumericVector lddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par); -RcppExport SEXP _finmix_lddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); - - rcpp_result_gen = Rcpp::wrap(lddirichlet_cc(values, par)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_lddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); + rcpp_result_gen = Rcpp::wrap(lddirichlet_cc(values, par)); + return rcpp_result_gen; +END_RCPP } // ddirichlet_cc arma::vec ddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par); -RcppExport SEXP _finmix_ddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); - - rcpp_result_gen = Rcpp::wrap(ddirichlet_cc(values, par)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_ddirichlet_cc(SEXP valuesSEXP, SEXP parSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type par(parSEXP); + rcpp_result_gen = Rcpp::wrap(ddirichlet_cc(values, par)); + return rcpp_result_gen; +END_RCPP } // hungarian_cc arma::imat hungarian_cc(const arma::mat cost); -RcppExport SEXP _finmix_hungarian_cc(SEXP costSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::mat >::type cost(costSEXP); - - rcpp_result_gen = Rcpp::wrap(hungarian_cc(cost)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_hungarian_cc(SEXP costSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const arma::mat >::type cost(costSEXP); + rcpp_result_gen = Rcpp::wrap(hungarian_cc(cost)); + return rcpp_result_gen; +END_RCPP } // moments_cc Rcpp::List moments_cc(Rcpp::S4 classS4); -RcppExport SEXP _finmix_moments_cc(SEXP classS4SEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); - - rcpp_result_gen = Rcpp::wrap(moments_cc(classS4)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_moments_cc(SEXP classS4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); + rcpp_result_gen = Rcpp::wrap(moments_cc(classS4)); + return rcpp_result_gen; +END_RCPP } // permmoments_cc Rcpp::List permmoments_cc(Rcpp::S4 classS4); -RcppExport SEXP _finmix_permmoments_cc(SEXP classS4SEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); - - rcpp_result_gen = Rcpp::wrap(permmoments_cc(classS4)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_permmoments_cc(SEXP classS4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::S4 >::type classS4(classS4SEXP); + rcpp_result_gen = Rcpp::wrap(permmoments_cc(classS4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_binomial_cc +RcppExport SEXP mcmc_binomial_cc(SEXP fdata_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_binomial_cc(SEXP fdata_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type fdata_S4(fdata_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_binomial_cc(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_condpoisson_cc +RcppExport SEXP mcmc_condpoisson_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_condpoisson_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_condpoisson_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_exponential_cc +RcppExport SEXP mcmc_exponential_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_exponential_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_exponential_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_normal_cc +RcppExport SEXP mcmc_normal_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_normal_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_normal_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_normult_cc +RcppExport SEXP mcmc_normult_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_normult_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_normult_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_poisson_cc +RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_poisson_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_poisson_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_student_cc +RcppExport SEXP mcmc_student_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_student_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_student_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP +} +// mcmc_studmult_cc +RcppExport SEXP mcmc_studmult_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4); +RcppExport SEXP _finmix_mcmc_studmult_cc(SEXP data_S4SEXP, SEXP model_S4SEXP, SEXP prior_S4SEXP, SEXP mcmc_S4SEXP, SEXP mcmcoutput_S4SEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type data_S4(data_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type model_S4(model_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type prior_S4(prior_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmc_S4(mcmc_S4SEXP); + Rcpp::traits::input_parameter< SEXP >::type mcmcoutput_S4(mcmcoutput_S4SEXP); + rcpp_result_gen = Rcpp::wrap(mcmc_studmult_cc(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4)); + return rcpp_result_gen; +END_RCPP } // stephens1997a_poisson_cc arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm); -RcppExport SEXP _finmix_stephens1997a_poisson_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values1(values1SEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); - Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); - Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); - - rcpp_result_gen = Rcpp::wrap(stephens1997a_poisson_cc(values1, values2, pars, perm)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_stephens1997a_poisson_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values1(values1SEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); + Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); + Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); + rcpp_result_gen = Rcpp::wrap(stephens1997a_poisson_cc(values1, values2, pars, perm)); + return rcpp_result_gen; +END_RCPP } // stephens1997a_binomial_cc arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm); -RcppExport SEXP _finmix_stephens1997a_binomial_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericMatrix& >::type values1(values1SEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); - Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); - Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); - - rcpp_result_gen = Rcpp::wrap(stephens1997a_binomial_cc(values1, values2, pars, perm)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_stephens1997a_binomial_cc(SEXP values1SEXP, SEXP values2SEXP, SEXP parsSEXP, SEXP permSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericMatrix& >::type values1(values1SEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type values2(values2SEXP); + Rcpp::traits::input_parameter< arma::vec >::type pars(parsSEXP); + Rcpp::traits::input_parameter< const arma::umat >::type perm(permSEXP); + rcpp_result_gen = Rcpp::wrap(stephens1997a_binomial_cc(values1, values2, pars, perm)); + return rcpp_result_gen; +END_RCPP } // stephens1997b_poisson_cc arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par, signed int max_iter); -RcppExport SEXP _finmix_stephens1997b_poisson_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP, SEXP max_iterSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - Rcpp::traits::input_parameter< signed int >::type max_iter(max_iterSEXP); - - rcpp_result_gen = Rcpp::wrap(stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_stephens1997b_poisson_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP, SEXP max_iterSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); + Rcpp::traits::input_parameter< signed int >::type max_iter(max_iterSEXP); + rcpp_result_gen = Rcpp::wrap(stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter)); + return rcpp_result_gen; +END_RCPP } // stephens1997b_binomial_cc arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, Rcpp::NumericVector reps, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par); -RcppExport SEXP _finmix_stephens1997b_binomial_cc(SEXP valuesSEXP, SEXP repsSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type reps(repsSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - - rcpp_result_gen = Rcpp::wrap(stephens1997b_binomial_cc(values, reps, comp_par, weight_par)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_stephens1997b_binomial_cc(SEXP valuesSEXP, SEXP repsSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type reps(repsSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); + rcpp_result_gen = Rcpp::wrap(stephens1997b_binomial_cc(values, reps, comp_par, weight_par)); + return rcpp_result_gen; +END_RCPP } // stephens1997b_exponential_cc arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par); -RcppExport SEXP _finmix_stephens1997b_exponential_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) -{ - BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); - Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); - - rcpp_result_gen = Rcpp::wrap(stephens1997b_exponential_cc(values, comp_par, weight_par)); - return rcpp_result_gen; - - END_RCPP +RcppExport SEXP _finmix_stephens1997b_exponential_cc(SEXP valuesSEXP, SEXP comp_parSEXP, SEXP weight_parSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type comp_par(comp_parSEXP); + Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type weight_par(weight_parSEXP); + rcpp_result_gen = Rcpp::wrap(stephens1997b_exponential_cc(values, comp_par, weight_par)); + return rcpp_result_gen; +END_RCPP } -RcppExport SEXP mcmc_binomial_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_condpoisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_exponential_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_normal_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_normult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_poisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_student_cc(SEXP, SEXP, SEXP, SEXP, SEXP); -RcppExport SEXP mcmc_studmult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_binomial_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_condpoisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_exponential_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_normal_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_normult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_poisson_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_student_cc(SEXP, SEXP, SEXP, SEXP, SEXP); +RcppExport SEXP mcmc_studmult_cc(SEXP, SEXP, SEXP, SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { - { "_finmix_swap_cc", (DL_FUNC)&_finmix_swap_cc, 2 }, - { "_finmix_swap_3d_cc", (DL_FUNC)&_finmix_swap_3d_cc, 2 }, - { "_finmix_swapInteger_cc", (DL_FUNC)&_finmix_swapInteger_cc, 2 }, - { "_finmix_swapInd_cc", (DL_FUNC)&_finmix_swapInd_cc, 2 }, - { "_finmix_swapST_cc", (DL_FUNC)&_finmix_swapST_cc, 2 }, - { "_finmix_ldgamma_cc", (DL_FUNC)&_finmix_ldgamma_cc, 3 }, - { "_finmix_dgamma_cc", (DL_FUNC)&_finmix_dgamma_cc, 3 }, - { "_finmix_lddirichlet_cc", (DL_FUNC)&_finmix_lddirichlet_cc, 2 }, - { "_finmix_ddirichlet_cc", (DL_FUNC)&_finmix_ddirichlet_cc, 2 }, - { "_finmix_hungarian_cc", (DL_FUNC)&_finmix_hungarian_cc, 1 }, - { "_finmix_moments_cc", (DL_FUNC)&_finmix_moments_cc, 1 }, - { "_finmix_permmoments_cc", (DL_FUNC)&_finmix_permmoments_cc, 1 }, - { "_finmix_stephens1997a_poisson_cc", (DL_FUNC)&_finmix_stephens1997a_poisson_cc, 4 }, - { "_finmix_stephens1997a_binomial_cc", (DL_FUNC)&_finmix_stephens1997a_binomial_cc, 4 }, - { "_finmix_stephens1997b_poisson_cc", (DL_FUNC)&_finmix_stephens1997b_poisson_cc, 4 }, - { "_finmix_stephens1997b_binomial_cc", (DL_FUNC)&_finmix_stephens1997b_binomial_cc, 4 }, - { "_finmix_stephens1997b_exponential_cc", (DL_FUNC)&_finmix_stephens1997b_exponential_cc, 3 }, - { "mcmc_binomial_cc", (DL_FUNC)&mcmc_binomial_cc, 5 }, - { "mcmc_condpoisson_cc", (DL_FUNC)&mcmc_condpoisson_cc, 5 }, - { "mcmc_exponential_cc", (DL_FUNC)&mcmc_exponential_cc, 5 }, - { "mcmc_normal_cc", (DL_FUNC)&mcmc_normal_cc, 5 }, - { "mcmc_normult_cc", (DL_FUNC)&mcmc_normult_cc, 5 }, - { "mcmc_poisson_cc", (DL_FUNC)&mcmc_poisson_cc, 5 }, - { "mcmc_student_cc", (DL_FUNC)&mcmc_student_cc, 5 }, - { "mcmc_studmult_cc", (DL_FUNC)&mcmc_studmult_cc, 5 }, - { NULL, NULL, 0 } + {"_finmix_swap_cc", (DL_FUNC) &_finmix_swap_cc, 2}, + {"_finmix_swap_3d_cc", (DL_FUNC) &_finmix_swap_3d_cc, 2}, + {"_finmix_swapInteger_cc", (DL_FUNC) &_finmix_swapInteger_cc, 2}, + {"_finmix_swapInd_cc", (DL_FUNC) &_finmix_swapInd_cc, 2}, + {"_finmix_swapST_cc", (DL_FUNC) &_finmix_swapST_cc, 2}, + {"_finmix_ldgamma_cc", (DL_FUNC) &_finmix_ldgamma_cc, 3}, + {"_finmix_dgamma_cc", (DL_FUNC) &_finmix_dgamma_cc, 3}, + {"_finmix_lddirichlet_cc", (DL_FUNC) &_finmix_lddirichlet_cc, 2}, + {"_finmix_ddirichlet_cc", (DL_FUNC) &_finmix_ddirichlet_cc, 2}, + {"_finmix_hungarian_cc", (DL_FUNC) &_finmix_hungarian_cc, 1}, + {"_finmix_moments_cc", (DL_FUNC) &_finmix_moments_cc, 1}, + {"_finmix_permmoments_cc", (DL_FUNC) &_finmix_permmoments_cc, 1}, + {"_finmix_mcmc_binomial_cc", (DL_FUNC) &_finmix_mcmc_binomial_cc, 5}, + {"_finmix_mcmc_condpoisson_cc", (DL_FUNC) &_finmix_mcmc_condpoisson_cc, 5}, + {"_finmix_mcmc_exponential_cc", (DL_FUNC) &_finmix_mcmc_exponential_cc, 5}, + {"_finmix_mcmc_normal_cc", (DL_FUNC) &_finmix_mcmc_normal_cc, 5}, + {"_finmix_mcmc_normult_cc", (DL_FUNC) &_finmix_mcmc_normult_cc, 5}, + {"_finmix_mcmc_poisson_cc", (DL_FUNC) &_finmix_mcmc_poisson_cc, 5}, + {"_finmix_mcmc_student_cc", (DL_FUNC) &_finmix_mcmc_student_cc, 5}, + {"_finmix_mcmc_studmult_cc", (DL_FUNC) &_finmix_mcmc_studmult_cc, 5}, + {"_finmix_stephens1997a_poisson_cc", (DL_FUNC) &_finmix_stephens1997a_poisson_cc, 4}, + {"_finmix_stephens1997a_binomial_cc", (DL_FUNC) &_finmix_stephens1997a_binomial_cc, 4}, + {"_finmix_stephens1997b_poisson_cc", (DL_FUNC) &_finmix_stephens1997b_poisson_cc, 4}, + {"_finmix_stephens1997b_binomial_cc", (DL_FUNC) &_finmix_stephens1997b_binomial_cc, 4}, + {"_finmix_stephens1997b_exponential_cc", (DL_FUNC) &_finmix_stephens1997b_exponential_cc, 3}, + {"mcmc_binomial_cc", (DL_FUNC) &mcmc_binomial_cc, 5}, + {"mcmc_condpoisson_cc", (DL_FUNC) &mcmc_condpoisson_cc, 5}, + {"mcmc_exponential_cc", (DL_FUNC) &mcmc_exponential_cc, 5}, + {"mcmc_normal_cc", (DL_FUNC) &mcmc_normal_cc, 5}, + {"mcmc_normult_cc", (DL_FUNC) &mcmc_normult_cc, 5}, + {"mcmc_poisson_cc", (DL_FUNC) &mcmc_poisson_cc, 5}, + {"mcmc_student_cc", (DL_FUNC) &mcmc_student_cc, 5}, + {"mcmc_studmult_cc", (DL_FUNC) &mcmc_studmult_cc, 5}, + {NULL, NULL, 0} }; -RcppExport void R_init_finmix(DllInfo *dll) -{ - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); +RcppExport void R_init_finmix(DllInfo *dll) { + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); } diff --git a/src/attributes.cpp b/src/attributes.cpp index 0c5b711..a7a8084 100644 --- a/src/attributes.cpp +++ b/src/attributes.cpp @@ -28,8 +28,27 @@ #include "mincol.h" #include "moments.h" +//' Swaps values in each row +//' +//' @description +//' This function swaps the values in each row of a matrix by permuting the +//' columns via the indices provided in the `index` matrix. All +//' `swapElements()`-methods use this function internally. The code is extended +//' to `C++` using the packages `Rcpp` and `RcppArmadillo`. +//' +//' @param values A matrix containing the values to be swapped. +//' @param index An integer matrix defining how values should be swapped. +//' @return A matrix with swapped values. +//' @export +//' +//' @examples +//' values <- matrix(rnorm(10), nrow = 2) +//' index <- matrix(c(2,1), nrow = 5, ncol = 2) +//' swap_cc(values, index) +//' +//' @seealso +//' * [swapElements()][mcmcoutput_class] for the calling function // [[Rcpp::export]] - Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index) { /* If dimensions of both arguments do not agree throw an exception */ @@ -58,6 +77,26 @@ Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix inde return Rcpp::wrap(values_copy); } +//' Swap elements in a 3d array +//' +//' @description +//' This function swaps the elements in a three-dimensional array by using the +//' scheme provided in the `index` matrix. +//' +//' @param values An array of dimension `M x r x K` of values to swap. +//' @param index An integer matrix of dimension `M x K`. containing the scheme +//' by which values should be swapped. +//' @param A three-dimensional array with swapped values. +//' @export +//' +//' @examples +//' values <- array(rnorm(40), dim = c(10, 2, 2)) +//' index <- matrix(c(1,2), nrow = 10, ncol = 2) +//' swap_3d_cc(values, index) +//' +//' @seealso +//' * [swapElements()][mcmcoutput_class] for the calling method +//' * [swap_cc()] for the equivalent function for 2-dimensional arrays // [[Rcpp::export]] Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix index) { @@ -66,7 +105,7 @@ Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix i const unsigned int r = valDim[1]; const unsigned int K = valDim[2]; - /* If dimensions of both arguments do not agree thrw an exception */ + /* If dimensions of both arguments do not agree throw an exception */ if (M != (unsigned)index.nrow() || K != (unsigned)index.ncol()) { throw Rcpp::exception("Matrix dimensions disagree."); @@ -105,8 +144,28 @@ Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix i return Rcpp::wrap(output); } +//' Swap values in an integer matrix +//' +//' @description +//' This function swaps the values in an integer matrix column-wise defined +//' by the `index` matrix. This function is used mainly for the +//' `swapElements()`-method of MCMC samples to swap the indicator values. +//' +//' @param values An integer matrix containing the values to swap. +//' @param index An integer matrix containing the indices by which values +//' should be swapped. +//' @return An integer matrix containing the swapped values. +//' @export +//' +//' @examples +//' values <- matrix(c(2, 4, 1, 3), nrow = 10, ncol = 2) +//' index <- matrix(c(1, 2), nrow = 10, ncol = 2) +//' swapInteger_cc(values, index) +//' +//' @seealso +//' * [swap_cc()] for the equivalent function for numeric values +//' * [swap_3d_cc()] for the equivalent function for three-dimensional arrays // [[Rcpp::export]] - Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index) { /* If dimensions of both arguments do not agree throw an exception */ @@ -135,8 +194,29 @@ Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatr return Rcpp::wrap(values_copy); } +//' Swap values of stored indicators +//' +//' @description +//' This function is used to swap elements in the stored indicators from MCMC +//' sampling. Note that this function reuses R memory and should therefore be +//' treated with caution. Do not use this function unless you really know what +//' you are doing. +//' +//' @param values An integer matrix containing the last indicators stored in +//' MCMC sampling. The number of these last stored indicators is defined by +//' the hpyer-parameter `storeS` in the `mcmc` object. +//' @param index An integer matrix defining the swapping scheme. +//' @return A matrix with swapped values. +//' @export +//' +//' @seealso +//' * [mcmc()] for the hyper-parameter `storeS` +//' * [swapElements()][mcmcoutput_class] for the calling method +//' * [swapInteger_cc()] for the equivalent function that swaps simple integer +//' matrices +//' * [swap_3d_cc()] for a function that swaps values in three-dimensional +//' arrays // [[Rcpp::export]] - Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix index) { /* If dimensions of both arguments do not agree throw an exception */ @@ -164,8 +244,24 @@ Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix i return Rcpp::wrap(values_copy); } +//' Swap the `ST` slot in the MCMC output +//' +//' @description +//' This function is used to swap the elements in slot `ST` of an `mcmcoutput` +//' object (An MCMC sampling output). The main difference to the +//' [swapInteger_cc()] function is that this function reuses memory from R. Do +//' only use this function, if you really know what you are doing. +//' +//' @param values An integer matrix containing the values to swap in R memory. +//' @param index An integer matrix containing the swapping scheme. +//' @return An integer matrix with swapped values. +//' @export +//' +//' @seealso +//' * [swapInteger_cc()] for the equivalent function not using R memory +//' * [swap_3d_cc()] for an equivalent function for three-dimensional arrays +//' * [swapElements()][mcmcoutput_class] for the calling method // [[Rcpp::export]] - Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix index) { /* If dimensions of both arguments do not agree throw an exception */ @@ -188,8 +284,23 @@ Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix in return Rcpp::wrap(values_copy); } +//' Computes the log density of the Gamma distribution +//' +//' @description +//' For each shape and rate parameter pair the log gamma density is computed. +//' Inside the function the unsafe access functions of Armadillo `at()` and +//' `unsafe_col()` are used, so now boundary check is performed. In each step +//' the `lngamma()` function from Rcpp's `R` namespace is used. At this time +//' unused. +//' +//' @param values A matrix of dimension `M x K` for which the log-density +//' should be calculated. +//' @param shape A vector of dimension `K x 1` with Gamma shape parameters. +//' @param rate A vector of dimension `K x 1` with Gamma rate parameters. +//' @return A matrix of Gamma log-density values for each pair of parameters +//' in a column. +//' @export // [[Rcpp::export]] - Rcpp::NumericMatrix ldgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, Rcpp::NumericVector rate) { @@ -205,8 +316,23 @@ Rcpp::NumericMatrix ldgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector s return Rcpp::wrap(arma_return); } +//' Computes the density of the Gamma distribution +//' +//' @description +//' For each shape and rate parameter pair the gamma density is computed. +//' Inside the function the unsafe access functions of Armadillo `at()` and +//' `unsafe_col()` are used, so now boundary check is performed. In each step +//' the `lngamma()` function from Rcpp's `R` namespace is used. At this time +//' unused. +//' +//' @param values A matrix of dimension `M x K` for which the density +//' should be calculated. +//' @param shape A vector of dimension `K x 1` with Gamma shape parameters. +//' @param rate A vector of dimension `K x 1` with Gamma rate parameters. +//' @return A matrix of Gamma density values for each pair of parameters +//' in a column. +//' @export // [[Rcpp::export]] - arma::mat dgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, Rcpp::NumericVector rate) { @@ -222,8 +348,22 @@ arma::mat dgamma_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector shape, return arma_return; } +//' Computes the log density of the Dirichlet distribution +//' +//' @description +//' For each shape and rate parameter pair the log-Dirichlet density is +//' computed. Inside the function the unsafe access functions of Armadillo +//' `at()` and `unsafe_col()` are used, so now boundary check is performed. +//' In each step the `lgammafn()` function from Rcpp's `R` namespace is used. +//' At this time unused. +//' +//' @param values A matrix of dimension `M x K` for which the log-density +//' should be calculated. +//' @param par A vector of dimension `K x 1` containing the Dirichlet +//' parameters. +//' @return A vector of Dirichlet log-density values. +//' @export // [[Rcpp::export]] - Rcpp::NumericVector lddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par) { /* Reuse memory from R */ @@ -237,8 +377,22 @@ Rcpp::NumericVector lddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVect return Rcpp::wrap(arma_return); } +//' Computes the density of the Dirichlet distribution +//' +//' @description +//' For each shape and rate parameter pair the Dirichlet density is +//' computed. Inside the function the unsafe access functions of Armadillo +//' `at()` and `unsafe_col()` are used, so now boundary check is performed. +//' In each step the `lgammafn()` function from Rcpp's `R` namespace is used. +//' At this time unused. +//' +//' @param values A matrix of dimension `M x K` for which the log-density +//' should be calculated. +//' @param par A vector of dimension `K x 1` containing the Dirichlet +//' parameters. +//' @return A vector of Dirichlet density values. +//' @export // [[Rcpp::export]] - arma::vec ddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par) { /* Reuse memory from R */ @@ -252,8 +406,28 @@ arma::vec ddirichlet_cc(Rcpp::NumericMatrix values, Rcpp::NumericVector par) return arma_return; } +//' Compute the hungarian matrix +//' +//' @description +//' This function calls an implementation of the Hungarian algorithm by Munkres. +//' The Hungarian algorithm solves a weighted assignment problem on a bipartite +//' graph. Note, here this algorithm is used in the re-labeling algorithm by +//' Stephens (1997b). +//' +//' @param cost A matrix containing the costs for each row source and column +//' target. +//' @return An integer matrix defining the best solution to the assignment +//' problem. +//' @export +//' @seealso +//' * [mcmcpermute()] for the calling function +//' * [mcmcestimate()] for the function that uses the re-labeling algorithm by +//' Stephens (1997b) +//' +//' @references +//' * Stephens, Matthew (1997b), "Dealing with Label-Switching in Mixture +//' Models", Journal of the Royal Statistical Society Series B, 62(4) // [[Rcpp::export]] - arma::imat hungarian_cc(const arma::mat cost) { arma::umat indM = hungarian(cost); @@ -261,8 +435,23 @@ arma::imat hungarian_cc(const arma::mat cost) return arma::conv_to::from(indM); } +//' Calculate moments on samples of multivariate mixture models +//' +//' @description +//' This function calculates the moments for MCMC samples of multivariate +//' mixture models. Moments like means, standard deviations, kurtosis and +//' skewness are computed for each iteration in MCMC sampling. The moments are +//' used when plotting the traces of an MCMC sample output. +//' +//' @param classS4 An `mcmcoutput` class containing the MCMC samples. +//' @return A named list with vectors containing the data moments for each +//' iteration in the MCMC sample. +//' @export +//' @seealso +//' * [mcmcoutput][mcmcoutput_class] for the `mcmcoutput` class definition +//' * [mixturemcmc()] for performing MCMC sampling +//' * [plotTraces][mcmcoutput_class] for the calling function // [[Rcpp::export]] - Rcpp::List moments_cc(Rcpp::S4 classS4) { Rcpp::S4 model = Rcpp::as((SEXP)classS4.slot("model")); @@ -278,8 +467,25 @@ Rcpp::List moments_cc(Rcpp::S4 classS4) } } +//' Calculate moments on permuted samples of multivariate mixture models +//' +//' @description +//' This function calculates the moments for re-labeled MCMC samples of +//' multivariate mixture models. Moments like means, standard deviations, +//' kurtosis and skewness are computed for each iteration in MCMC sampling. The +//' moments are used when plotting the traces of an MCMC sample output. +//' +//' @param classS4 An `mcmcoutputperm` class containing the re-labeled MCMC +//' samples. +//' @return A named list with vectors containing the data moments for each +//' iteration in the re-labeled MCMC sample. +//' @export +//' @seealso +//' * [mcmcoutputperm][mcmcoutputperm_class] for the `mcmcoutput` class definition +//' * [mixturemcmc()] for performing MCMC sampling +//' * [mcmcpermute()] for re-labeling MCMC samples +//' * [plotTraces][mcmcoutputperm_class] for the calling function // [[Rcpp::export]] - Rcpp::List permmoments_cc(Rcpp::S4 classS4) { Rcpp::S4 model = Rcpp::as((SEXP)classS4.slot("model")); @@ -293,5 +499,4 @@ Rcpp::List permmoments_cc(Rcpp::S4 classS4) { return Rcpp::wrap(permmoments_ind_cc(classS4)); } -} - +} \ No newline at end of file diff --git a/src/data b/src/data deleted file mode 100644 index fca0c25c408e5e4f2de2ecc13aed6d6dc9480524..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 239295 zcmeIb>ys-uw*^BvMfppNtR_X!VZ7(Cx`z8fApW=5B{jn4hQLzS()dY zs;nv$x~l-(8ARMiBJ<=qCr_Tt%KYW)lg~eT^ytZ>+M~yhp43F}9r)*K@c)B6PUa);JXqb#v~J(=rY;3o6h&OBUuzBlusfOqfN-CM=!Cy2xqB*SpF@Yj>U zG?0?}D@FI?nRJZVmyxJ(J`8WxTHT+)_~z0Z`m1&CqlsPbcDrY-e)p5J^X}8W<0(O@ zv~D_W9r?B=^L4PC`%~Lqdh6v)kRhh7#T3aJm%3HfW=vts`pp!DoyBr8o2)0df#OJ{Z~bZ!^gg-px?NWU z$?V(lm-e_1|DR9Mzj^A>AV76Gl@|M8@s$5pA zX84ZOW(6(w?Ab6b>upS8<@`|@xwh?T_+m2jg5@$?#+&;Or%m~NJqcIdz+VM! zZ$4QA2i>crrnCIAqWbI3z#n=3bQ%s*(t^8TuvkyRIjh7|klSC|P0tI#uz^4GCi7JQ z-amv`dwAuG#xHyyjNLtlxH@PDB~;YC3-98@>-L-8*|UD#)8B};GuRBW!XZRbaKEBz#4sk-@m=%Z;KnMTTg}{*u>+V()@n z_=1R*Xg9^b;Ca&Q;4*e(c5R!*tGr+HJa2gCNA>Hk0}m@y5rAt(1nb~#qCclU zq#}pl7T(P~xLZI&4Mr-0ps%G?#^2T%T);9 zj0v==+Y^=eh9{V-A8*13Q@E%4`S{yA4CsNwV+{1QbTfd87bmBrpR&HpnIe=|i1r z**@2#L-7OD+vNXR$5>9i-PSEvm-n?U(NTGri@v5tcw{{h$}4}YjV3er`8NC&(SIHO zTJVRHd=5zFFjQYbnwXP|w7-DAVqR`3HkKgJVKKu{;WuvCwA)%uz8gfD<)r?5is=5c z?0Zb9KYsf0Q#sPjpHfS*)G4(bx#|hJAWM#1V`((~D0QA)Wb%5FJ_9Y1H9j-nV)8mj zo4i&#=at30&z!XCIrX-4-g4)s-++Pp>1!|(O`Ry-V)sO`H7=5J~79)wRWIWYi%3~n*)m)jnZqK zy3Ue9*T#XnnRtwWvB#&_2y)c+_%ET5dNlX5a)c)1pNRM}M{kdRU5(z7OELx5V7?@l zRwT4?DM4(-Ep=(8>H(r0n%Q===JIhk3a05J#1y*JAtHcOu!h6=u`yywA`KD`Wxa;< zXhzi|)@wT5F8eTNk-T?;AaEuL;l!znJ@MfuE)4y&Fl!9IZ>@s0SU)n>Gib3&L;X)3 zgGkmyj2|026d5L$Kf*2|^#O}gP=jOzz`s?a+dM!ob6lTR#`+R){K;A^Xenpw-rjQ= z>|mz^1*aUxWj5?Wj>~K?i(4O;+2rnz27CZ;5$z=UFntRaAEW-_qk-KOI6&-!1s$I1 zWo8e;a@PRVb$GRO|mjbh2rcT+w*Q`nK`8UXtW`= zBS$My1drfc(#>4SdhVNGpV9P8FY&*os7T)OF0A$jv*F^EYL43hC|e;HIUoxrA%J2A zP?niw#vt+i0{3HR<}zdMr%!dcP(xD$CSd?+%osBXY0Ll;7YSf?BsOC(sq{cL@bo}f z#j+c?R9&-ib^1xmkZ3s_#K|m&Eo3_ck)bk{Lu<;Ak=C7^4z5-M4Tdq}{Q|%W;XKP3 z`iAm3Y(YJQ?x0*uRiBl2U>YQc=Pr}1dIQUD%C+jv6KxHk#LWOm36WT2jKqLdZ?Wtx z^bcT5MyoeXw#XqT08G&LkPP(kk4yHSYPdAoP>wZz3>*SFZerMfvq}v6>uR899wRt} zqX03u`D{5+TXc<$3n_G|u(YI$4g(~%fl9a=H$fA4YA5IzjGeX9KNIua3Kk|64ivwA z00^6LG9V2WO&(<^7r!ltMplic?h);zg_m+SUmQ`(BWj6<10IB07TLmb#3VQ3z8Z0i zW5XP=)fAsSO!A00ibE=|`+*Wf4KaYo5C#ws!Wax-(pG_-?3jdstvK(1*i;N-Fo0^9 zF=i6dm;oft31BXyF=H^Ptbj&k9ytB25kT|A*F0+hqBgaW39{8jh-}qH4+OSq0rE0S zQX3(_Qwwloo=Lag7|V7|1Py>uv>_0f2p2@=0cSSD-Rvd-XLf^tGdl&3%P|GVYLN`o z7##7kBVHz#>Cr1bH31Wr`k+c!N}Q_^w_V76kE0je{MK}`S}TTPS=(+yTriznh2h9s zgp(DVlf{hDk^FAo)*Hw|$Z=}7J_=tv4dkM*LS@>9QM~de;Ii)fvw;UW_&}q1VXb0CAdk%rjSUJw!d8ZufoNuJq#DG zyusv!Q26!?ZtHjkdg!`&ju|?jI^5MT^VcP4{{w<;M_vdccCRqcleT&$jb(R~DZRiS zUWuz*X5pM0?W1cz^PH2(Ji6rt_O^UC5GVTK${SH?+-lnv(w@QAp+Q| zAaAzl)`4cjwmsM}BJRxSz`Ypi)`l4vyB}WYe&hfTEqz|<%%)MVkx{^S%yI;)`BN zhtB%ft#9IxO#9hPW%^}y`gWVucCo|j`@l@|mosIQ`|bCFP4@DRj|%Y>3oaH}C?#XN zyDYKUQY9oV^4Mah7tX>lfDnrrKpG6-OdVtP8$f*yEr4b*6~iP9WcVs+elQ#CeHUTO3jlXM!bk05>8kXZT&pR!2Yr5E`d962=i~0dfLpL)QiR%jWAG9j1WdF zoUY@3g4jCGgj*OP6Yf~#1SrZH43NMY(3%3AKt_1lYPddX(HzsNK%MA+s>JZ-wX(6ZY+o^-PV3O52q6EOY^UT>bzio(DpgA8cjrscGV=fEXC4qK&g zo46~|YS?6xA=BR(Va-@>n`{eDMxfn>&5_=E^;k#lH((9hRODeBtJ2g8D9PZ%HZww- z3^*)wVfbWy`$&uB1kjwSyNxUd%>MDQ$L5{ zWqR6nFy#?-yw!8q5>UrHv135Hi(hg#@ zcbd~JtHrjO)?IwFZo?*8hLWYdV+XI+5$xkPkSlD{r5&I4kmBtjK|}VCKtAULaTu%7 zA{wW`XxN6@273>W?I^XHbZMZ~AY{>U8pM-7&es_RhrhYj@1T)WD%NNB9{L>wrcx=L zBL;QEpgt8ClnK#%t4fGQuSI`$w%ev*BW$B-T5@q@Wsn4rVBvhb?X?U)g1kxmh}Pi^ zJs~L%KN86~_z@)Ml~N>s%JHM)Hrjh{qdjhaRre-{{maMguSJgBAGg0Ax4){b`^W9C zuif1X$L+7t%@%A-l)Al@4aic{S$+X@!rc*_fj^2KKV)f#x&3uB*2|$;7(rHw1IIAp zgs=>ZSQa3bM)|hGkB{42U#iM|8!mMitwQe#9<`e4bDQF(hZlEu-Xd7SWl{cgvVP^2 z2{<3OxjshZ_H_*G06;Dx!Ze+k%cL=5%v>0Q#2B-eKsKCiqN^BV!R|_((WV>u(r>#}!)*mh#Elk?zqw9*2BHSD0-(Kj#vscaW3d(Uae z77>OWUmFlJngL){KdvSmR}(%Js|la7{i|3UbCu*f6|Ryz`ajfnW2;q?CBL3EV{@y# zc*16wKU|FpF#Y+n0U-bUnRumuLj7ZVOikQAo=mvCcy9tO05R@T#TAOYD^>q$MrL`* zK!&=Rd2))V?h7%LWW~%Rp`w6TMPS@B&CT}>Ro5g!O zY(iW}lz8cQ!&AhWyWxIXu)00*<__FPk)j`Kq8mx6sk*>b-=@#U{YBD6oCPg zGbR-YnAtHVCp*$SFi>E!fYXOs9Vdu2m~1KcWHVo!qp>VVSEGqDCDWCQ7*~3r)=3fGZ|q_jm~G*>MZZ^G$9OR(Mq3%fH{``W`$$< z$3LUm=4(EdH)am7cCppW0qEKH+L%~~Wco%|GjphX7Lckolq_e$1F6bEQYSBvy!C`f zV!v-Pz{we;SmE20zrIENz6SDMl${)!sal$4U z#wK$lOe(W!GH0Yye#!fS8;R03O$5`^DZk_mi_~coMKg`^NxnIg$nlHUqQs*e}8k)E=TgDmYk`cF!b6a}QdLwB;u5mqcxe8L^>O#psQ2P#+b84*A~@iJsguUP@`8PYCg`@Yw#kZ`shDFEQ9ila8bPm3&o0%l6}lv z3vg*2lS>c4Q?WgRTM2A>$keh4Hi0bzOd_2> z1U?9@01cWaeo+>G!?TGrrdAlko-?hD$Q$UQtlAKF0MzIlVr_uR)abIU8h-_(-a4*& zf5wm(Tu%KA229kcS0(DCKlq;$w{>?v=$@+{^iA*Fd-~zK`X{{N>Ag3Z^qIc^}g>n7>%- z*EYW3^)JqQryqFTkF=(5dKce0>pp*9@%e&x*?oHP{G3r_tZDx;3_0NvC77^0zgeq$ zj~c5rJdgnE+VI+E`dsFhQgTV8<6+6%|tAiSB6_>+HGu!|U?DB?^b#V zEFk(zQXOusZ$=P}?Fc{gUj*_+(B3EF6$W?xY7rQEZ~G#My!-oEf7O!DXM(GrJsYa} zZ3|V8FJ?mT3Y){#1?ljP#!8vz!8;*7lw7xbCX4J3KN{HL4VQSwNBw&|bJS^>nPZ(9WfqQwl4Cu+{(Sr- zr%3DQH6dq}(3N?y7RJ6+&;e^60*OJ2s5^38c%BjtO02wfC|&}Bx47Y4TXwY zmq4E~qV7jEU%9_SrBOHP1h>Fz7Obzr(JGbOme{JSivC0D5i{SX9#!TX<7}NaGX_k>Fv$!cF(zRQ1~6%> z0A?=|Fgar`Ov0Gz0vgFfBy0x(zQ2i(x*EeeeZ>Ayo!S7;sniB|>Zax+s>m@{-`C}0 z2pzJ@3DkU)l0$W9NdStX!62Licml+VwgXCEn+d{rTntMGkvZ0Y!&{gI!i+7u1>dII z?m;wDve0HW)C2>-1WN~DRDcmQkH?HYYg^qugE;Gci)^C2->wklee|Eybff6r!UX#J zFr+sP)dfI!u?*LMiYd(`QS4-rM2&Ceak6UgV7de!H{fO7k8kX66epv^d$JivjZ*1z zcHJ2p9)Ul@N>h^wCw(|T{3*gd1v-(nWiSU9ExMa9fMXxwE2w#S=Zf;h|W7HF&sw^E)-2 ztx-s;^HWPHX|E4VC`xnDOJ5o)4AVtSwgk3hrr5^7#16-d&3D^@JhBW$@ReO)BVY48 zZ+PcN_YC>#z(YS#tqVLpB3K7^6aDFcr5qVKUIu24w^ZW#3SJFnT(-Ll=1|cPb6RV{ zA{c|SVl!a!!I-UxG1m?Ps926Hq`^QD;vAX>Ch6HC&bD?Lc!E2#_@SsV?w^7=C}IJL zi$ySJj=qqE%`EBekDM&KOtNg+Uz8&k$e0lV+{~4qrG4C@bljq}kBd3XdE~EDIgk85 z)fcqrJkp%iZQPsl;JH|3b1T|Eq;!NG?OF3hNK&RU=6{g1)qGLVZ&N0q&zmobWE#w8 zZ4;7O%e_dnve*=xy+&tKe;9liPDjC#@sWdmR~(YB!%}+hcslDaH$CLdX3R8j73IWH zTGUJ4?EfP3Y00xvWKV-gqfb~C3Sn?Yl8x3vw&%A z`MD4>8e~5{Vsu;&EV5i?PDbh#PDUR8ks6$Q297TLiooO@`z&0o;q1cGa6Y1GQtSvr zM?UHtCs1Y*8zr-N$O(x$7C<}W*nx)J%*TTbcm`zagAJ+2Bf#)%3YSSj)3|MpN2Jn< zs>UM{2Xd66$Vy~f@8c;9y+{Y6dsxH^JKo2hx)tQ`A6~9zIrBqliQ_4Z!vrMc?)|-- z!iYLeAU|P;fiftVMWr`r9$TJR**Y(iyZvdGf;pIs?NGwc-uW2m9p(udX2DDxR8)OQ z$mQ__jhc+#4}&uyPK+^uKNMjmJun727YU%OBE$zmgF2f5Q$v#`CkC^dG?;_|lcuZ~ z6j3CQBNVeE4aQU#(CDZMgjN?*3)uM$_Hd6wH!8yeKqgpgId$5k#?~GL z@jiv&c#s-$181x$#sm)f5CLAajRY95>g;Z&I^7Hf@u;L#Z;%7j+0#z-28y=o%mM1m zdFt%usk)0rKn02ffH~gZ1Yu?q@=W9d25B7kNgek|?PH%*k>!gc4K~$n1Ln%lpvsjW zeF^Y!<%ce>y6?)*rp24gr6<^2lfU#tyKe-nk-GE*B==u>5}7w?FSg%gNoGqdxn#7= zLMt(G(2s3|d-wsY;|*O=NBmV$b#e=$zFCIdDO6-_NWfaOrgdB!I<5`D!%ZRIwR&6| zikjMCt_^)1I)IB_#;yl7hsvgje|_}Y$Nk`ZT%d|0@*ClNzAh90VrWEur^`eVe%A|0 zTSE6gC@Ul0AL~LCT$W+W3=y|2mt|yK_Y3$#Dow&4aE0bRH@{)#`}l)iJGtiyjjTk? zW6Me`xFW(TO4|G~&E{m!n5_auaBpN-g!n*c zQ0JV0scI2oq}eJv=GrP?ipYsEIU_M9VN7)a-2%5ocFG0CYAsyIs5NjGdu>2Z1F&}= zd_>10wXbC*>n~h!dO*_%ID*oU zM^GqHAvJbJ-i`QwX2wm}{}HX{uam%plr2+`ZP<=t*vH4#L^4TeJtXxgiJ18k?CyA~ z{!?ki&cPJgy}sa4WN9I;_i<_AxU_IwS~x!b5qmi#zP&!a!#`s^q1X<8ojLot1WmE= zxdgoykPSs^ig;;Mm(G_r;-3+{G9bZf&0|Zjdh5Jw8~P8Hx>`|ieZ!Ey<@!ea@W(FK zCE}9fiyFn8QZGnkdy=Ne_9T;nSyXz1rnrwMZIhSD-G0fWU=AkZxPX$sfO0%`;$6XO zOw&O1yRb9HdvSN?ErR7LgtzG?aC7j%FR|bu6ElD~I0g_0$C$DL$hk-Wg%%+`5E|6k z444|4G&wPt-K4=J445=!#h{2HfgGWj9ceJ8y1+hwv|0z(Ff7}~2T1^nXYe;+^oZYC zwvS6RKZB9q4h*0C+N?Da$%2JtqLby}2HgLw_JimeZt)aGG@N#G#kH zO;s(2J=o%~^&5w+&^S#xcH*QwUjw3P-NngWt#Md|I^-3W!z$GAX;sGYX{pJf7lK<@}JU;p!?JzBN8@GHj==kV6e3_&rcKLeJ@kq%bA1M)USHWve<_-ph ztfi;ZS4INmdU@quH$!3OILdxJN)owE!KD_qyFOa#*>b5x)^mS@9~kKgKTsuv9R?7axq@2=O& z$w1|nZ#Yha`HS_Hih-PCZ?O#5@azRATE6gSGhf9>UN`eN*%!S2#d)usB?@tA$*CP% z4uA);=|RTp^JlTg-@E6h@UTVwX*lgoy6|dy`kUT=C6%jO46yC@C-d3lPM&X3rIhb1 z7)k(nY)8C7z-}^XNr7p%ciAU5ixE`xhm&BLsqcAa_J>;HKg;AS*HqH1AHx zZqA9<_k!61c3m!mg|}LVOaDcn8SZ?=LEvkr{dId1uDpT23f$g&vS#fqH9cwd{<<^p zN1i{OhQpM!;BFW!){}6~IY5xo?_f$M-1)PjX7MG}w2uty=L-;1fB$QmbKUVyQw{UbZ|Psx65Nvv z357oP0=O^f5rxJS9pDuCH@0;n_6Up@Hp;74p196GzY632VJt+4Z*wf~f6u1x)w}A_RoXuNO z@I*mCbCuT-F5Dj0V-_id*yRurgp^@Aux}wZ&p=us`$L^50}%zznMi9+mMyI<-0K8U zvkXHDBJ#nXhiT|G+mTZds4WmGvA6%?sW~wRtxh~M8dd>RU-!-IjPMeY7w_(Xo644k zAyH~k49Qe1!6OCbNl>JqJVcR?@}#9w-UzQTH6+tzQ4o*qQKIjN>bRN<)2F~J!1DdEW=uB_62}7g6gA2M#DzJ>_1(Z(5EJLu1}58pwn3>1 zb@*?BH;txedff`1CkHsx_h3ctZn9Qgg@_!j!u#IOPzc1zfgCUi134fB(wG4g=P+Z; zTo_{t#Uu?RGWib)R)pezia2#hHbC@_hy4RLmDPT^`zJbz!S{Ni$Ok22pf*OFr8dSR{+Nt`T7dFufv+uO z*(W)9Ff)*$ju^>Mi6N%eItcI7=$w3wo;j>F5wEJzyM?tOUXM_tiwaN_2A*KWVAL@H zlg!Vi5zLuXU)UL2Tv8_fFc@c(q!gq<5M<5v zGWgMKIGuovWitq9JSgXi^4$~Lori007|s^{dNP;>Y|!}d!^=C`C?n>I$w{rVSWae> z_2f42{8ew%?Ou3zTdit@pQL1Sm)V>ug8u8j(xs zy-zN@Zr2q^9^Hnk_-{McHuum_g_&vO4vDl0zbyED^LK~TV&hQ@CDdQUUDljss2h;;t!`#Fb2ot z(1&~+It}O|2q=16Pi=)t^zgb3SGyTX>er9MbfjMz#6_vw9V?CAIV(`s2W??0asSTu zLA#s3oT*j_T~LHgi2Zv2P>Fu z_m)arUoCM*&I7TKH@%tMeyB8tpTTUnc%^<8LQ0BE%I`;m0Kis(A~*!|!7V0M zJ-{#)({gP@WGJ#hKodpQ1164OEZ~5s3xrWS%XJXSvD`6kg+Yd|QNU`p5gsd|HqiUp zqabXWJ%d-^Xr10ZHIO3Ywu4M!j}Tz!Aj&d0A76U zHU*!Huh)KAOwA=e*Ek=BH)~zp4~LXWgN^Qk?;JrKU6Dt;=27a_B8ERnSTo~r+v|9M zEe)}OR~_9(K$brkOs04OPP8RhhP$^nJ3L;-b52@z?$#q}enu(~fcI|$WO9x;yUh&=rZ%0*8A3QDmnB3>+& zx4<+ncSAQ77rXRh< zoV<%D>%kn5J%hC1z9U(h`|LX^$X^!uKK!=@p;9OM&Sk4`IO^Og;iO=(5UW(&O;{_{g(Nry-9sohBnQISpkN3Sni%CEv$gQF1&p zNhT+WNtTXeUVG1~I)j24G)6&kvUm^$;~^bN>rvzxV#a;zyiBfiA0>AShufTk$=Ghk zlo&q3#r3gEqTs@)RpuR0+v9z*!t{o#>^@3S-s2Rv@MVEWVswSU=#6<-L|3%{Ej|^F#3zJ+V-!U*V~8 ze6JF|#1mlHucG(7g$vOz1j_ajKs6p1K;?7zAWcpHv**y{B;{n!Ny=gPz$6r!6DT4g zC;L`OIiNQtWrKeR-1L1PgZ|4RammuCl}Ih)E_7`ZQW!~H>H`3DHipCJ%y*UyKG#k+8Pa5RDQ zDIIZ;(0jRrl?`jHAb``of1FAe1=6k6-_Xr=3Pj-v0KERwdeL;Zm9zjB=YN|k(_ZAfh zq?-f^5)zoY0+FdUK{Ro-Q@Ld7LR{jyq^?bXAgaI8)-lZGs{1Z>kSV{4PNdOG26-1* z&WINkmotiF1w%3`Vb+3+3R3WW78MHem)hNj|F(-3;#6VO_NgC}3wJZ}9J!5Gu1R$e z=oQWDnTAc|3EKn#YcYRA$`F03U0>Y{ZYRM@Pn^DXdLt-eUG#z1uu|-J-Bxf1h~;oC z9zwA_(KEs_FV;;qpGiI+=+HPHxe((DeWdJ>=qn%{S1JXp&U(EOZ~ck9lMQ)ehtv~% zAuV&4@->&4$OmbZPhgypu5Ew0^k0RGRT~!UUU`Gb3t`pUGq@1o8QAt(b=)T+!!ub~ zy3yHg^qS7iIyhT~cdzQJU`=g9<&%yQ&*%E^2#>JbO3{eDi;6dS)9@BQCb$&VmW0Ps z?vEY`;P!ZYoplz{+4&yelr-#xSVK6>t}ca3W7xZ*3FRIkNmyRoLoc4L!*Ri|`C zO>tcDJ+Amhs9EM&6yYyw&}cU$)B!gL1^!HIDz)KSA#pR%SwHOBHj7uCYGN6=j5|JH z7Wmn?#RFH1}wM3i_cVbS#jvvUdy3XbO>V+Ak6a8(!J&QXo?(_4mQbZ4XC=| zu4b(6)`0BRN-3k&qN}HY2^j~D&M_vmg`wr+E)J_j3;1Xmh-6HB^Pn11V!&$AO+gT5 zve?zot$-DTZke`PV^;7n%R6TDboI5>VjCY?BcIAR+R6cd53|pZ6`5_OXbq7+E3Dr> zp13=nxU2re-B#=RM`CQD$H2yYJmxNt->q;L$miZuqom|6kT<<^@9Br{o~vXyj_JWh zf&Q!6Ae^eWhh1}?cEI!g+eE(L^)JqQryqFTkM!&`aSHSc-evdc#q)DUk#R6o9tgBg z-j`dp-}BeLTwjaeMyKy`oDnwX6B$GLV=O*?`tj2OECd;2@e^WY#kM2%ABUr0n$ANm zLdWQ`n4F2*tJ0bLvJ_T7^Ow(W)@R{lwF>7Aae;OK>tk@ml`WD~JY4|$ODVY+f40@X zL$J17Y)$ZEI~Y=vY02G4hO@hQxkWPNj*97iI0;xeH)rzzIQ;^kF>+*_2ASvt)CO2`{%yktgon`)aR8`Or9 z<){s*N`+LlA$e=Hg(>NBALUGOwFL>O-ICT$bL&DcLS;Mw2z?Hgn_amlwqA%$7Tg=5 zPEtFojQ9M2vowmXNZCm$D`q^^2U#{37_9P;0z>xu6&Nxq?K27t1ltxEvakaGil|}7 zK7;!Z;bRf+(PH0>G$&BH$u^n6Luwa&ZPULXnF@fO`3jJ6G8NF~$x~n;EKq;H_en3c z>qzM?Qo3>JrS!G!x~K4s*LAKt`2VglNztu{Z1j@o%jlsKYDJyWU&M1AEtp%H6(qeXzu>d)NC*yjhIkB^8{_=5;Lh7E-X| zx<7yFxUS^ap?CUTFQfOpw~+Mi>t9tYuZ&J?Sh0?*dMg)2H9e}XR7SUUTb-=5&aD|A zIz~g*N_<*LPw(P(AUCz63o5rZ^Vl5-BcH9Xc_fF)|GqjSKB!Mh87xN=ze@a@Rdkh7 zsD`VQLW8+?MCH2Qdbi&-x+=I{M#;8l$OgZ& za~l|6l7F~!71F*Zo%r{Jf8KWE8@Y3v{i&1sZTa1ORT=9v_NN22p53?KC4_!AS*=ec&An{K0*JjY(+cOA?+KK znA7~x-n2@e+Wg+$^kFS_k4liw?xEQvJN{^bwNsa6wXhHAWd3N59hJS3Pexkz2`e#1 z_qk_9$RfYbn&wU|Vsxe7+m|M39cp4w&%61ZS}AvI{|9@v7;DyhSA{%!Z%r%N(em-h zPMwC;%l>qr3i+qxraMB2(t2UQ=#5_Z&@>~P{prEj%;=~8!@;PQ)^WcZM`QlYp(&d_ zKxW^*JvR|$Q`UtXo^I4k4yOSpJO2oqlq1bO*C?yX15%3W@V_^jXeA#@15!`>NTdzb z4^uy~-@iC8`xzgM|M|caO#5s+jej=GZ`^);GItvAXNPHD*6$puhSZ1-t&t}`C+2u? zzYfVN_uy2cTKzHEGQ`c9cI>?|wkKVle3m!-+U`7Dd&6+H@Yj>UG>{`Tysr1hiB*D* zF{7tJ?apLA3hun{X6=PzZxG(VHJOa^N01#HWC2Nd?XTKj{$-xdj2(}sl2Ux*d;OPpi_mrPxVO95Tr zIQk}C1PSS~!;9)GcyRY5{jT^rIwHMyXjlGLZxN~Dx&Ul`bbOTUAQm2)$e|CcHY&;6gOvsi^k1tpQK20m)xg^yz4a@2!CBma4^+JI}igm+Q;p4|~zu>1VI;J0t!9pdQX zexZes=gM1vM;A;U-1n)kAC0{Sa4&h{*?>qCyzCwm^Vf=r$$xVoYHiZ!tyQ>Od(k)W zDwr;UW$*g>qiehS(Y5g5=%#%rr@m=F`X0(>2BLc`qOUJLGw^lPPd!5b-`9!wT2DuK zq$m1BOCHf#{fOoz#B{Gy1Vuy%K|h!j#5!g(jdm(06r6NZ6inogy=johf1Q>;Q9w1dC5tKJRDn{I5sM(S`rPe zLrb=c}X2s3o6<3YaWc4Myvl^kS5_cnys`9^z8Ffb}t68^ydoOAvEBn=6v|zQr zCk4nI{$82|Dsg%PN;aM1@9t5Vq-&(MlN}j`ImlksAUFB@@tWD`J}A>q5>C5YZIX`i zclK!-<|+HtgIwhwq}ijAhLg1xWjf4%vwxkEZj;)gc55c)JcpnSxzN8(sjeN3RMLD( zY=SX;>R%n8l1V4~=Le`G^SXmnkKFLzXIrn5hH8wE(wtE&wwuoQKOC&8NteuN+j}-D zbIb!)lH60mKZ*A;SJM!lHl_D6<=R@Drqc(S=oQWv@Cv8C$IulX6j9PzL;FQA50;am zH}_|Ow-8Tvibv`I{IB!8@5sFURZFe|!i~iAaBDkCTHB3*zXC?^-qU3MVsJC=4aNI! z!z*7bXZVx#3Z8}P`{He=I?$k6UljTKVPibKSzTeQd@r^icD#=PEnNiw^Uvg)QWu_D z3H*l4wsO7mU}2vC*(d<6;VWSqAtaM*vRZ^IaiuaRlUD3U+?*4y?*+5P`jxi~0G)=F z2LDB%8A?m^S7P1n*)Y!J?MS5vIbA6QJ|9Igxb#P5446hf4JaPWQa3{5qN==LIq`TN zWALG3(B=k@p4rN_IcNnO>s~KhdCwQYd->*k2U#Z1A6?(9*4|YhUR&>Y-i!GSJO>6>RCwMzgg1Jp-eest zeW=OaS@hDa;|M_9V{rV!AO2Rb?oGrq!s}+V!X#HYeDN=U^W7=@FK)SYqPN{y-U!Nv z#jjx?I`7*H4>0`xQ}4p|E*$N#m8g4NnYw>og>?(4TR%zGjIu5?@I3SW+eqIgytFAh zj7d0`)mx!M6m^FFw}d~a)>f6CIi|grp8u{Qdv4IPQ1!$;~ORuG+He?49GAVcCKmd0cVt2X@xu+Z4hLivSQAy3U`qHOYdA*FmSbI>8lTt>z3E)r3RyNeX_zZGd-$yip25QBz` zp1j~m#lQo?B4#(Y&nTHoF0+#28uK9~c@;_CDeR|23%ni-9f_`_&{=anrNEys1$I>5 zX&ONj)I;8XY-&`AVGM6b(+k?A*2|N6(V}I^m%(c>K|)L=W!J*QIpB*PmT5;0pr!wA zs`N?UKC#%t0v z6kUYY@Ykh=)jSlTWr#Z;FM6fRP=_0|l>Cy&5sWd`N{*OP1~suq3i3;GZyAY_h+Qqh zUX^%AtUTh5;L0Q=N)?S+PIuHYW5pDg?m#hjBsx*h--(reHwq+d z@Li?CPQO(#BSc^BQ#Ecac_ft9$%@ZF!U|%2TDajJK9(_C{Qmy*NLb{ba7}j9JhLh* zW}-hmAjJ|k6HA8ZMF%mKh*|Dm9GrRy`-u(5!hZ62*9q)NUQX`51*p7O)~R^z*d%GWtX;+UJJ`AJTbcFIi?eu)vX*P6H%iP}+hlR+U2kw!tK6?V?2*vvy%Oz{xw zh}vGwXl2iFgS&+fNBO*U=*eX*SaR_uv&A&>y8Gv4nr$tY=^UY?QKM*`KObDf0U}+V zUu5N>g;6KCg)+>7^;I}pB}!2+2h+V^4nt!BKC@*)RRdp<8uJx1l^~1R&jEvDX)vBw z`6O7|PtF$L6Q7%I=8sQ6%>40m$}jQSewAQw7V~@0X_RFo7~HRBDx*YvUetEq0E7EG z8c!%KBp9q^?q-m!B+H3af43uBC0fpHwCG9-oi2gYGNUx;8#spvMAi-d! z!%ipIS_ugT8%k7Sh_uEhx&y7s_hf&7ULJLdJMxP(-9*Qrb^Eg%-6}Db;WcR*a_dP5 zwO=|=8=D_W2(^3}iAi35N$x$U*`g%(mXRol1cSj|m3T<3JQ579N>ZX!(U?Vpq9wy| zhTq4EDZ$|Wu0$uw9SxYY@Ji}5zw{Ce#?tRbfrJgdEBiqWgO*(PXNx?8ciQj4p(mjdJniQLPFx*h0q?*Tl(AjPBGR?M@%XF6LsFJ${0=qc})32Zm zrj-O!FF2SA?O&k{5-`0;ZX-7%A*Ek(>BQYk zqkKOkMjw}ULvmJJDW}x?as$w7q!V|YKMv%Y{Nw4AUzYpQEH`n;q97h$mnF>TpH=-x zK>4z45U2=q&@<^4GHR>c#h2Aghm`&jP`)$(<;xw7Nt6~6P}VYc^G#Qh<>c&ge}J+U zT}h!c+Jy#bB%rJm*in6_X$0+EYa{{XxJH#2#+Wyz=><(y>m>o@ON83W?n|^72`Do$ zm6TlzlYlY_+mQok>2g|XNUx;8MrCUqB%sW6*dL&5C{c+avYcGo<9qUBie7$rfO67I z%4aJvmfuaB}x?yqBPQ5GRkQ*#8@#U!hN|b(TQ?Pgd2rdQm6T)mk9Tc6-e0NyHU5d+Yxlk z1)`yZMwd(WzO-In3|JFZkO((a#6ck3`_Us|5s7eXO?EW6%&M%IyGVrlKom>ZOd{L~ z)ppaXq*+ePe`1!C2=_s$m#|-i7b%20d-pCBL1N%}yLUCs#@)M$Fo_SV=p205q+kdo zFG({SAJ#mGVlxkhYRbK%mnnNk{}<7zU(M~4w%zpTHs#oiV84!OUWz52P&#m(lec62 zPlvBEyC&;((3UP5`YB~wxG>{11%zeg+C)h_7ZFeAq`_N7>1dGgI#{?Hxk>lD-i=sR z6}ys1Rr)hg8S8c7CTUAB>~5+*jA&ikc6g__n|nCS4o}?T2_4>^)JZyvcv5(O+Ats5 zvm)eL;z4X_5vR@FWw$7!(U*w#E%&Zf(s};q5R_s*bQt=OD@m;WYTl^FdY)=fB(tND z7|X7tCtX8*b9Ym8<^sEwOI7_JqNdQa+i=0)fno7RXYxNDu(C-<`ZouxEAzX9R+HRR zeMZ_R?g@9(Xe_jwsiE0XiOcBW+qPGwl5VF4jeFIJxz|CcLvAFO97T<_VngaZz^JA- zNucmBbW1vw8d@HL*_dw~l2+tm-w>U`?TI&c;DgHd&;h>5l+Pt2ZsP4$;?|1qZG(jY z#&IKQL9TH3^rRjK1;VDfuQC9bcQ;Y%iCvA@w_puYO~gWha78^SY;^U)&O*y#;*8juFF z;o_Ad{hatY3vV^2H@qdNpb{T{`!E9ilGH#xMFM8o&0PDXLFuR%#+ZR3G?)vCkAX*z z9v_WxG{U3rfApy_LQXT!N!n#AKsB}sm>T9}H;IoipBfJ@QkAA}U@kN1&|*;4tpa8# zw#t4aKAZ+(Rwc%iUQIxoFr2XBsK#k@u9_-I%CYCscPzj zs+s|lxJV50DMEat*-htwl~P^cq5#^XQLx8*4OsQ|Nl6M=_Mom=S+?Jz@TfuI!3e_* z8|h6WShi~;CF~v2;Z#Z{E1&0pQToF?o};l&wd`SAhfV1iW7)x=2pQ~yD?o;9->_NX ztwtLSVYzi=WYq(vZW{|`*)3Gv>a?3$u;n{g>mZ|y zbch~mP<1kv-6nd!MY{PND!lDd9osf5Sez$dvuhjbpf zr01wfVNikew@C+^YS!jnOvKk$>uyeRCjKR z^l1)xn934#h)=+5IBF9gyTNp@$)3>3p-tKj`A;h#dY83Tw@!Ajd0jJ|eV^=OyJSP# zrlx1t$yV-=;(;9XX))cJEIt6I(S8{Cly}5zWxK3iY?5U=WRrG>__Uj3TX<>^`PW(Z z;tZKT*OC8YB(@u@;Efc54lA|YWZar$)edWYc9Ut&HEghW=CSaaFH?p}XM_2)#q1`< zH<+wCwI(dlRspNiBERZT`^{luv2G1ISJvKw0oBu(b&zA$r;GzMvDIK5XWggvP#=(G z-7)nSb=GF;9rE@1h{{m!u<(dz+C$>gpmJJu)<4!eMAKn9k61r7KB1a$M-*;2l(*3! zJJ@Y3ulRtHnG$^0dEAXcAH9Rv)%?iXvoK9Gy&^XZ1%ZrH>g%&YX#=DnQk!y4bgIz3*TPd76PBO3x|4u z_JEazzHX)`!ypJL&D2ASfhNXWZagGIj7MaM@qj8X7&C98=3^G@4H!&dJ;RRxdBBe* z`mp#BOTl`96dH61GGEt{NI@fuA3ViJ$AJ_YA_@lR79tP&tRTa(!jBHuddRu8(I0?} zx)G6wYd|AHNTFe{$is_G{SBnhfI#HoWCN}a4Wxmrg|!7gsCN-RVuiz&0VzJ#o?yU> z-QtF))-CeH&owy@rZFj`{$_?0$25*lI-kjW#-Bf)eu%`C@hTWiXI{a|)lL0@toCXaoA%$kU z@T0-=#MGhB9gy)R*x=OwHAf|FIIQX#1IF4Nu{v?7cNQA3lm@TV2Je#^EymjA{g^vu za==}fI=l@x>YR+cLKKeI!iY0C;dy9|26^Zc2tR0q0rkV1pvyZBm-jquL=Aaps4WH#xIo!4o7jJmPr z!p3dT&d9wu3Be4Y1~+(p#L8YLx5vz8Kyctiq^TvOa7U|;SV3Hy7oImmmv<#D|BSfY z)!mqL@@DAr4~)y3luH8`(2aLN&@+<7U78sI8GU-pvSW-e0x!^s&)8A-ETl36yS&?V zdAAGQJ7YkzMPSh6DNWu&X&ek>fGkq~)#hZpg}NMB0kDAOY4S>KVG0)641l}wt{T1% z#IDYpPMx=~I&Wch!laPD70}nxvK{RItu`CWwyARfC=kDMmQ5c5Kx&xnZHC{uG$^v_ z^qI08as+@>(R(cp*|}_r?{b+NKMyo}iC{PH8 z0H6>l$G&!!%jW3;8_C<$k}Me9A^$e@1y(>~JIl6lh+?(L=d3n;5F|1huP9#*wqw6Q^tY7&uzPind7} zUE-6{t}>sx8W~@ zpL_-Wx8RQmi}-h<_(y*M|9@GgMYC>e?$7ioZcAMLuJL1dNd89uuvU}r29OCdKY`3| z{y&Q7b6)TCqWeMjT>XC2JNKS`_^$r>7W{l~GV8yZ4Z^7+`69%fg2+`Y_6s6*GQDIn z-}cVO-iu)U?s~nP3{-C5IQAy1==ClY_jwUF4dyS_S1Ja$jlIP(T*Kjd6(zad%;S+? z@cI|$z0(i8?nip}@SEPnch0)c-$zcD-KQ7N&lv^0we{`!%gKD?od>HMwB0x0b^y2} z|NY5)2DcUXYyYX;J%1M6-|F<;u3{)2L5h*Fiw$BdK7RV~(*i668DsGilD!>i@o_i` zrs+K3jsQ@D(`7M<-g-(c%TO|@!y7^LVw1lAXWXdhBx`+EVs2p&GL|!>^ivf9) z#egVP`-UQrlvfN$&MSsUregeZR1C1_^P9CYD&2!+7+b0IODVaS&#)_f*>$`miYkvR zmQ{&AkD@4-6g2?lxG%=76>|~O9P#8db0}$Gtt=fONy#*Hgru!>6m@cvbWGAwBqw!r zKb!=t&Nf=VF723XDfY?DVgwhF2xidM5=~1L?=&?lnZ<0h+}X3Z{*_d&vK+czWjCUf zfU8rWy(RT$W=YW!>~=pbA)^wTq9r75qh-AE#MLt5!rpMTrUnOB)x_FdvXn{}cn>8t z@5Z`M6$*M~3nc@j3e_fvzEtVW{ZeQfT^^h)Pr}W3FAAoRsbrk!l6GB>y7Lx~dzHui zsUw`9eTNf$3;mQXNwnfis%qy~OVx-ucFBw#>}Sr)(wO{6*+RU|QcCTp8}LcM`Dx$v zV%PSImu!=z|PMpqX<&=-}&^zNl1S*e}OcPgBGdLvU}H}a@_lZwk{REl_^GWI%W$p%g9*jw?AT|8g00~OMH z`dtZ6?fT_Ml)t@Ljq#a3?@A(hbk!{=*_Zrz#oko*=R+_+`kU^*sw=C}bBlMhsu!Eqe|O^jH~)lGSN`1b`fgQ7?aRe`L_4bv)~I(Y zm%M&AZ7tcm|F1i-a@l=6AJtXYLYPzRNFaH`js(&?G$XW%8FgnO z$*j}rOKE&p{&w{;(>^MRNx|LDv`C*9%yuT9dDsqxl8^1ct&_d@xO(FbX9+MSCZ2@ti&jocbk>gd+tDZwPTC0X0~(D9{5N5 zRxW*j$G#mqc4=iZ)};5Z3%T|F8d$P({k^?84y&3yDnWJfM}{TJ``9G5VRw_AaN1Dw zF!Uk&{PCXcV|2*>a?c8-b<0oV-Lm=3*sV|H4rAr!Xjh^;s&n3pa;zUX6phH~_uUAS z-L*L$+HIY&%G$dsR7*c5dxG=fVqrV;aP9f<_$-|4<1hQl(`&9IaRtdRoGtwIWH1fn z$fdthyEuQGSS9G#?$n`CI4P5!NkWRG3UrGL1kz0c z1qlgcI$grq%W$bmn9e0mLR^^IM6yxs80jW~1=NP)ZkxCW5>oqTsCt*)&|j@p;mM!i z_@naRR9a9fjh4KmGER&Zg`r@vL!c#*ftDvl$f6-eqg(GXNtXR(~jChN&<;Q6cGpxeFhFsG`J z&DpNgvdPV*3Cp@m?^Zg$w_5v4=>^ibr+u%vUiy>u%63-JHvAWXCk|ZqKDqF^T~`FD zKuWEG{ACSP$X`~|efa-;N^La7@$b>u)E@>PhSO27WNqkICA~N`Y@dV+Z*_Gu9#4aY zzgSFP^*{l6mKbWH+r5S3LykCp?sbA`Fq4*qXmQBcbDl4HaJHy_0(Mn~yduW+)y?2` z61?<8KD#&KZ0(cDd?7UR!iA7$cZ3#<-V1*FrhD4AJ#nI0Xd&de-||;MZ*;-r!5i$b z2rdiqaCuNrCF%s^axs6cn3z^@2c9=vcfn|p>gUg>$wX~j>e^a`%e5DMF0Xc`!DB6=%T{Zx9) zYzX)T6wvmUOaE24Sha`Y;*~d;ybz5j@+oj}UDdf6K%MO}KxbiO_;sOD>)rR>J-g_h z_sTff+BGJ=f2({M$$5r6$X0GK*odbJ?lf2$#LZLM1j(!jzbZ+|>PUE1c|~HCQk@K{ z8o7LhZdD;9Y}S=rK;4PxWaY^X2Ro6>YIBD|sd`_<+C$}_l3B@jJ60fB)v5knT5C17 z=JHwO&P7wT-^Q(8>3%V@&Tn=pJz3#$V<@%lYKzXA_ip7fGr23Gm|kWMb}4^zxv;g>wQR0hY-x~5P3g9A`1=_G%606H%{6*uR^>wCd$v3}((13)(;C|Wa=mgujq$6g*y4W# zJIFG5{^Zvuc=f8C5$C?rbmi+=^mH--NNsP1%aTUU+~3_n&$fws(PR zT9v4KU75OnUWIiFs9QhDur4(4JoEnBNZ+QXIt=g?S-llHL{Vqxe@pm-YHd~NnPb{} z>G|&}vgZap3sry2pr@!P+%zdVLH)%@`ToEs1UkW}-&E8+*;vJWyJup}N8iINK5PB; zbk&0liH}$slOdq~{RXhmpGDEBUGx&SN+=gF(_rshB8{#@g~>u@8s+Ord1YYrN?0aC zkh$GGaEjscNW;>`c#5s~z+Uv^MItKZH=~&9?*346#Bm{z9LXuISO!3*qzxl!m7+6B z)P##FuV5*_h!Xf+CUD2oaHYZDF*PW!;6-L|N{_zO1Hrg5+Oro=*3#LH9* z5&LVibScjmMVhRxm@}zSDHrp`uKPVNkFVN8y;?pp5TxT4xt4s5r-Y(W_WuqLk5>Rm&{TxG7`6SXspm2P$i& zauX#Mwi&a0Dw42?SZ+z$q`W#Q@{Nr-#~<%qorHbF=0IT|c_iZ`I<)XD zvDZ}|T=-~U!&X=?enJ6oL^Y7f%j|Z|%wm&qM&@X5zbTpa{EHpXg))<5%3N4-2i2y` zVjnt67T7l$EOyLATScsSAVuQzil+HVPLp(G-+2mo(;li6ab&r{qtFVk#mxlHE>-HIB8 zUbfQZ`9)S9T7+@}cudWk1?#JDv`UnsU=F5x!5oIh0_bB)GRlfyks9;W36&s=+0Oy^ zVrek`P2|f2_#hvpQ9g;s^~)G=C`B?EZar343?;zVub1|LP;5UhYM^fbeEkZ)(Mqxe z__UnTie-#yl{5+P^{X9MDp7KRphcBeu#~}_5-0&aC9uMJOB-7$4J5!9*Py(D7a7SY zJtV-_Cls!P*_rNKCBVm6msUP4;99ms)V;!r)Dq=1go>mjmR2yMDQdZLLd)dt4&XC{ zmRH!6=Bdjo0luW@3hOtmp=w?JB;jQoY%I?hMVhSENCJHQiU7WH_$DSM*&1*CagWWw zBqW)t@z#738cTo=IG0w#F})?gS0?v__7dRhYXGc-KHcbf;A5JZM)`h7Sm@GN1ywoIQYo+4z6^QI z51Yy@akR^_fw?q>pi{z}+=4olt=lRMB`|kc-q2dH{k$}c0nA-i_-$2^B`~MuRQJ77 z(j+iGHIc5=ba(6yuzk5 zPc2#kb4k$^)^A!v)w=wN?C-IKL>;2ir95L4X|h_QpOYG$!uc<8+{YhGZf$YqXE^m& zusjMEhQU#Qaj2<(!K8+>Ufybwl|hbqE@SK++w*Q`nK{lP5oL59v5Aqy-7ZT(AQLm3 zY>oAJLcNhGf6^{7oytZV1vS<=3-e8AERjO6MQJV<(_12iWpYnwFOkAajii-fMy*b0qO8$pS7T^p)MesJkd72WK`Z_2B}%!7 z`ZOi8JmV(H3f)2qQix@(RBocg5-HS@cl@!9`L#p}_oPU|CK4%3s8U{?B>S-BFvM_< zKju!kmoZ4fJ`$Y*`$(iPduN-b$lKYbX*TX`Q-n#JO-1M6Y$gRmdU#2i**Kf#K@^*L zFmy=ntGZ0tS2Yqfdo{OPCve&t2b*P#sLV?;3extf#v1=@fp7$V}s$V={Cad3W^6Ia2Ok#S#@9jg2q!Zlj zLkZ>w`;kwsAVo#n_K_L&F z`>4Uw&JDs`Wp65wTS#2{YTi1DeK>Z3F_@kqXW9GFCFvY$XtfWsF#p)67UUxTGU{hL z?n&kcYPSG{={bLPa4IGpN`2)I$cW6(4p2FAKXG&5#qEhVci_X7*ml9nkV{6~ z);L>E!X+($unX^85UXECX+}4pMVDH^J%P5kJP|HIJnM&D+g6udiFmby{U+ocP0#eb zd*25?=Pzd}@oSz~B=e&i_WX6=;gx!d;B8H?4(=vv6$x8oWUe7x%;(+A;pibe-4p2T zIA2w%<7Hs-drKv*ua@CUCS$Y;y(>7tI1N;!;PT?`&V$!fRw2B-G=ZBJZ%8=hdU ze!K~9qKOLv)z2?`v*B#$EyBqPGI~QD4`jh?xOk<=J|}+8!duPd4Q~nJRpR4sA4Z^G zk{ZYd17-m+2?HjL8H2PG!YcF<2w=n~I(Pt~6rp_3%6`#EjqpD`$e)=Gv`(;1o;>{e5SzX|w06d~0 zqsMyln71J`0~6 zlZhI2QqE>d*eA?HOi}xUc-C8_biGCKHY{~uli~F@ruc!)`IE8i6VlUmsLBS+5cLsN zO?^PM(HJq~j!2(ij0UoTfOwAJ1$V9IXh>n(WxAaZy={}NMguBKyF-rLVin&UQn~6a zDp$Ql@pg;KVz;PX2E2mnOotQf94y`_oqX6nAw6w}=w0p)V=7~lHJ%221*~99 zc>~svMkA_68KiDTkZ`)MA9h>am4w%kNt}~>%wgcu@b>#n;1T{!`yOBcBVYO*D z$ijAmH1GJNq1|AbH<%`@L$h6qcgD=xE)P=;@?OQ}9ch!i!Wp9uSh}qOR)^J5CqO^R zVFG<0nisl$_CXo5b}}BJX4aVcCdj}#KetVe=CJQWopp*Xa}Xz>2Iq`WS*z|ald#5A zXAa(BW_DQz=1`$6Cm^LeLy|ROMjErKcA1m9uz5i{vfE+q(8hT2WhJKd0aLm|UOlE( zCO$1x$|n21H~9#OzTMD0k%QI)YBqJ&B*s*K76?GC+XHgM7H}^W``dqRDWY=HrgAnV7Jdw4WSjwg58e>p1ICTM=D=XgxzTt;x70p zLIs{e-w=_4HO!^Ac^%RKNXW?P2*9uCnE1gr@*Xz&9m+%X$`YSxJ9MuR-a!`n%N1{gvP^U_8gO)B!lip^47 z?u!kY-$5SwFp3|XHO*5Xg(e~JgFYMZqs=_KK^_MwusfZMNFR7e;ay5&#D&_N8_gvl zkI%UcSgUh61DCUQN6Zyn-cns&S?*}8H!Fef1WW@rU|ovK4e!$IQTQ8Ihc{@KcdIV% zUtHd)xxBW)Qe-!m8^pDlsa$Ry*XD{k$N<}!8346uHVHqtBe>iVT$;cE8O_4rN36|o zCv|y`;L_&~^6=rNOYBJA8@osW! zH@RETG#~QNJQjY?ghu>eJp$;)Shsl!OA_KiXXD4hqF0 zn*qoK=Pj_Qy1aS2G}{L<8pDVm+*a^YF+l#7-DY1}n~H4J8MNRKzy>%U)&-1}(HmfV ziHxi|H9X5^V{Y4FG(%L)s?#^w8uMNZyjrVlHHY~1u$nFWxPn6XWdw!rJ7uxvX1N4` zf&fMjheef1U~o;c+N1^ zFUz!OzG}_=nLZY4i3@WTI`sxT$a$lGSgXl*1IPrK1;a;=HIc}?QXIdgBHwy{GM`QE z-t*V~FNg8CkDq@06yx5G=spfd!892uPe)_qJ8r7e)ue0t$|C1_>^Rx`yG`#%{cKSp6jd9 z!Wj~cM4t02{Ny?}Y%GE2cw5|v*u7hX%k>Iv@s__{FDHYWbwF`HAP;j7p{CV=ZlwMq LKjsaw;EMl0mCIOi diff --git a/src/mcmc_binomial.cpp b/src/mcmc_binomial.cpp index fc38e12..18101a1 100644 --- a/src/mcmc_binomial.cpp +++ b/src/mcmc_binomial.cpp @@ -36,7 +36,46 @@ #include "ParOutBinomial.h" #include "PostOutBinomialInd.h" - +//' Performs MCMC sampling for mixtures of Binomial distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a Binomial mixture +//' model. In addition an `mcmcoutput` object is given that stores the output +//' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +//' so-called "mixin" layers that help to design a software by organizing code +//' into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the Binomial finite mixture +//' model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_binomial_cc(SEXP fdata_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_condpoisson.cpp b/src/mcmc_condpoisson.cpp index 33da2be..844c63c 100644 --- a/src/mcmc_condpoisson.cpp +++ b/src/mcmc_condpoisson.cpp @@ -41,7 +41,46 @@ #include "PostOutCondPoissonFix.h" #include "PostOutCondPoissonInd.h" - +//' Performs MCMC sampling for mixtures of conditional Poisson distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a conditional Poisson +//' mixture model. In addition an `mcmcoutput` object is given that stores the +//' output of MCMC sampling in R memory. Note that `finmix` relies in C++ code +//' on so-called "mixin" layers that help to design a software by organizing +//' code into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the conditional Poisson finite mixture +//' model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_condpoisson_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_exponential.cpp b/src/mcmc_exponential.cpp index a5de543..b859c83 100644 --- a/src/mcmc_exponential.cpp +++ b/src/mcmc_exponential.cpp @@ -40,7 +40,46 @@ #include "PostOutExponentialFix.h" #include "PostOutExponentialInd.h" - +//' Performs MCMC sampling for mixtures of Exponential distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a Exponential mixture +//' model. In addition an `mcmcoutput` object is given that stores the output +//' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +//' so-called "mixin" layers that help to design a software by organizing code +//' into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the Exponential finite mixture +//' model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_exponential_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_normal.cpp b/src/mcmc_normal.cpp index 74ceacb..3ce6b99 100644 --- a/src/mcmc_normal.cpp +++ b/src/mcmc_normal.cpp @@ -20,6 +20,46 @@ #include "LogNormalInd.h" #include "PostOutNormalInd.h" +//' Performs MCMC sampling for mixtures of Normal distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a Normal mixture +//' model. In addition an `mcmcoutput` object is given that stores the output +//' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +//' so-called "mixin" layers that help to design a software by organizing code +//' into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the Normal finite mixture +//' model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_normal_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_normult.cpp b/src/mcmc_normult.cpp index 7f05e32..eeac1a2 100644 --- a/src/mcmc_normult.cpp +++ b/src/mcmc_normult.cpp @@ -20,6 +20,46 @@ #include "LogNormultInd.h" #include "PostOutNormultInd.h" +//' Performs MCMC sampling for mixtures of multivariate Normal distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a multivariate Normal +//' mixture model. In addition an `mcmcoutput` object is given that stores the +//' output of MCMC sampling in R memory. Note that `finmix` relies in C++ code +//' on so-called "mixin" layers that help to design a software by organizing +//' code into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the multivariate Normal finite +//' mixture model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_normult_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_poisson.cpp b/src/mcmc_poisson.cpp index c25744f..ebbee2b 100644 --- a/src/mcmc_poisson.cpp +++ b/src/mcmc_poisson.cpp @@ -40,6 +40,46 @@ #include "PostOutPoissonInd.h" +//' Performs MCMC sampling for mixtures of Poisson distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a Poisson mixture +//' model. In addition an `mcmcoutput` object is given that stores the output +//' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +//' so-called "mixin" layers that help to design a software by organizing code +//' into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the Poisson finite mixture +//' model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_poisson_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_student.cpp b/src/mcmc_student.cpp index a2f15cb..29fe647 100644 --- a/src/mcmc_student.cpp +++ b/src/mcmc_student.cpp @@ -20,6 +20,46 @@ #include "LogStudentInd.h" #include "PostOutStudentInd.h" +//' Performs MCMC sampling for mixtures of Student-t distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a Student-t mixture +//' model. In addition an `mcmcoutput` object is given that stores the output +//' of MCMC sampling in R memory. Note that `finmix` relies in C++ code on +//' so-called "mixin" layers that help to design a software by organizing code +//' into layers that build upon each others and enable modularity in MCMC +//' sampling by allowing to combine different sampling designs, e.g. with or +//' without a hierarchical prior, with fixed indicators or storing posterior +//' density parameters. See for more information on mixin layers Smaragdakis +//' and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the Student-t finite mixture +//' model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 A `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_student_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/mcmc_studmult.cpp b/src/mcmc_studmult.cpp index a4a0b6b..ec5aa68 100644 --- a/src/mcmc_studmult.cpp +++ b/src/mcmc_studmult.cpp @@ -20,6 +20,46 @@ #include "LogStudmultInd.h" #include "PostOutStudmultInd.h" +//' Performs MCMC sampling for mixtures of multivariate Student-t distributions +//' +//' @description +//' For internal usage only. This function gets passed the `fdata`, `model`, +//' `prior`, `mcmc` objects to perform MCMC sampling for a multivriate +//' Student-t mixture model. In addition an `mcmcoutput` object is given that +//' stores the output of MCMC sampling in R memory. Note that `finmix` relies +//' in C++ code on so-called "mixin" layers that help to design a software by +//' organizing code into layers that build upon each others and enable +//' modularity in MCMC sampling by allowing to combine different sampling +//' designs, e.g. with or without a hierarchical prior, with fixed indicators +//' or storing posterior density parameters. See for more information on mixin +//' layers Smaragdakis and Butory (1998). +//' +//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param model_S4 A `model` object specifying the multivariate Student-t +//' finite mixture model. +//' @param prior_S4 A `prior` object specifying the prior distribution for MCMC +//' sampling. +//' @param mcmc_S4 An `mcmc` object specifying the hyper-parameters for MCMC +//' sampling. +//' @param mcmcoutput_S4 An `mcmcoutput` object storing the outcomes from MCMC +//' sampling using R memory. +//' @return An `mcmcoutput` object containing the results from MCMC sampling +//' and using the R memory from the input argument `mcmcoutput_S4`. +//' @export +//' +//' @seealso +//' * [mixturemcmc()] for performing MCMC sampling +//' * [fdata][fdata_class] for the `fdata` class definition +//' * [model][model_class] for the `model` class definition +//' * [prior][prior_class] for the `prior` class definition +//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' +//' @references +//' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with +//' mixin layers." In: Jul E. (eds) ECOOP’98 — Object-Oriented Programming. +//' ECOOP 1998. Lecture Notes in Computer Science, vol 1445. Springer, +//' Berlin, Heidelberg. +// [[Rcpp::export]] RcppExport SEXP mcmc_studmult_cc(SEXP data_S4, SEXP model_S4, SEXP prior_S4, SEXP mcmc_S4, SEXP mcmcoutput_S4) { diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index 5959d62..bf84f0d 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -34,26 +34,39 @@ // Stephens Relabeling Algorithm (1997a) // ------------------------------------------------------------ -/** - * ------------------------------------------------------------ - * stephens1997a_poisson_cc - * @brief Defines Stephens (1997a) relabelling algorithm for - * Poisson models. The nlopt library is used for - * optimization (Nelder-Mead algorithm) - * @par values1 sampled lambda parameters; M x K - * @par values2 sampled weight parameters; M x K - * @par pars Gamma and Dirichlet hyper parameters - * @par perm matrix with all possible permutations of labels; - * @return matrix indicating the optimal labeling of sampled - * parameters; M x K - * @detail See Stephens (1997a) - * @see nlopt - * @author Lars Simon Zehnder - * ------------------------------------------------------------ - **/ - +//' Relabeling algorithm from Stephens (1997a) for Poisson mixture models +//' +//' @description +//' For internal usage only. This function runs the re-labeling algorithm from +//' Stephens (1997a) for MCMC samples of a Poisson mixture distribution. For +//' optimization a Nelder-Mead-Algorithm from the NLopt library is used. This +//' is also the reason why the package depends on the `nloptr` package which +//' provides a header file for direct access to the C routines. +//' +//' @param values1 A matrix containing the sampled component parameters +//' `lambda`. +//' @param values2 A matrix containing the sampled weights. +//' @param pars A vector containing the parameters of the prior distributions +//' of the component parameters and weights. More specifically, the +//' parameters of the Dirichlet distribution for the weights and the +//' shape and rate parameters for the Gamma distributions of the component +//' parameters. +//' @param perm A matrix with all possible permutations of the labels. +//' @return A matrix of dimension `MxK` that holding the optimal labeling. +//' @export +//' +//' @seealso +//' * \code{\link{mcmcpermute}} for the calling function +//' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +//' Stephens (1997b) +//' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +//' for mixtures of Binomial distributions +//' +//' @references +//' * Stephens, Matthew (1997a), Discussion of "On Bayesian Analysis of +//' Mixtures with an Unknown Number of Components", Journal of the Royal +//' Statistical Society: Series B (Statistical Methodology), 59: 731-792. // [[Rcpp::export]] - arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm) @@ -126,27 +139,38 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, return arma::conv_to::from(index); } - -/** - * ------------------------------------------------------------ - * stephens1997a_poisson_cc - * @brief Defines Stephens (1997a) relabelling algorithm for - * Binomial models. The nlopt library is used for - * optimization (Nelder-Mead algorithm) - * @par values1 sampled lambda parameters; M x K - * @par values2 sampled weight parameters; M x K - * @par pars Beta and Dirichlet hyper parameters - * @par perm matrix with all possible permutations of labels; - * @return matrix indicating the optimal labeling of sampled - * parameters; M x K - * @detail See Stephens (1997a) - * @see nlopt - * @author Lars Simon Zehnder - * ------------------------------------------------------------ - **/ - +//' Relabeling algorithm from Stephens (1997a) for Binomial mixture models +//' +//' @description For internal usage only. This function runs the re-labeling +//' algorithm from Stephens (1997a) for MCMC samples of a Binomial mixture +//' distribution. For optimization a Nelder-Mead-Algorithm from the NLopt +//' library is used. This is also the reason why the package depends on the +//' `nloptr` package which provides a header file for direct access to the C +//' routines. +//' +//' @param values1 A matrix containing the sampled component parameters `p`. +//' @param values2 A matrix containing the sampled weights. +//' @param pars A vector containing the parameters of the posterior +//' distributions of the component parameters and weights. More specifically, +//' the parameters of the Dirichlet distribution for the weights and the shape +//' and rate parameters for the Beta distributions of the component +//' parameters. +//' @param perm A matrix with all possible permutations of the labels. +//' @return A matrix of dimension `MxK` that holding the optimal labeling. +//' @export +//' +//' @seealso +//' * \code{\link{mcmcpermute}} for the calling function +//' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +//' Stephens (1997b) +//' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +//' for mixtures of Binomial distributions +//' +//' @references +//' * Stephens, Matthew (1997a), Discussion of "On Bayesian Analysis of +//' Mixtures with an Unknown Number of Components", Journal of the Royal +//' Statistical Society: Series B (Statistical Methodology), 59: 731-792. // [[Rcpp::export]] - arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, Rcpp::NumericMatrix values2, arma::vec pars, const arma::umat perm) @@ -227,8 +251,34 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, return arma::conv_to::from(index); } +//' Relabeling algorithm from Stephens (1997b) for Poisson mixture models +//' +//' @description +//' For internal usage only. This function runs the re-labeling algorithm from +//' Stephens (1997b) for MCMC samples of a Poisson mixture distribution. +//' +//' @param values A matrix of observations of dimension `Nx1`. +//' @param comp_par An array of component parameter samples from MCMC sampling. +//' Dimension is `MxK`. +//' @param weight An array of weight parameter samples from MCMC sampling. +//' Dimension is `MxK`. +//' @param max_iter A signed integer specifying the number of iterations to be +//' run in optimization. Unused. +//' @return An integer matrix of dimension `MxK` that holding the optimal +//' labeling. +//' @export +//' +//' @seealso +//' * \code{\link{mcmcpermute}} for the calling function +//' * \code{\link{stephens1997a_poisson_cc}} for the re-labeling algorithm from +//' Stephens (1997a) +//' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +//' for mixtures of Binomial distributions +//' +//' @references +//' * Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +//' distributions, DPhil Thesis, University of Oxford, Oxford. // [[Rcpp::export]] - arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par, @@ -328,8 +378,34 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, return arma::conv_to::from(index_out); } +//' Relabeling algorithm from Stephens (1997b) for Binomial mixture models +//' +//' @description +//' For internal usage only. This function runs the re-labeling algorithm from +//' Stephens (1997b) for MCMC samples of a Binomial mixture distribution. +//' +//' @param values A matrix of observations of dimension `Nx1`. +//' @param comp_par An array of component parameter samples from MCMC sampling. +//' Dimension is `MxK`. +//' @param weight An array of weight parameter samples from MCMC sampling. +//' Dimension is `MxK`. +//' @param max_iter A signed integer specifying the number of iterations to be +//' run in optimization. Unused. +//' @return An integer matrix of dimension `MxK` that holding the optimal +//' labeling. +//' @export +//' +//' @seealso +//' * \code{\link{mcmcpermute}} for the calling function +//' * \code{\link{stephens1997a_binomial_cc}} for the re-labeling algorithm from +//' Stephens (1997a) +//' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +//' for mixtures of Poisson distributions +//' +//' @references +//' * Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +//' distributions, DPhil Thesis, University of Oxford, Oxford. // [[Rcpp::export]] - arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, Rcpp::NumericVector reps, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par) @@ -429,8 +505,34 @@ arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, return arma::conv_to::from(index_out); } +//' Relabeling algorithm from Stephens (1997b) for Exponential mixture models +//' +//' @description +//' For internal usage only. This function runs the re-labeling algorithm from +//' Stephens (1997b) for MCMC samples of a Exponential mixture distribution. +//' +//' @param values A matrix of observations of dimension `Nx1`. +//' @param comp_par An array of component parameter samples from MCMC sampling. +//' Dimension is `MxK`. +//' @param weight An array of weight parameter samples from MCMC sampling. +//' Dimension is `MxK`. +//' @param max_iter A signed integer specifying the number of iterations to be +//' run in optimization. Unused. +//' @return An integer matrix of dimension `MxK` that holding the optimal +//' labeling. +//' @export +//' +//' @seealso +//' * \code{\link{mcmcpermute}} for the calling function +//' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +//' for mixtures of Poisson distributions +//' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +//' for mixtures of Binomial distributions +//' +//' @references +//' * Stephens, Matthew (1997a), Bayesian methods for mixtures of normal +//' distributions, DPhil Thesis, University of Oxford, Oxford. // [[Rcpp::export]] - arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, Rcpp::NumericMatrix comp_par, Rcpp::NumericMatrix weight_par) @@ -528,5 +630,4 @@ arma::imat stephens1997b_exponential_cc(Rcpp::NumericVector values, delete mat_vector[m]; } return arma::conv_to::from(index_out); -} - +} \ No newline at end of file diff --git a/tests/.test.mixturemcmc.poisson.R.swp b/tests/.test.mixturemcmc.poisson.R.swp deleted file mode 100644 index 1f99264b4d09992ecbf7c4c3da9803ff6440f9a0..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12288 zcmeI2O>fjj7{@0O7q`4r^vGrKa_~ydWW71GLPQFO1Vs>}k_7coRdVbJJ7oP*dzK`i z1P~v9146y`MWRx_1*fXLRqCbpeuZB9e3Q#J^Wk)DbGyl6bL%uKp zCcp%k025#WOn?b60Vco%m;e)C0%wpwoC@*Q6XM5DP(1$r-~Rvq&r6txzK0${eW(Nd zdr^o#px4khPy}6p&O;tF1O0wMh+m*r&fzGuHf`hH=JGgjO)f4rwxRT0F@1k(WEJP7t}=>Wxp`-Oxebpfywi~zIN~akxYo7o zbcEN`FK^7ri4(6u8rwL`sGzW{Oi_gt2LrlLtg5x$EENp{OuHDGcQ>iV$y$BnA)N_A zkg%GkCRs6i!O>iFq0ZyT%USBo|#Wg3y#_$a>rCU2hyQx2~-< z`Gf1ir&GOZW%X;-_sMK~lqc2{dC-+l@XvSQRT?LKbH^HXo~OnPj}W@a+7^{wS9onN zlx|QKu*JB+d<@4?*@C6XoA@=lMm?7qR~DOPGSQ!)Ijur@Tq1!%Ib&e%CQzxtqAp6m zIjHQ1Qr*V5-xXtT%A95{JP>FR5a6yy47{y}koVNl^9W_oEz z#539~m5x)D)Q|CIaZ}^s=xrZXU30|!M0qazo%+U}A5b5@ bZnv~W7j{6uRoYEQ7AN=I@t4=Zqi+5KhjZfF diff --git a/tests/doRUnit.R b/tests/doRUnit.R deleted file mode 100644 index 5fc62bd..0000000 --- a/tests/doRUnit.R +++ /dev/null @@ -1,71 +0,0 @@ -## Unit tests will not be done if RUnit is not available ## -if (require("RUnit", quietly = TRUE)) { - - ## --- Setup --- ## - - pkg <- "finmix" - if (Sys.getenv("RCMDCHECK") == "FALSE") { - ## Path to unit tests for standalone running under - ## Makefile (not R CMD check) - ## finmix/tests/../inst/unitTests - path <- file.path(getwd(), "..", "inst", "unitTests") - } else { - ## Path to unit tests for R CMD check - ## finmix.Rcheck/tests/../finmix/unitTests - path <- system.file(package = pkg, "unitTests") - } - cat("\nRunning unit tests\n") - print(list(pkg = pkg, getwd = getwd(), pathToUnitTests = path)) - - library(package = pkg, character.only = TRUE) - - ## If desired, load the name space to allow testing of private - ## functions - ## if (is.element(pkg, loadedNamespaces())) - ## attach(loadNamespace(pkg), name=paste("namespace", pkg, - ## sep=":"), pos=3) - ## - ## or simply call PKG:::MyPrivateFuncion() in tests - - ## --- Testing --- ## - - ## Define tests - testSuite <- defineTestSuite( - name = paste(pkg, "unit testing"), - dirs = path - ) - - ## Run - tests <- runTestSuite(testSuite) - - ## Default report name - pathReport <- file.path(path, "report") - - ## Report to stdout and text files - cat("--------------------- UNIT TEST SUMMARY -------------------------\n\n") - printTextProtocol(tests, showDetails = FALSE) - printTextProtocol(tests, - showDetails = FALSE, - fileName = paste(pathReport, "Summary.txt", sep = "") - ) - printTextProtocol(tests, - showDetails = TRUE, - fileName = paste(pathReport, ".txt", sep = "") - ) - - ## Report to HTML file - printHTMLProtocol(tests, fileName = paste(pathReport, ".html", sep = "")) - - ## Return stop() to cause R CMD check stop in case of - ## - failure i.e. FALSE to unit tests or - ## - errors i.e. R errors - tmp <- getErrors(tests) - if (tmp$nFail > 0 | tmp$nErr > 0) { - stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, - ", #R errors: ", tmp$nErr, ")\n\n", - sep = "" - )) - } -} else { - warning("cannot run unit tests -- package RUnit is not available") -} From 005ec1d430159be01adcad6b9eec19c3dd820fdb Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Tue, 5 Oct 2021 09:36:11 +0200 Subject: [PATCH 11/24] Fixed a bug in subseq() --- R/mcmcoutputfixhier.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index 8099900..4e2e61e 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -1478,7 +1478,7 @@ setMethod( #' @seealso #' * [subseq()] for the calling method ".subseq.Poisson.Hier" <- function(obj, index) { - obj@hyper$b <- array(obj@hyper$b[index], + obj@hyper$b <- array(obj@hyper$b[index,], dim = c(obj@M, 1) ) return(obj) @@ -1501,7 +1501,7 @@ setMethod( #' @seealso #' * [subseq()] for the calling method ".subseq.Norstud.Hier" <- function(obj, index) { - obj@hyper$C <- array(obj@hyper$C[index], + obj@hyper$C <- array(obj@hyper$C[index,], dim = c(obj@M, 1) ) return(obj) From 41a4d08ca628aa4b8bbcfb12fad79fd1df92e2e8 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Wed, 6 Oct 2021 11:41:05 +0200 Subject: [PATCH 12/24] Fixed bugs that occurred during R CMD check in the examples. --- NAMESPACE | 3 + R/AllGenerics.R | 2 +- R/csdatamoments.R | 2 +- R/groupmoments.R | 4 +- R/mcmcoutputbase.R | 30 +- R/mcmcoutputfix.R | 8 +- R/mcmcoutputfixhier.R | 2 +- R/mcmcoutputfixhierpost.R | 3 +- R/mcmcoutputpermfix.R | 30 +- R/mcmcoutputpermfixhier.R | 19 +- R/mcmcoutputpermfixhierpost.R | 22 +- R/mcmcoutputpermfixpost.R | 304 ++++++++- R/mcmcoutputpermhier.R | 15 +- R/mcmcoutputpost.R | 2 +- R/mcmcpermfixhier.R | 81 +++ R/mcmcpermfixpost.R | 6 +- R/mcmcpermindhier.R | 76 +++ R/prior.R | 10 +- R/sdatamoments.R | 2 +- man/csdatamoments-class.Rd | 24 + man/groupmoments-class.Rd | 24 + man/groupmoments.Rd | 9 + ...initialize-mcmcoutputpermfixpost-method.Rd | 45 ++ man/initialize-mcmcoutputpermhier-method.Rd | 1 + man/mcmcoutput_class.Rd | 18 +- man/mcmcoutputperm-class.Rd | 28 + man/mcmcoutputperm_class.Rd | 580 +----------------- man/mcmcoutputpermfix-class.Rd | 238 ++++++- man/mcmcoutputpermfixhier-class.Rd | 4 +- man/mcmcoutputpermfixpost-class.Rd | 3 + man/plotDens-mcmcoutputpermfixhier-method.Rd | 56 ++ ...otDens-mcmcoutputpermfixhierpost-method.Rd | 56 ++ man/plotDens-mcmcoutputpermfixpost-method.Rd | 58 ++ man/plotHist-mcmcoutputpermfixhier-method.Rd | 56 ++ ...otHist-mcmcoutputpermfixhierpost-method.Rd | 56 ++ man/plotHist-mcmcoutputpermfixpost-method.Rd | 58 ++ ...ntProc-mcmcoutputpermfixhierpost-method.Rd | 55 ++ ...tPointProc-mcmcoutputpermfixpost-method.Rd | 57 ++ ...stDens-mcmcoutputpermfixhierpost-method.Rd | 55 ++ ...otPostDens-mcmcoutputpermfixpost-method.Rd | 57 ++ ...ampRep-mcmcoutputpermfixhierpost-method.Rd | 55 ++ ...lotSampRep-mcmcoutputpermfixpost-method.Rd | 54 ++ ...plotTraces-mcmcoutputpermfixhier-method.Rd | 63 ++ ...Traces-mcmcoutputpermfixhierpost-method.Rd | 65 ++ ...plotTraces-mcmcoutputpermfixpost-method.Rd | 65 ++ man/prior-class.Rd | 4 +- man/sdatamoments.Rd | 9 + man/show-mcmcoutputpermfixpost-method.Rd | 19 + man/subseq-mcmcoutputfix-array-method.Rd | 23 + man/subseq-mcmcoutputfixhier-array-method.Rd | 23 + 50 files changed, 1888 insertions(+), 651 deletions(-) create mode 100644 R/mcmcpermfixhier.R create mode 100644 R/mcmcpermindhier.R create mode 100644 man/csdatamoments-class.Rd create mode 100644 man/groupmoments-class.Rd create mode 100644 man/initialize-mcmcoutputpermfixpost-method.Rd create mode 100644 man/mcmcoutputperm-class.Rd create mode 100644 man/plotDens-mcmcoutputpermfixhier-method.Rd create mode 100644 man/plotDens-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/plotDens-mcmcoutputpermfixpost-method.Rd create mode 100644 man/plotHist-mcmcoutputpermfixhier-method.Rd create mode 100644 man/plotHist-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/plotHist-mcmcoutputpermfixpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermfixpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermfixpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermfixpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermfixhier-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermfixpost-method.Rd create mode 100644 man/show-mcmcoutputpermfixpost-method.Rd create mode 100644 man/subseq-mcmcoutputfix-array-method.Rd create mode 100644 man/subseq-mcmcoutputfixhier-array-method.Rd diff --git a/NAMESPACE b/NAMESPACE index 2817a13..e2b2aa7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,6 +35,7 @@ export(stephens1997a_poisson_cc) export(stephens1997b_binomial_cc) export(stephens1997b_exponential_cc) export(stephens1997b_poisson_cc) +export(subseq) export(swapInd_cc) export(swapInteger_cc) export(swapST_cc) @@ -149,6 +150,7 @@ exportMethods(hasS) exportMethods(hasT) exportMethods(hasWeight) exportMethods(hasY) +exportMethods(initialize) exportMethods(mixturemar) exportMethods(moments) exportMethods(plot) @@ -160,6 +162,7 @@ exportMethods(plotSampRep) exportMethods(plotTraces) exportMethods(show) exportMethods(simulate) +exportMethods(subseq) import(graphics) import(methods) import(nloptr) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 180f937..3c36886 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -337,7 +337,7 @@ setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSamp #' @describeIn mcmcoutput_class setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPostDens")) -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutput_class setGeneric("subseq", function(object, index) standardGeneric("subseq")) #' @describeIn mcmcoutput_class diff --git a/R/csdatamoments.R b/R/csdatamoments.R index b2c723d..e48b1da 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -124,7 +124,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn csdatamoments_class +#' @describeIn csdatamoments-class Shows a short summary of the object's slots. setMethod( "show", "csdatamoments", function(object) { diff --git a/R/groupmoments.R b/R/groupmoments.R index c76a390..84cad67 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -74,7 +74,7 @@ #' @export #' @name groupmoments #' -#' @example +#' @examples #' # Define a mixture model with exponential components. #' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) #' # Simulate data from the mixture model. @@ -148,7 +148,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn groupmoments_class +#' @describeIn groupmoments-class Shows a short summary of the object's slots setMethod( "show", "groupmoments", function(object) { diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index f89e18a..452a3b7 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -22,7 +22,7 @@ #' @description #' This class defines the basic slots for the MCMC sampling output when #' indicators are not known. It inherits from the -#' [mcmcoutfix][mcmcoutput_class]. +#' [mcmcoutputfix-class]. #' #' @slot weight An `array` of dimension `M x K` containing the sampled #' weights. @@ -41,7 +41,7 @@ #' indicators defining the last "clustering" of observations into the #' mixture components. #' @exportClass mcmcoutputbase -#' @describeIn mcmcoutput_class +#' @rdnam mcmcoutputbase-class .mcmcoutputbase <- setClass("mcmcoutputbase", representation( weight = "array", @@ -75,7 +75,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class Shows a short summary of the object's slots setMethod( "show", "mcmcoutputbase", function(object) { @@ -146,7 +146,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -220,7 +220,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -272,7 +272,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -323,7 +323,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point processes of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -370,7 +370,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representations of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -417,7 +417,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @describeIn mcmcoutputbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -528,7 +528,7 @@ setMethod( #' getWeight(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput][mcmcoutputbase-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getWeight", "mcmcoutputbase", @@ -562,7 +562,7 @@ setMethod( #' getEntropy(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput][mcmcoutputbase-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getEntropy", "mcmcoutputbase", @@ -596,7 +596,7 @@ setMethod( #' getST(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput][mcmcoutputbase-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getST", "mcmcoutputbase", @@ -630,7 +630,7 @@ setMethod( #' getS(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput][mcmcoutputbase-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getS", "mcmcoutputbase", @@ -664,7 +664,7 @@ setMethod( #' getNK(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput][mcmcoutputbase-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getNK", "mcmcoutputbase", @@ -698,7 +698,7 @@ setMethod( #' getClust(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput][mcmcoutputbase-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getClust", "mcmcoutputbase", diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index 95365c9..0f35417 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -470,7 +470,7 @@ setMethod( #' @param object An `mcmcoutput` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. -#' @noRd +#' @exportMethod subseq setMethod( "subseq", signature( object = "mcmcoutputfix", @@ -2498,10 +2498,10 @@ setMethod( #' @seealso #' * [subseq()] for the calling method ".subseq.Log.Fix" <- function(obj, index) { - obj@log$mixlik <- matrix(obj@log$mixlik[index], + obj@log$mixlik <- matrix(obj@log$mixlik[index,], nrow = obj@M, ncol = 1 ) - obj@log$mixprior <- matrix(obj@log$mixprior[index], + obj@log$mixprior <- matrix(obj@log$mixprior[index,], nrow = obj@M, ncol = 1 ) return(obj) @@ -2528,7 +2528,7 @@ setMethod( nrow = obj@M, ncol = 1 ) } else { - obj@par$lambda <- obj@par$lambda[index, ] + obj@par$lambda <- obj@par$lambda[index,] } return(obj) } diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index 4e2e61e..db6fcd7 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -434,7 +434,7 @@ setMethod( #' @param object An `mcmcoutput` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. -#' @noRd +#' @exportMethod subseq setMethod( "subseq", signature( object = "mcmcoutputfixhier", diff --git a/R/mcmcoutputfixhierpost.R b/R/mcmcoutputfixhierpost.R index e72b9ed..7f97531 100644 --- a/R/mcmcoutputfixhierpost.R +++ b/R/mcmcoutputfixhierpost.R @@ -418,6 +418,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @noRd +#' @export subseq setMethod( "subseq", signature( object = "mcmcoutputfixhierpost", @@ -427,7 +428,7 @@ setMethod( ## TODO: Check arguments via .validObject ## dist <- object@model@dist ## Call 'subseq()' from 'mcmcoutputfixhier' - callNextMethod(object, index) + object <- callNextMethod(object, index) ## post ## if (dist == "poisson") { .subseq.Poisson.Post(object, index) diff --git a/R/mcmcoutputpermfix.R b/R/mcmcoutputpermfix.R index 708b290..442eb29 100644 --- a/R/mcmcoutputpermfix.R +++ b/R/mcmcoutputpermfix.R @@ -32,10 +32,10 @@ #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermfix -#' @describeIn mcmcoutputperm_class +#' @rdname mcmcoutputpermfix-class #' @seealso -#' * [mcmcoutputfix][mcmcoutput_class] for the parent class -#' * [mcmcpermfix][mcmcperm_class] for the parent class +#' * [mcmcoutputfix-class] for the parent class +#' * [mcmcpermfix-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermfix <- setClass("mcmcoutputpermfix", contains = c("mcmcpermfix", "mcmcoutputfix"), @@ -95,7 +95,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class setMethod( "show", "mcmcoutputpermfix", function(object) { @@ -153,7 +153,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -225,9 +225,10 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class #' #' @examples +#' \dontrun{} #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -243,6 +244,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotHist(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -279,9 +281,10 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -297,6 +300,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -333,9 +337,10 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -351,6 +356,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPointProc(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -387,9 +393,10 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling represetnation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -405,6 +412,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotSampRep(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -441,9 +449,10 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfix-class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -459,6 +468,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPostDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index 5d01d25..b933a6c 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -32,10 +32,10 @@ #' Note this class inherits all slots from its parent classes. #' #' @exportClass mcmcoutputpermfixhier -#' @describeIn mcmcoutputperm_class +#' @rdname mcmcoutputpermfixhier-class #' @seealso -#' * [mcmcoutputpermfix][mcmcoutputperm_class] for the parent class -#' * [mcmcpermfix][mcmcperm_class] for the parent class +#' * [mcmcoutputpermfix-class] for the parent class +#' * [mcmcpermfix-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermfixhier <- setClass("mcmcoutputpermfixhier", contains = c("mcmcpermfixhier", "mcmcoutputfixhier"), @@ -99,7 +99,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfixhier-class setMethod( "show", "mcmcoutputpermfixhier", function(object) { @@ -165,9 +165,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -181,6 +181,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotTraces(f_outputperm, lik = 0) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -239,9 +240,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -255,6 +256,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotHist(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -295,9 +297,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -311,6 +313,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -462,6 +465,7 @@ setMethod( #' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -475,6 +479,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPostDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index d3f10f5..920126b 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -69,7 +69,7 @@ #' hierarchical prior. #' @param postperm A named list containing a named list `par` with array(s) of #' parameters from the posterior density. -#' +#' @exportMethod initialize #' @keywords internal #' #' @seealso @@ -108,7 +108,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermfixhierpost-class setMethod( "show", "mcmcoutputpermfixhierpost", function(object) { @@ -184,9 +184,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -200,6 +200,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotTraces(f_outputperm, lik = 0) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -258,9 +259,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -274,6 +275,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotHist(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -314,9 +316,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -330,6 +332,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -369,9 +372,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -385,6 +388,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPointProc(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -424,9 +428,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampliing representations of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -440,6 +444,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotSampRep(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -479,9 +484,9 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) @@ -495,6 +500,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPostDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index 5ef29c3..c91f420 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -22,7 +22,8 @@ #' It inherits from the #' #' @exportClass mcmcoutputpermfixpost -#' @describeIn mcmcoutputperm_class +#' @rdname mcmcoutputpermfixpost-class +#' @seealso .mcmcoutputpermfixpost <- setClass("mcmcoutputpermfixpost", contains = c( "mcmcpermfixpost", @@ -34,6 +35,31 @@ } ) +#' Initializer of the `mcmcoutputpermfixhier` class +#' +#' @description +#' Only used implicitly. The initializer stores the data into the slots of the +#' passed-in object. +#' +#' @param .Object An object: see the "initialize Methods" section in +#' [initialize]. +#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' sampling. +#' @param Mperm An integer defining the number of permuted MCMC samples. +#' @param parperm A named list containing the permuted component parameter +#' samples from MCMC sampling +#' @param logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and the complete data posterior log-likelihood +#' for the permuted MCMC samples. +#' @param postperm A named list containing the permuted parameters of the +#' posterior density. +#' +#' @keywords internal +#' @exportMethod initialize +#' +#' @seealso +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "mcmcoutputpermfixpost", function(.Object, mcmcoutput, Mperm = integer(), @@ -55,6 +81,17 @@ setMethod( } ) +#' Shows a summary of an `mcmcoutputpermfixpost` object. +#' +#' @description +#' Calling [show()] on an `mcmcoutputpermfixpost` object gives an overview +#' of the `mcmcoutputpermfixpost` object. +#' +#' @param object An `mcmcoutputpermfixpost` object. +#' @returns A console output listing the slots and summary information about +#' each of them. +#' @exportMethod show +#' @describeIn mcmcoutputpermfixpost-class setMethod( "show", "mcmcoutputpermfixpost", function(object) { @@ -99,6 +136,55 @@ setMethod( } ) +#' Plot traces of MCMC sampling +#' +#' @description +#' Calling [plotTraces()] plots the MCMC traces of the mixture log-likelihood +#' , the mixture log-likelihood of the prior distribution, the log-likelihood +#' of the complete data posterior, or the weights and parameters if `lik` is +#' set to `1`.s +#' +#' If `lik` is set to `0` the parameters of the components and the posterior +#' parameters are plotted together with `K-1` weights. +#' +#' @param x An `mcmcoutputpermfixpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @exportMethod plotTraces +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use an hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotTraces", signature( x = "mcmcoutputpermfixpost", @@ -132,6 +218,50 @@ setMethod( } ) +#' Plot histograms of the parameters and weights +#' +#' @description +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the histogram plots. +#' +#' Note, this method is so far only implemented for Poisson and Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermfixpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @exportMethod plotHist +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use an hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component setMethod( "plotHist", signature( x = "mcmcoutputpermfixpost", @@ -147,6 +277,50 @@ setMethod( } ) +#' Plot densities of the parameters and weights +#' +#' @description +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling.More specifically, all component parameters, `K-1` of the +#' weights and the posterior parameters are considered in the density plots. +#' +#' Note, this method is so far only implemented for mixtures of Poisson or +#' Binomial distributions. +#' +#' @param x An `mcmcoutputpermfixpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @exportMethod plotDens +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use an hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters setMethod( "plotDens", signature( x = "mcmcoutputpermfixpost", @@ -162,6 +336,49 @@ setMethod( } ) +#' Plot point processes of the component parameters +#' +#' @description +#' Calling [plotPointProc()] plots point processes of the sampled component +#' parameters from MCMC sampling. +#' +#' Note, this method is so far only implemented for mixture models of Poisson +#' or Binomial distributons. +#' +#' @param x An `mcmcoutputpermfixpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Point process of the MCMC samples. +#' @exportMethod plotPointProc +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use an hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotPointProc", signature( x = "mcmcoutputpermfixpost", @@ -177,6 +394,46 @@ setMethod( } ) +#' Plot sampling representations for the component parameters +#' +#' @description +#' Calling [plotSampRep()] plots sampling representations of the sampled +#' component parameters from MCMC sampling. +#' +#' @param x An `mcmcoutputpermfixpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Sampling representation of the MCMC samples. +#' @exportMethod plotSampRep +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use an hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotSampRep(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting point processes of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values setMethod( "plotSampRep", signature( x = "mcmcoutputpermfixpost", @@ -192,6 +449,49 @@ setMethod( } ) +#' Plot posterior densities of the component parameters +#' +#' @description +#' Calling [plotPostDens()] plots posterior densities of the sampled component +#' parameters from MCMC sampling, if the number of components is two. +#' +#' Note, this method is so far only implemented for Poisson and Binomial +#' mixture distributions. +#' +#' @param x An `mcmcoutputpermfixpost` object containing all sampled values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Posterior densities of the MCMC samples. +#' @exportMethod plotPostDens +#' +#' @examples +#' \dontrun{ +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use an hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPostDens(f_outputperm) +#' } +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values setMethod( "plotPostDens", signature( x = "mcmcoutputpermfixpost", @@ -205,4 +505,4 @@ setMethod( .permpostdens.Binomial(x, dev) } } -) +) \ No newline at end of file diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index aadab49..19ca88e 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -27,19 +27,19 @@ #' #' This class stores the permuted parameters together with the new MCMC sample #' size and the mixture log-likelihood, the prior log-likelihood, and the -#' complete data posterior log-likelihood. +#' complete data posterior log-likelihood. #' #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermhier -#' @describeIn mcmcoutputperm_class +#' @rdname mcmcoutputperm-class #' @seealso -#' * [mcmcoutputbase][mcmcoutput_class] for the parent class -#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcoutputhier-class] for the parent class +#' * [mcmcpermindhier-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermhier <- setClass("mcmcoutputpermhier", contains = c( - "mcmcpermind", + "mcmcpermindhier", "mcmcoutputhier" ), validity = function(object) { @@ -90,8 +90,8 @@ setMethod( function(.Object, mcmcoutput, Mperm = integer(), parperm = list(), relabel = character(), weightperm = array(), logperm = list(), - entropyperm = array(), STperm = array(), - Sperm = array(), NKperm = array()) { + hyperperm = list(), entropyperm = array(), + STperm = array(), Sperm = array(), NKperm = array()) { .Object@M <- mcmcoutput@M .Object@burnin <- mcmcoutput@burnin .Object@ranperm <- mcmcoutput@ranperm @@ -110,6 +110,7 @@ setMethod( .Object@relabel <- relabel .Object@weightperm <- weightperm .Object@logperm <- logperm + .Object@hyperperm <- hyperperm .Object@entropyperm <- entropyperm .Object@STperm <- STperm .Object@Sperm <- Sperm diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index 3b17970..bd0ba54 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -426,7 +426,7 @@ setMethod( ), function(object, index) { ## Call 'subseq()' from 'mcmcoutputbase' - callNextMethod(object, index) + object <- callNextMethod(object, index) ## Change owned slots ## dist <- object@model@dist if (dist == "poisson") { diff --git a/R/mcmcpermfixhier.R b/R/mcmcpermfixhier.R new file mode 100644 index 0000000..bae9161 --- /dev/null +++ b/R/mcmcpermfixhier.R @@ -0,0 +1,81 @@ +## Copyright (C) 2013 Lars Simon Zehnder +# +# This file is part of finmix. +# +# finmix is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# finmix is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Rcpp. If not, see . + +#' Finmix `mcmcpermfixhier` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class is supplementing the parent class by adding a slot to store the +#' permuted parameter samples of the hierarchical prior. +#' +#' Note that for models with fixed indicators `weight`s do not get permuted. +#' +#' @slot hyperperm A named list containing the (permuted) parameters of the +#' hierarchical prior. +#' @exportClass mcmcpermfixhier +#' @rdname mcmcpermfixhier-class +#' +#' @seealso +#' * \code{\link{mcmcpermute()}} for the calling function +#' +#' * \code{\link{mcmcpermfix-class}} for the parent class definition +#' +#' * \code{\link{mcmcpermindhier-class}} for the corresponding class for models +#' with unknown indicators +.mcmcpermfixhier <- setClass("mcmcpermfixhier", + representation(hyperperm = "list"), + contains = c("mcmcpermfix"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(hyperperm = list()) +) + +## Getters ## + +#' Getter method of `mcmcpermfixhier` class. +#' +#' Returns the `hyperperm` slot. +#' +#' @param object An `mcmcpermfixhier` object. +#' @returns The `hyperperm` slot of the `object`. +#' @docType methods +#' @rdname mcmcpermfixhier-methods +#' @aliases mcmcpermfixhierpost_class, mcmcoutputpermfixhier_class, +#' mcmcpermoutputpermfixhierpost_class +#' +#' @examples +#' \dontrun{getHyperpem(mcmcperm)} +#' +#' @seealso +#' * \code{\link{mcmcoutputpermfix-class}} for the inheriting class +#' * \code{\link{mcmcpermute}} for function permuting MCMC samples +setMethod( + "getHyperperm", "mcmcpermfixpost", + function(object) { + return(object@hyperperm) + } +) +## No setters implemented as users are not intended to +## manipulate this object diff --git a/R/mcmcpermfixpost.R b/R/mcmcpermfixpost.R index c35e7a4..a80402b 100644 --- a/R/mcmcpermfixpost.R +++ b/R/mcmcpermfixpost.R @@ -34,12 +34,12 @@ #' parameters from the posterior density. #' #' @exportClass mcmcpermfixpost -#' @describeIn mcmcperm_class +#' @rdname mcmcpermfixpost-class #' #' @seealso #' * [mcmcpermute()] for the calling function -#' * [mcmcpermfix][mcmcperm_class] for the parent class definition -#' * [mcmcpermindpost][mcmcperm_class] for the corresponding class for models with +#' * [mcmcpermfix-class] for the parent class definition +#' * [mcmcpermindpost-class]for the corresponding class for models with #' unknown indicators .mcmcpermfixpost <- setClass("mcmcpermfixpost", representation(postperm = "list"), diff --git a/R/mcmcpermindhier.R b/R/mcmcpermindhier.R new file mode 100644 index 0000000..2d8bfbc --- /dev/null +++ b/R/mcmcpermindhier.R @@ -0,0 +1,76 @@ +## Copyright (C) 2013 Lars Simon Zehnder +# +# This file is part of finmix. +# +# finmix is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# finmix is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Rcpp. If not, see . + +#' Finmix `mcmcpermindhier` class +#' +#' @description +#' This class defines objects to store the outputs from permuting the MCMC +#' samples. Due to label switching the sampled component parameters are usually +#' not assigned to the same component in each iteration. To overcome this issue +#' the samples are permuted by using a relabeling algorithm (usually K-means) +#' to reassign parameters. Note that due to assignment of parameters from the +#' same iteration to the same component, the sample size could shrink. +#' +#' This class is supplementing the parent class by adding a slot to store the +#' permuted parameter samples of the hierarchical prior. +#' +#' Note that for models with fixed indicators `weight`s do not get permuted. +#' +#' @slot hyperperm A named list containing the (permuted) parameters of the +#' hierarchical prior. +#' @exportClass mcmcpermindhier +#' @describeIn mcmcperm_class +#' +#' @seealso +#' * \code{\link{mcmcpermute()}} for the calling function +#' * \code{\link{mcmcpermind}} for the parent class definition +#' * \code{\link{mcmcpermfixhier}} for the corresponding class for models with +#' fixed indicators +.mcmcpermindhier <- setClass("mcmcpermindhier", + representation(hyperperm = "list"), + contains = c("mcmcpermind"), + validity = function(object) { + ## else: OK + TRUE + }, + prototype(hyperperm = list()) +) + +## Getters ## + +#' Getter method of `mcmcperminfhier` class. +#' +#' Returns the `hyperperm` slot. +#' +#' @param object An `mcmcpermindhier` object. +#' @returns The `hyperperm` slot of the `object`. +#' @noRd +#' +#' @examples +#' \dontrun{getHyperpem(mcmcperm)} +#' +#' @seealso +#' * \code{\link{mcmcoutputpermind}} for the inheriting class +#' * \code{\link{mcmcpermute}} for function permuting MCMC samples +setMethod( + "getHyperperm", "mcmcpermfixpost", + function(object) { + return(object@hyperperm) + } +) +## No setters implemented as users are not intended to +## manipulate this object diff --git a/R/prior.R b/R/prior.R index 048bd50..3384af4 100644 --- a/R/prior.R +++ b/R/prior.R @@ -179,17 +179,19 @@ #' @describeIn prior-class Checks for parameters in `prior` object #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model. #' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) #' # Call the default constructor. #' f_prior <- prior() #' # Check if the prior has appropriate parameters defined. -#' hasPriorPar(f_prior) -#' hasPriorPar(f_prior, TRUE) +#' hasPriorPar(f_prior, f_model) +#' hasPriorPar(f_prior, f_model, TRUE) +#' } #' #' @seealso -#' * [prior][prior-class] for the definition of the `prior` class -#' * [model][model_class] for the definition of the `model` class +#' * [prior-class] for the definition of the `prior` class +#' * [model-class] for the definition of the `model` class setMethod( "hasPriorPar", signature( object = "prior", diff --git a/R/sdatamoments.R b/R/sdatamoments.R index 9014007..94bedff 100644 --- a/R/sdatamoments.R +++ b/R/sdatamoments.R @@ -69,7 +69,7 @@ setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) #' @export #' @name sdatamoments #' -#' @example +#' @examples #' # Define a model of exponential mixtures. #' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) #' # Simulate data from the model. diff --git a/man/csdatamoments-class.Rd b/man/csdatamoments-class.Rd new file mode 100644 index 0000000..3cedd04 --- /dev/null +++ b/man/csdatamoments-class.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{show,csdatamoments-method} +\alias{show,csdatamoments-method} +\title{Shows a summary of an \code{csdatamoments} object.} +\usage{ +\S4method{show}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{csdatamoments} object gives an overview +of the moments of a finite mixture with continuous data. +} +\section{Functions}{ +\itemize{ +\item \code{show,csdatamoments-method}: Shows a short summary of the object's slots. +}} + diff --git a/man/groupmoments-class.Rd b/man/groupmoments-class.Rd new file mode 100644 index 0000000..604775b --- /dev/null +++ b/man/groupmoments-class.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{show,groupmoments-method} +\alias{show,groupmoments-method} +\title{Shows a summary of a \code{groupmoments} object.} +\usage{ +\S4method{show}{groupmoments}(object) +} +\arguments{ +\item{object}{A \code{groupmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{groupmoments} object gives an overview +of the moments of a finit mixture with continuous data. +} +\section{Functions}{ +\itemize{ +\item \code{show,groupmoments-method}: Shows a short summary of the object's slots +}} + diff --git a/man/groupmoments.Rd b/man/groupmoments.Rd index 7df9370..e6d5080 100644 --- a/man/groupmoments.Rd +++ b/man/groupmoments.Rd @@ -19,6 +19,15 @@ Calling \code{\link[=groupmoments]{groupmoments()}} creates an object holding va component-specific moments. These moments can only constructed if the \link[=fdata_class]{fdata} object contains in addition to observations also indicators defining from which component a certain observation stems. +} +\examples{ +# Define a mixture model with exponential components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Create group moments of the data. +groupmoments(f_data) + } \seealso{ \itemize{ diff --git a/man/initialize-mcmcoutputpermfixpost-method.Rd b/man/initialize-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..76f0b46 --- /dev/null +++ b/man/initialize-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{initialize,mcmcoutputpermfixpost-method} +\alias{initialize,mcmcoutputpermfixpost-method} +\title{Initializer of the \code{mcmcoutputpermfixhier} class} +\usage{ +\S4method{initialize}{mcmcoutputpermfixpost}( + .Object, + mcmcoutput, + Mperm = integer(), + parperm = list(), + logperm = list(), + postperm = list() +) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +sampling.} + +\item{Mperm}{An integer defining the number of permuted MCMC samples.} + +\item{parperm}{A named list containing the permuted component parameter +samples from MCMC sampling} + +\item{logperm}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and the complete data posterior log-likelihood +for the permuted MCMC samples.} + +\item{postperm}{A named list containing the permuted parameters of the +posterior density.} +} +\description{ +Only used implicitly. The initializer stores the data into the slots of the +passed-in object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-mcmcoutputpermhier-method.Rd b/man/initialize-mcmcoutputpermhier-method.Rd index a5bd121..e48eedd 100644 --- a/man/initialize-mcmcoutputpermhier-method.Rd +++ b/man/initialize-mcmcoutputpermhier-method.Rd @@ -12,6 +12,7 @@ relabel = character(), weightperm = array(), logperm = list(), + hyperperm = list(), entropyperm = array(), STperm = array(), Sperm = array(), diff --git a/man/mcmcoutput_class.Rd b/man/mcmcoutput_class.Rd index 4dae5a9..75e8f8c 100644 --- a/man/mcmcoutput_class.Rd +++ b/man/mcmcoutput_class.Rd @@ -1,9 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfix.R, R/mcmcoutputfixhier.R, -% R/mcmcoutputfixpost.R, R/mcmcoutputfixhierpost.R, R/mcmcoutputbase.R, -% R/mcmcoutputhier.R, R/mcmcoutputpost.R, R/mcmcoutputhierpost.R +% Please edit documentation in R/AllGenerics.R, R/mcmcoutputfix.R, +% R/mcmcoutputfixhier.R, R/mcmcoutputfixpost.R, R/mcmcoutputfixhierpost.R, +% R/mcmcoutputbase.R, R/mcmcoutputhier.R, R/mcmcoutputpost.R, +% R/mcmcoutputhierpost.R \docType{class} -\name{mcmcoutput_class} +\name{subseq} +\alias{subseq} \alias{mcmcoutput_class} \alias{.mcmcoutputfix} \alias{plotTraces,mcmcoutputfix-method} @@ -46,6 +48,8 @@ \alias{plotPostDens,mcmcoutputhierpost-method} \title{Finmix \code{mcmcoutput} base class for fixed indicators} \usage{ +subseq(object, index) + \S4method{plotTraces}{mcmcoutputfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) \S4method{plotHist}{mcmcoutputfix}(x, dev = TRUE, ...) @@ -111,6 +115,8 @@ \S4method{plotPostDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) } \arguments{ +\item{object}{An \code{ mcmcoutputpost} object.} + \item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} \item{dev}{A logical indicating, if the plots should be shown by a graphical @@ -123,8 +129,6 @@ and weights are plotted instead.} \item{col}{A logical indicating, if the plot should be colored.} \item{...}{Further arguments to be passed to the plotting function.} - -\item{object}{An \code{ mcmcoutputpost} object.} } \value{ A plot of the traces of the MCMC samples. @@ -370,6 +374,8 @@ Note, this method calls the equivalent method of the parent class. } \section{Functions}{ \itemize{ +\item \code{subseq}: + \item \code{plotTraces,mcmcoutputfix-method}: \item \code{plotHist,mcmcoutputfix-method}: diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd new file mode 100644 index 0000000..bacb506 --- /dev/null +++ b/man/mcmcoutputperm-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\docType{class} +\name{mcmcoutputpermhier-class} +\alias{mcmcoutputpermhier-class} +\alias{.mcmcoutputpermhier} +\title{Finmix \code{mcmcoutputpermhier} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputhier} for the parent class +\item \linkS4class{mcmcpermindhier} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} diff --git a/man/mcmcoutputperm_class.Rd b/man/mcmcoutputperm_class.Rd index 6757677..f35d90a 100644 --- a/man/mcmcoutputperm_class.Rd +++ b/man/mcmcoutputperm_class.Rd @@ -1,25 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfix.R, R/mcmcoutputpermfixhier.R, -% R/mcmcoutputpermfixhierpost.R, R/mcmcoutputpermbase.R, -% R/mcmcoutputpermhier.R, R/mcmcoutputpermpost.R, R/mcmcoutputpermhierpost.R +% Please edit documentation in R/mcmcoutputpermfixhier.R, +% R/mcmcoutputpermbase.R, R/mcmcoutputpermhier.R, R/mcmcoutputpermpost.R, +% R/mcmcoutputpermhierpost.R \docType{class} -\name{plotTraces,mcmcoutputpermfix-method} -\alias{plotTraces,mcmcoutputpermfix-method} -\alias{plotHist,mcmcoutputpermfix-method} -\alias{plotDens,mcmcoutputpermfix-method} -\alias{plotPointProc,mcmcoutputpermfix-method} -\alias{plotSampRep,mcmcoutputpermfix-method} -\alias{plotPostDens,mcmcoutputpermfix-method} -\alias{plotTraces,mcmcoutputpermfixhier-method} -\alias{plotHist,mcmcoutputpermfixhier-method} -\alias{plotDens,mcmcoutputpermfixhier-method} +\name{plotPostDens,mcmcoutputpermfixhier-method} \alias{plotPostDens,mcmcoutputpermfixhier-method} -\alias{plotTraces,mcmcoutputpermfixhierpost-method} -\alias{plotHist,mcmcoutputpermfixhierpost-method} -\alias{plotDens,mcmcoutputpermfixhierpost-method} -\alias{plotPointProc,mcmcoutputpermfixhierpost-method} -\alias{plotSampRep,mcmcoutputpermfixhierpost-method} -\alias{plotPostDens,mcmcoutputpermfixhierpost-method} \alias{plotTraces,mcmcoutputpermbase-method} \alias{plotHist,mcmcoutputpermbase-method} \alias{plotDens,mcmcoutputpermbase-method} @@ -46,40 +31,10 @@ \alias{plotPointProc,mcmcoutputpermhierpost-method} \alias{plotSampRep,mcmcoutputpermhierpost-method} \alias{plotPostDens,mcmcoutputpermhierpost-method} -\title{Plot traces of MCMC sampling} +\title{Plot posterior densities of the component parameters} \usage{ -\S4method{plotTraces}{mcmcoutputpermfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputpermfixhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) - \S4method{plotPostDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) -\S4method{plotTraces}{mcmcoutputpermfixhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) - \S4method{plotTraces}{mcmcoutputpermbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) \S4method{plotHist}{mcmcoutputpermbase}(x, dev = TRUE, ...) @@ -134,45 +89,15 @@ \item{dev}{A logical indicating, if the plots should be shown by a graphical device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} +\item{...}{Further arguments to be passed to the plotting function.} + \item{lik}{An integer indicating, if the log-likelihood traces should be plotted (default). If set to \code{0} the traces for the parameters and weights are plotted instead.} \item{col}{A logical indicating, if the plot should be colored.} - -\item{...}{Further arguments to be passed to the plotting function.} } \value{ -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. - -Sampling represetnation of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point process of the MCMC samples. - -Sampliing representations of the MCMC samples. - Posterior densities of the MCMC samples. A plot of the traces of the MCMC samples. @@ -224,93 +149,6 @@ Densities of the MCMC samples. Posterior densities of the MCMC samples. } \description{ -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}.s - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled component parameters -from MCMC sampling. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled component parameters -from MCMC sampling. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}.s - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Note, this method is so far only implemented for Poisson and Binomial -mixture distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Note, this method is so far only implemented for mixtures of Poisson or -Binomial distributions. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson and Binomial -mixture distributions. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. If a hierarchical prior -has been used in sampling its parameters are plotted alongside the other -parameters. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Note, this method is so far only implemented for Poisson and Binomial -mixture distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Note, this method is so far only implemented for mixtures of Poisson or -Binomial distributions. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this method is so far only implemented for mixtures of Poisson or -Binomial distributions. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method is so far only implemented for mixtures of Poisson or -Binomial distributions. - Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component parameters from MCMC sampling, if the number of components is two. @@ -486,38 +324,8 @@ mixture distributions. } \section{Functions}{ \itemize{ -\item \code{plotTraces,mcmcoutputpermfix-method}: - -\item \code{plotHist,mcmcoutputpermfix-method}: - -\item \code{plotDens,mcmcoutputpermfix-method}: - -\item \code{plotPointProc,mcmcoutputpermfix-method}: - -\item \code{plotSampRep,mcmcoutputpermfix-method}: - -\item \code{plotPostDens,mcmcoutputpermfix-method}: - -\item \code{plotTraces,mcmcoutputpermfixhier-method}: - -\item \code{plotHist,mcmcoutputpermfixhier-method}: - -\item \code{plotDens,mcmcoutputpermfixhier-method}: - \item \code{plotPostDens,mcmcoutputpermfixhier-method}: -\item \code{plotTraces,mcmcoutputpermfixhierpost-method}: - -\item \code{plotHist,mcmcoutputpermfixhierpost-method}: - -\item \code{plotDens,mcmcoutputpermfixhierpost-method}: - -\item \code{plotPointProc,mcmcoutputpermfixhierpost-method}: - -\item \code{plotSampRep,mcmcoutputpermfixhierpost-method}: - -\item \code{plotPostDens,mcmcoutputpermfixhierpost-method}: - \item \code{plotTraces,mcmcoutputpermbase-method}: \item \code{plotHist,mcmcoutputpermbase-method}: @@ -572,6 +380,7 @@ parameters }} \examples{ +\dontrun{ # Define a Poisson mixture model with two components. f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, indicfix = TRUE) @@ -581,232 +390,11 @@ f_data <- simulate(f_model) f_mcmc <- mcmc(storepost = FALSE) # Define the prior distribution by relying on the data. f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) # Start MCMC sampling. f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) f_outputperm <- mcmcpermute(f_output) plotPostDens(f_outputperm) +} # Define a Poisson mixture model with two components. f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) @@ -1147,156 +735,6 @@ plotPostDens(f_outputperm) } \seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples diff --git a/man/mcmcoutputpermfix-class.Rd b/man/mcmcoutputpermfix-class.Rd index ad56d2c..c13c63b 100644 --- a/man/mcmcoutputpermfix-class.Rd +++ b/man/mcmcoutputpermfix-class.Rd @@ -4,7 +4,53 @@ \name{mcmcoutputpermfix-class} \alias{mcmcoutputpermfix-class} \alias{.mcmcoutputpermfix} +\alias{plotTraces,mcmcoutputpermfix-method} +\alias{plotHist,mcmcoutputpermfix-method} +\alias{plotDens,mcmcoutputpermfix-method} +\alias{plotPointProc,mcmcoutputpermfix-method} +\alias{plotSampRep,mcmcoutputpermfix-method} +\alias{plotPostDens,mcmcoutputpermfix-method} \title{Finmix \code{mcmcoutputpermfix} class} +\usage{ +\S4method{plotTraces}{mcmcoutputpermfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermfix}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Densities of the MCMC samples. + +Sampling represetnation of the MCMC samples. + +Posterior densities of the MCMC samples. +} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -18,11 +64,199 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note that this class inherits all of its slots from the parent classes. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled component parameters +from MCMC sampling. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled component parameters +from MCMC sampling. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\section{Functions}{ +\itemize{ +\item \code{plotTraces,mcmcoutputpermfix-method}: + +\item \code{plotHist,mcmcoutputpermfix-method}: + +\item \code{plotDens,mcmcoutputpermfix-method}: + +\item \code{plotPointProc,mcmcoutputpermfix-method}: + +\item \code{plotSampRep,mcmcoutputpermfix-method}: + +\item \code{plotPostDens,mcmcoutputpermfix-method}: +}} + +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputfix} for the parent class -\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class +\item \linkS4class{mcmcoutputfix} for the parent class +\item \linkS4class{mcmcpermfix} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} } diff --git a/man/mcmcoutputpermfixhier-class.Rd b/man/mcmcoutputpermfixhier-class.Rd index 4f31bae..a9eea75 100644 --- a/man/mcmcoutputpermfixhier-class.Rd +++ b/man/mcmcoutputpermfixhier-class.Rd @@ -21,8 +21,8 @@ Note this class inherits all slots from its parent classes. } \seealso{ \itemize{ -\item \link[=mcmcoutputperm_class]{mcmcoutputpermfix} for the parent class -\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class +\item \linkS4class{mcmcoutputpermfix} for the parent class +\item \linkS4class{mcmcpermfix} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } } diff --git a/man/mcmcoutputpermfixpost-class.Rd b/man/mcmcoutputpermfixpost-class.Rd index 03b8ffc..acd1d75 100644 --- a/man/mcmcoutputpermfixpost-class.Rd +++ b/man/mcmcoutputpermfixpost-class.Rd @@ -9,3 +9,6 @@ This class defines the storage of parameters of the posterior distribution. It inherits from the } +\seealso{ + +} diff --git a/man/plotDens-mcmcoutputpermfixhier-method.Rd b/man/plotDens-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..cb97df9 --- /dev/null +++ b/man/plotDens-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{plotDens,mcmcoutputpermfixhier-method} +\alias{plotDens,mcmcoutputpermfixhier-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotDens-mcmcoutputpermfixhierpost-method.Rd b/man/plotDens-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..5063737 --- /dev/null +++ b/man/plotDens-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{plotDens,mcmcoutputpermfixhierpost-method} +\alias{plotDens,mcmcoutputpermfixhierpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotDens-mcmcoutputpermfixpost-method.Rd b/man/plotDens-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..0d0eaf5 --- /dev/null +++ b/man/plotDens-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{plotDens,mcmcoutputpermfixpost-method} +\alias{plotDens,mcmcoutputpermfixpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use an hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotHist-mcmcoutputpermfixhier-method.Rd b/man/plotHist-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..562e8e5 --- /dev/null +++ b/man/plotHist-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{plotHist,mcmcoutputpermfixhier-method} +\alias{plotHist,mcmcoutputpermfixhier-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotHist-mcmcoutputpermfixhierpost-method.Rd b/man/plotHist-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..4750468 --- /dev/null +++ b/man/plotHist-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{plotHist,mcmcoutputpermfixhierpost-method} +\alias{plotHist,mcmcoutputpermfixhierpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotHist-mcmcoutputpermfixpost-method.Rd b/man/plotHist-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..dd0a01f --- /dev/null +++ b/man/plotHist-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{plotHist,mcmcoutputpermfixpost-method} +\alias{plotHist,mcmcoutputpermfixpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use an hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component +} +} diff --git a/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd b/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..802580d --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{plotPointProc,mcmcoutputpermfixhierpost-method} +\alias{plotPointProc,mcmcoutputpermfixhierpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-mcmcoutputpermfixpost-method.Rd b/man/plotPointProc-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..95298f9 --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{plotPointProc,mcmcoutputpermfixpost-method} +\alias{plotPointProc,mcmcoutputpermfixpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is so far only implemented for mixture models of Poisson +or Binomial distributons. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use an hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd b/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..57b0568 --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{plotPostDens,mcmcoutputpermfixhierpost-method} +\alias{plotPostDens,mcmcoutputpermfixhierpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} diff --git a/man/plotPostDens-mcmcoutputpermfixpost-method.Rd b/man/plotPostDens-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..56165e6 --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{plotPostDens,mcmcoutputpermfixpost-method} +\alias{plotPostDens,mcmcoutputpermfixpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use an hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd b/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..777908b --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{plotSampRep,mcmcoutputpermfixhierpost-method} +\alias{plotSampRep,mcmcoutputpermfixhierpost-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampliing representations of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson or +Binomial distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotSampRep-mcmcoutputpermfixpost-method.Rd b/man/plotSampRep-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..037af45 --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{plotSampRep,mcmcoutputpermfixpost-method} +\alias{plotSampRep,mcmcoutputpermfixpost-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use an hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotTraces-mcmcoutputpermfixhier-method.Rd b/man/plotTraces-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..7be5d86 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{plotTraces,mcmcoutputpermfixhier-method} +\alias{plotTraces,mcmcoutputpermfixhier-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermfixhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd b/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..8b5de21 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{plotTraces,mcmcoutputpermfixhierpost-method} +\alias{plotTraces,mcmcoutputpermfixhierpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermfixhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. If a hierarchical prior +has been used in sampling its parameters are plotted alongside the other +parameters. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/plotTraces-mcmcoutputpermfixpost-method.Rd b/man/plotTraces-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..34b2a74 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{plotTraces,mcmcoutputpermfixpost-method} +\alias{plotTraces,mcmcoutputpermfixpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermfixpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use an hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} diff --git a/man/prior-class.Rd b/man/prior-class.Rd index c90ca92..ffec9c2 100644 --- a/man/prior-class.Rd +++ b/man/prior-class.Rd @@ -64,8 +64,8 @@ f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) # Call the default constructor. f_prior <- prior() # Check if the prior has appropriate parameters defined. -hasPriorPar(f_prior) -hasPriorPar(f_prior, TRUE) +hasPriorPar(f_prior, f_model) +hasPriorPar(f_prior, f_model, TRUE) # Define a Poisson mixture model. f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) diff --git a/man/sdatamoments.Rd b/man/sdatamoments.Rd index 6bb5fdf..28022af 100644 --- a/man/sdatamoments.Rd +++ b/man/sdatamoments.Rd @@ -20,6 +20,15 @@ Calling \code{\link[=sdatamoments]{sdatamoments()}} constructs an object of clas \code{csdatamoments} depending on the \code{type} slot of the argument \code{value}. If this slot is \code{"discrete"} an \code{sdatamoments} object is returned and if the slot is \code{"continuous"}, a \code{csdatamoments} object is returned. +} +\examples{ +# Define a model of exponential mixtures. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Compute data moments for the indicators. +sdatamoments(f_data) + } \seealso{ \itemize{ diff --git a/man/show-mcmcoutputpermfixpost-method.Rd b/man/show-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..3d4e463 --- /dev/null +++ b/man/show-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{show,mcmcoutputpermfixpost-method} +\alias{show,mcmcoutputpermfixpost-method} +\title{Shows a summary of an \code{mcmcoutputpermfixpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixpost} object gives an overview +of the \code{mcmcoutputpermfixpost} object. +} diff --git a/man/subseq-mcmcoutputfix-array-method.Rd b/man/subseq-mcmcoutputfix-array-method.Rd new file mode 100644 index 0000000..eefdf2b --- /dev/null +++ b/man/subseq-mcmcoutputfix-array-method.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{subseq,mcmcoutputfix,array-method} +\alias{subseq,mcmcoutputfix,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputfix,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. +} diff --git a/man/subseq-mcmcoutputfixhier-array-method.Rd b/man/subseq-mcmcoutputfixhier-array-method.Rd new file mode 100644 index 0000000..1eca51b --- /dev/null +++ b/man/subseq-mcmcoutputfixhier-array-method.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{subseq,mcmcoutputfixhier,array-method} +\alias{subseq,mcmcoutputfixhier,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputfixhier,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. +} From 192b2e8180e210c76fae1a6adcbde7ad555c0446 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Thu, 7 Oct 2021 10:05:01 +0200 Subject: [PATCH 13/24] Fixed some bugs and aggregated the documentation of mcmcoutputperm classes into a single RD file and putting the rest to internal --- NAMESPACE | 4 + R/RcppExports.R | 65 +- R/mcmcoutputpermbase.R | 39 +- R/mcmcoutputpermfixhier.R | 3 +- R/mcmcoutputpermfixhierpost.R | 16 +- R/mcmcoutputpermfixpost.R | 3 +- R/mcmcoutputpermhier.R | 24 +- R/mcmcoutputpermhierpost.R | 35 +- R/mcmcoutputpermpost.R | 23 +- R/mincol.R | 4 + R/prior.R | 8 +- R/unass.R | 2 +- man/initialize-mcmcoutputpermbase-method.Rd | 2 +- ...ialize-mcmcoutputpermfixhierpost-method.Rd | 6 +- man/initialize-mcmcoutputpermhier-method.Rd | 8 +- man/mcmc_binomial_cc.Rd | 2 +- man/mcmc_condpoisson_cc.Rd | 2 +- man/mcmc_exponential_cc.Rd | 2 +- man/mcmc_normal_cc.Rd | 2 +- man/mcmc_normult_cc.Rd | 2 +- man/mcmc_poisson_cc.Rd | 2 +- man/mcmc_student_cc.Rd | 2 +- man/mcmc_studmult_cc.Rd | 2 +- man/mcmcoutput_class.Rd | 208 +--- man/mcmcoutputbase-class.Rd | 242 ++++- man/mcmcoutputperm-class.Rd | 33 +- man/mcmcoutputperm_class.Rd | 905 +----------------- man/mcmcoutputpermbase-class.Rd | 280 +++++- man/mcmcoutputpermfixhier-class.Rd | 20 + man/mcmcoutputpermfixhierpost-class.Rd | 25 +- man/mcmcoutputpermfixpost-class.Rd | 20 + man/mcmcoutputpermhier-class.Rd | 5 +- man/mcmcoutputpermpost-class.Rd | 5 +- man/mcmcperm_class.Rd | 34 +- man/prior-class.Rd | 10 +- man/show-csdatamoments-method.Rd | 19 - man/show-groupmoments-method.Rd | 19 - man/show-mcmcoutputbase-method.Rd | 19 - man/show-mcmcoutputpermbase-method.Rd | 19 - man/show-mcmcoutputpermfixhier-method.Rd | 19 - man/show-mcmcoutputpermfixhierpost-method.Rd | 19 - man/show-mcmcoutputpermfixpost-method.Rd | 19 - man/show-mcmcoutputpermhier-method.Rd | 1 + man/show-mcmcoutputpermhierpost-method.Rd | 1 + man/show-mcmcoutputpermpost-method.Rd | 1 + man/stephens1997a_binomial_cc.Rd | 9 +- man/stephens1997a_poisson_cc.Rd | 9 +- man/stephens1997b_binomial_cc.Rd | 8 +- man/stephens1997b_exponential_cc.Rd | 9 +- man/stephens1997b_poisson_cc.Rd | 8 +- man/swap_cc.Rd | 2 +- man/unsass.Rd | 2 +- src/attributes.cpp | 2 +- src/relabel_algorithms.cpp | 47 +- 54 files changed, 831 insertions(+), 1446 deletions(-) delete mode 100644 man/show-csdatamoments-method.Rd delete mode 100644 man/show-groupmoments-method.Rd delete mode 100644 man/show-mcmcoutputbase-method.Rd delete mode 100644 man/show-mcmcoutputpermbase-method.Rd delete mode 100644 man/show-mcmcoutputpermfixhier-method.Rd delete mode 100644 man/show-mcmcoutputpermfixhierpost-method.Rd delete mode 100644 man/show-mcmcoutputpermfixpost-method.Rd diff --git a/NAMESPACE b/NAMESPACE index e2b2aa7..7e6e7c3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,10 @@ export(moments_cc) export(permmoments_cc) export(prior) export(priordefine) +export(qincol) +export(qincolmult) +export(qinmatr) +export(qinmatrmult) export(sdatamoments) export(stephens1997a_binomial_cc) export(stephens1997a_poisson_cc) diff --git a/R/RcppExports.R b/R/RcppExports.R index c6f96d0..3b6a692 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -15,7 +15,7 @@ #' @export #' #' @examples -#' values <- matrix(rnorm(10), nrow = 2) +#' values <- matrix(rnorm(10), ncol = 2) #' index <- matrix(c(2,1), nrow = 5, ncol = 2) #' swap_cc(values, index) #' @@ -297,7 +297,7 @@ permmoments_cc <- function(classS4) { #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -340,7 +340,7 @@ mcmc_binomial_cc <- function(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -383,7 +383,7 @@ mcmc_condpoisson_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -426,7 +426,7 @@ mcmc_exponential_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -469,7 +469,7 @@ mcmc_normal_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -512,7 +512,7 @@ mcmc_normult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -555,7 +555,7 @@ mcmc_poisson_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -598,7 +598,7 @@ mcmc_student_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' * [mixturemcmc()] for performing MCMC sampling #' * [fdata][fdata_class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [prior][prior_class] for the `prior` class definition #' * [mcmc][mcmc_class] for the `mcmc` class definition #' #' @references @@ -610,7 +610,7 @@ mcmc_studmult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4 .Call('_finmix_mcmc_studmult_cc', PACKAGE = 'finmix', data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) } -#' Relabeling algorithm from Stephens (1997a) for Poisson mixture models +#' Stephens (1997a) relabeling algorithm for Poisson mixtures #' #' @description #' For internal usage only. This function runs the re-labeling algorithm from @@ -630,12 +630,13 @@ mcmc_studmult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4 #' @param perm A matrix with all possible permutations of the labels. #' @return A matrix of dimension `MxK` that holding the optimal labeling. #' @export +#' @keywords internal #' #' @seealso -#' * \code{\link{mcmcpermute}} for the calling function -#' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +#' * [mcmcpermute()] for the calling function +#' * [stephens1997b_poisson_cc()] for the re-labeling algorithm from #' Stephens (1997b) -#' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +#' * [stephens1997a_binomial_cc()] for the equivalent implementation #' for mixtures of Binomial distributions #' #' @references @@ -646,7 +647,7 @@ stephens1997a_poisson_cc <- function(values1, values2, pars, perm) { .Call('_finmix_stephens1997a_poisson_cc', PACKAGE = 'finmix', values1, values2, pars, perm) } -#' Relabeling algorithm from Stephens (1997a) for Binomial mixture models +#' Stephens (1997a) relabeling algorithm for Binomial mixtures #' #' @description For internal usage only. This function runs the re-labeling #' algorithm from Stephens (1997a) for MCMC samples of a Binomial mixture @@ -665,12 +666,12 @@ stephens1997a_poisson_cc <- function(values1, values2, pars, perm) { #' @param perm A matrix with all possible permutations of the labels. #' @return A matrix of dimension `MxK` that holding the optimal labeling. #' @export -#' +#' @keywords internal #' @seealso -#' * \code{\link{mcmcpermute}} for the calling function -#' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +#' * [mcmcpermute()] for the calling function +#' * [stephens1997b_poisson_cc()] for the re-labeling algorithm from #' Stephens (1997b) -#' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +#' * [stephens1997a_binomial_cc()] for the equivalent implementation #' for mixtures of Binomial distributions #' #' @references @@ -681,7 +682,7 @@ stephens1997a_binomial_cc <- function(values1, values2, pars, perm) { .Call('_finmix_stephens1997a_binomial_cc', PACKAGE = 'finmix', values1, values2, pars, perm) } -#' Relabeling algorithm from Stephens (1997b) for Poisson mixture models +#' Stephens (1997b) relabeling algorithm for Poisson mixtures #' #' @description #' For internal usage only. This function runs the re-labeling algorithm from @@ -697,12 +698,12 @@ stephens1997a_binomial_cc <- function(values1, values2, pars, perm) { #' @return An integer matrix of dimension `MxK` that holding the optimal #' labeling. #' @export -#' +#' @kewords internal #' @seealso -#' * \code{\link{mcmcpermute}} for the calling function -#' * \code{\link{stephens1997a_poisson_cc}} for the re-labeling algorithm from +#' * [mcmcpermute()] for the calling function +#' * [stephens1997a_poisson_cc()] for the re-labeling algorithm from #' Stephens (1997a) -#' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +#' * [stephens1997b_binomial_cc()] for the equivalent implementation #' for mixtures of Binomial distributions #' #' @references @@ -712,7 +713,7 @@ stephens1997b_poisson_cc <- function(values, comp_par, weight_par, max_iter = 20 .Call('_finmix_stephens1997b_poisson_cc', PACKAGE = 'finmix', values, comp_par, weight_par, max_iter) } -#' Relabeling algorithm from Stephens (1997b) for Binomial mixture models +#' Stephens (1997b) relabeling algorithm for Binomial mixtures #' #' @description #' For internal usage only. This function runs the re-labeling algorithm from @@ -730,10 +731,10 @@ stephens1997b_poisson_cc <- function(values, comp_par, weight_par, max_iter = 20 #' @export #' #' @seealso -#' * \code{\link{mcmcpermute}} for the calling function -#' * \code{\link{stephens1997a_binomial_cc}} for the re-labeling algorithm from +#' * [mcmcpermute()] for the calling function +#' * [stephens1997a_binomial_cc()] for the re-labeling algorithm from #' Stephens (1997a) -#' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +#' * [stephens1997b_poisson_cc()] for the equivalent implementation #' for mixtures of Poisson distributions #' #' @references @@ -743,7 +744,7 @@ stephens1997b_binomial_cc <- function(values, reps, comp_par, weight_par) { .Call('_finmix_stephens1997b_binomial_cc', PACKAGE = 'finmix', values, reps, comp_par, weight_par) } -#' Relabeling algorithm from Stephens (1997b) for Exponential mixture models +#' Stephens (1997b) relabeling algorithm for Exponential mixtures #' #' @description #' For internal usage only. This function runs the re-labeling algorithm from @@ -759,12 +760,12 @@ stephens1997b_binomial_cc <- function(values, reps, comp_par, weight_par) { #' @return An integer matrix of dimension `MxK` that holding the optimal #' labeling. #' @export -#' +#' @keywords internal #' @seealso -#' * \code{\link{mcmcpermute}} for the calling function -#' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +#' * [mcmcpermute()] for the calling function +#' * [stephens1997b_poisson_cc()] for the equivalent implementation #' for mixtures of Poisson distributions -#' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +#' * [stephens1997b_binomial_cc()] for the equivalent implementation #' for mixtures of Binomial distributions #' #' @references diff --git a/R/mcmcoutputpermbase.R b/R/mcmcoutputpermbase.R index 0f01441..f725dea 100644 --- a/R/mcmcoutputpermbase.R +++ b/R/mcmcoutputpermbase.R @@ -32,10 +32,10 @@ #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermbase -#' @describeIn mcmcoutputperm_class +#' @rdname mcmcoutputpermbase-class #' @seealso -#' * [mcmcoutputbase][mcmcoutput_class] for the parent class -#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcoutputbase-class] for the parent class +#' * [mcmcpermind-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermbase <- setClass("mcmcoutputpermbase", contains = c( @@ -56,7 +56,7 @@ #' #' @param .Object An object: see the "initialize Methods" section in #' [initialize]. -#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC +#' @param mcmcoutput An `mcmcoutputpermbase` class containing the results from MCMC #' sampling. #' @param Mperm An integer defining the number of permuted MCMC samples. #' @param parperm A named list containing the permuted component parameter @@ -126,7 +126,8 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class Shows a short summary of the object's +#' slots setMethod( "show", "mcmcoutputpermbase", function(object) { @@ -225,9 +226,10 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) #' # Simulate data from the mixture model. @@ -242,6 +244,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotTraces(f_outputperm, lik = 0) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -303,9 +306,11 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class Plot histograms of the parameters and +#' weights #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) #' # Simulate data from the mixture model. @@ -320,6 +325,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotHist(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -356,7 +362,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -412,9 +418,11 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class Plots point process for the component +#' parameters #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) #' # Simulate data from the mixture model. @@ -429,6 +437,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPointProc(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -468,9 +477,11 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class Plots sampling representations of the +#' component parameters #' -#' @examples +#' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) #' # Simulate data from the mixture model. @@ -485,6 +496,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotSampRep(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling @@ -524,9 +536,11 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermbase-class Plots the posterior density of the +#' component parameters #' #' @examples +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) #' # Simulate data from the mixture model. @@ -541,6 +555,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) #' plotPostDens(f_outputperm) +#' } #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index b933a6c..13d5d2c 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -99,7 +99,8 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfixhier-class +#' @describeIn mcmcoutputpermfixhier-class Shows a short summary of the +#' object's slots setMethod( "show", "mcmcoutputpermfixhier", function(object) { diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index 920126b..79fd3c6 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -32,10 +32,11 @@ #' Note this class inherits all slots from its parent classes. #' #' @exportClass mcmcoutputpermfixhierpost -#' @describeIn mcmcoutputperm_class +#' @rdname mcmcoutputpermfixhierpost-class #' @seealso -#' * [mcmcoutputfixhierpost][mcmcoutput_class] for the parent class -#' * [mcmcpermfix][mcmcperm_class] for the parent class +#' * [mcmcoutputfixhierpost-class] for the parent class +#' * [mcmcpermfixhier-class] for the parent class +#' * [mcmcpermfixpost-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermfixhierpost <- setClass("mcmcoutputpermfixhierpost", contains = c( @@ -49,7 +50,7 @@ } ) -#' Initializer of the `mcmcoutputpermfixhier` class +#' Initializer of the `mcmcoutputpermfixhierpost` class #' #' @description #' Only used implicitly. The initializer stores the data into the slots of the @@ -57,8 +58,8 @@ #' #' @param .Object An object: see the "initialize Methods" section in #' [initialize]. -#' @param mcmcoutput An `mcmcoutput` class containing the results from MCMC -#' sampling. +#' @param mcmcoutput An `mcmcoutputpermfixhierpost` class containing the +#' results from MCMC sampling. #' @param Mperm An integer defining the number of permuted MCMC samples. #' @param parperm A named list containing the permuted component parameter #' samples from MCMC sampling @@ -108,7 +109,8 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfixhierpost-class +#' @describeIn mcmcoutputpermfixhierpost-class Shows a short summary of the +#' object's slots setMethod( "show", "mcmcoutputpermfixhierpost", function(object) { diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index c91f420..18b5911 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -91,7 +91,8 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfixpost-class +#' @describeIn mcmcoutputpermfixpost-class Shows a short summary of the +#' object's slots setMethod( "show", "mcmcoutputpermfixpost", function(object) { diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index 19ca88e..8a82db7 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -32,7 +32,8 @@ #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermhier -#' @rdname mcmcoutputperm-class +#' @rdname mcmcoutputpermhier-class +#' @keywords internal #' @seealso #' * [mcmcoutputhier-class] for the parent class #' * [mcmcpermindhier-class] for the parent class @@ -71,13 +72,13 @@ #' @param entropyperm An `array` of dimension `Mperm\ x 1` containing the #' entropy for each MCMC permuted draw. #' @param STperm An `array` of dimension `Mperm\ x 1` containing all permuted -#' MCMC states, for the last observation in slot `@@y` of the `fdata` object +#' MCMC states, for the last observation in slot `y` of the `fdata` object #' passed in to [mixturemcmc()] where a state is defined for non-Markov #' models as the last indicator of this observation. -#' @param An `array` of dimension `N\ x storeS` containing the last -#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' @param An `array` of dimension `NxstoreS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `storeS` #' of the `mcmc` object passed into [mixturemcmc()]. -#' @param NKperm An `array` of dimension `Mperm\ x K` containing the numbers +#' @param NKperm An `array` of dimension `MpermxK` containing the numbers #' of observations assigned to each component. #' #' @keywords internal @@ -129,7 +130,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @keywords internal setMethod( "show", "mcmcoutputpermhier", function(object) { @@ -236,7 +237,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class Plots traces of MCMC samples +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -246,6 +247,7 @@ setMethod( #' # Define the hyper-parameters for MCMC sampling. #' f_mcmc <- mcmc(storepost = FALSE) #' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) #' # Start MCMC sampling. #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_outputperm <- mcmcpermute(f_output) @@ -303,7 +305,7 @@ setMethod( #' from MCMC sampling. In addition the parameters of the hierarchical prior are #' plotted. #' -#' Note, this method is so far only implemented for mictures of Poisson and +#' Note, this method is so far only implemented for mixtures of Poisson and #' Binomial distributions. #' #' @param x An `mcmcoutputpermhier` object containing all sampled values. @@ -312,7 +314,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -368,7 +370,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -530,7 +532,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index 9d43254..fbe81d5 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -32,11 +32,12 @@ #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermhierpost +#' @rdname mcmcoutputpermhierpost-class +#' @keywords internal #' -#' @describeIn mcmcoutputperm_class Finmix `mcmcoutputpermhierpost` class #' @seealso -#' * [mcmcoutputbase][mcmcoutput_class] for the parent class -#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcoutputbase-class] for the parent class +#' * [mcmcpermind-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermhierpost <- setClass("mcmcoutputpermhierpost", contains = c( @@ -138,7 +139,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @keywords internal setMethod( "show", "mcmcoutputpermhierpost", function(object) { @@ -258,7 +259,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -338,7 +339,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -393,7 +394,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -447,7 +448,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -501,7 +502,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -555,7 +556,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -594,14 +595,24 @@ setMethod( } ) -#' Finmix `mcmcoutputperm` class union +#' Finmix `mcmcoutputperm` class #' #' @description +#' The mcmcoutputperm class stores MCMC samples after relabeling (permuting). +#' +#' @details +#' Calling [mcmcpermute()] on an `mcmcoutput` class permutes the labels of the +#' components and generates an object of class `mcmcoutputperm`. Note, the +#' number of samples of the `mcmcoutputperm` object could be less than the +#' original number of MCMC samples due to some samples where both components +#' get assigned to the same label and henceforth get eliminated from further +#' analysis. +#' #' This class union includes all classes that define objects for permuted #' MCMC samples and is used to dispatch methods for `mcmcoutputperm` objects. #' #' @exportClass mcmcoutputperm -#' @noRd +#' @rdname mcmcoutputperm-class setClassUnion( "mcmcoutputperm", c( diff --git a/R/mcmcoutputpermpost.R b/R/mcmcoutputpermpost.R index cac0a33..41059f9 100644 --- a/R/mcmcoutputpermpost.R +++ b/R/mcmcoutputpermpost.R @@ -32,10 +32,11 @@ #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermpost -#' @describeIn mcmcoutputperm_class +#' @describeIn mcmcoutputpermpost-class +#' @keywords internal #' @seealso -#' * [mcmcoutputbase][mcmcoutput_class] for the parent class -#' * [mcmcpermind][mcmcperm_class] for the parent class +#' * [mcmcoutputbase-class] for the parent class +#' * [mcmcpermind-class] for the parent class #' * [mcmcpermute()] for performing permutation of MCMC samples .mcmcoutputpermpost <- setClass("mcmcoutputpermpost", contains = c( @@ -132,7 +133,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputperm_class +#' @keywords internal setMethod( "show", "mcmcoutputpermpost", function(object) { @@ -243,7 +244,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputperm_class +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -322,7 +323,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputperm_class Plots histograms of MCMC samples +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -378,7 +379,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputperm_class Plots densities of MCMC samples +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -434,7 +435,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputperm_class Plots point process of MCMC samples +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -490,8 +491,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputperm_class Plots sampling representations of MCMC -#' samples +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -547,8 +547,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class Plots posterior densities of component -#' parameters +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mincol.R b/R/mincol.R index d151959..c092f1e 100644 --- a/R/mincol.R +++ b/R/mincol.R @@ -11,6 +11,7 @@ #' #' @param q A vector of dimension `r(r+1)/2x1`. #' @return A symmetric matrix of dimension `rxr`. +#' @export #' #' @examples #' # Define a vector. @@ -51,6 +52,7 @@ #' #' @param q A matrix or array of vectors of dimension `r(r+1)/2x1`. #' @return An array of symmetric matrices, all of dimension `rxr`. +#' @export #' #' @examples #' # Convert a matrix of vectors @@ -82,6 +84,7 @@ #' #' @param q A symmetric matrix or dimension `rxr`. #' @return A vector of length `r(r+1)/2`. +#' @export #' #' @examples #' # Define a vector. @@ -121,6 +124,7 @@ #' #' @param q A symmetric matrix or dimension `rxr`. #' @return A vector of length `r(r+1)/2`. +#' @export #' #' @examples #' # Convert a matrix of vectors diff --git a/R/prior.R b/R/prior.R index 3384af4..7613069 100644 --- a/R/prior.R +++ b/R/prior.R @@ -179,15 +179,13 @@ #' @describeIn prior-class Checks for parameters in `prior` object #' #' @examples -#' \dontrun{ #' # Define a Poisson mixture model. #' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) #' # Call the default constructor. #' f_prior <- prior() #' # Check if the prior has appropriate parameters defined. #' hasPriorPar(f_prior, f_model) -#' hasPriorPar(f_prior, f_model, TRUE) -#' } +#' \dontrun{hasPriorPar(f_prior, f_model, TRUE)} #' #' @seealso #' * [prior-class] for the definition of the `prior` class @@ -221,8 +219,8 @@ setMethod( #' # Call the default constructor. #' f_prior <- prior() #' # Check if the prior has appropriate parameters defined. -#' hasPriorWeight(f_prior) -#' hasPriorWeight(f_prior, TRUE) +#' hasPriorWeight(f_prior, f_model) +#' \dontrun{hasPriorWeight(f_prior, f_model, TRUE)} #' #' @seealso #' * [prior][prior-class] for the definition of the `prior` class diff --git a/R/unass.R b/R/unass.R index 78f6746..05168c2 100644 --- a/R/unass.R +++ b/R/unass.R @@ -19,7 +19,7 @@ #' #' @examples #' f_model <- model(K=2, dist= 'poisson', par=list(lambda=c(0.17, 0.12))) -#' f_data <- simulate(model) +#' f_data <- simulate(f_model) #' mcmc <- mcmc() #' (f_data~f_model~mcmc) %=% mcmcstart(f_data, f_model, mcmc) #' diff --git a/man/initialize-mcmcoutputpermbase-method.Rd b/man/initialize-mcmcoutputpermbase-method.Rd index 3379ece..5beffe9 100644 --- a/man/initialize-mcmcoutputpermbase-method.Rd +++ b/man/initialize-mcmcoutputpermbase-method.Rd @@ -22,7 +22,7 @@ \item{.Object}{An object: see the "initialize Methods" section in \link{initialize}.} -\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC +\item{mcmcoutput}{An \code{mcmcoutputpermbase} class containing the results from MCMC sampling.} \item{Mperm}{An integer defining the number of permuted MCMC samples.} diff --git a/man/initialize-mcmcoutputpermfixhierpost-method.Rd b/man/initialize-mcmcoutputpermfixhierpost-method.Rd index 88ebcc5..d2db588 100644 --- a/man/initialize-mcmcoutputpermfixhierpost-method.Rd +++ b/man/initialize-mcmcoutputpermfixhierpost-method.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/mcmcoutputpermfixhierpost.R \name{initialize,mcmcoutputpermfixhierpost-method} \alias{initialize,mcmcoutputpermfixhierpost-method} -\title{Initializer of the \code{mcmcoutputpermfixhier} class} +\title{Initializer of the \code{mcmcoutputpermfixhierpost} class} \usage{ \S4method{initialize}{mcmcoutputpermfixhierpost}( .Object, @@ -18,8 +18,8 @@ \item{.Object}{An object: see the "initialize Methods" section in \link{initialize}.} -\item{mcmcoutput}{An \code{mcmcoutput} class containing the results from MCMC -sampling.} +\item{mcmcoutput}{An \code{mcmcoutputpermfixhierpost} class containing the +results from MCMC sampling.} \item{Mperm}{An integer defining the number of permuted MCMC samples.} diff --git a/man/initialize-mcmcoutputpermhier-method.Rd b/man/initialize-mcmcoutputpermhier-method.Rd index e48eedd..5422268 100644 --- a/man/initialize-mcmcoutputpermhier-method.Rd +++ b/man/initialize-mcmcoutputpermhier-method.Rd @@ -45,15 +45,15 @@ for the permuted MCMC samples.} entropy for each MCMC permuted draw.} \item{STperm}{An \code{array} of dimension \verb{Mperm\\ x 1} containing all permuted -MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +MCMC states, for the last observation in slot \code{y} of the \code{fdata} object passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the last indicator of this observation.} -\item{NKperm}{An \code{array} of dimension \verb{Mperm\\ x K} containing the numbers +\item{NKperm}{An \code{array} of dimension \code{MpermxK} containing the numbers of observations assigned to each component.} -\item{An}{\code{array} of dimension \verb{N\\ x storeS} containing the last -\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +\item{An}{\code{array} of dimension \code{NxstoreS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \code{storeS} of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} } \description{ diff --git a/man/mcmc_binomial_cc.Rd b/man/mcmc_binomial_cc.Rd index f62ba9a..eded624 100644 --- a/man/mcmc_binomial_cc.Rd +++ b/man/mcmc_binomial_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_condpoisson_cc.Rd b/man/mcmc_condpoisson_cc.Rd index a746b4f..f00ce49 100644 --- a/man/mcmc_condpoisson_cc.Rd +++ b/man/mcmc_condpoisson_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_exponential_cc.Rd b/man/mcmc_exponential_cc.Rd index bb01073..e6dd759 100644 --- a/man/mcmc_exponential_cc.Rd +++ b/man/mcmc_exponential_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_normal_cc.Rd b/man/mcmc_normal_cc.Rd index 5357e33..7449d81 100644 --- a/man/mcmc_normal_cc.Rd +++ b/man/mcmc_normal_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_normult_cc.Rd b/man/mcmc_normult_cc.Rd index 9536ab2..ec3df62 100644 --- a/man/mcmc_normult_cc.Rd +++ b/man/mcmc_normult_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_poisson_cc.Rd b/man/mcmc_poisson_cc.Rd index b6f5acd..a5f12a9 100644 --- a/man/mcmc_poisson_cc.Rd +++ b/man/mcmc_poisson_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_student_cc.Rd b/man/mcmc_student_cc.Rd index 2849380..92e40b1 100644 --- a/man/mcmc_student_cc.Rd +++ b/man/mcmc_student_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_studmult_cc.Rd b/man/mcmc_studmult_cc.Rd index feef610..47b0b52 100644 --- a/man/mcmc_studmult_cc.Rd +++ b/man/mcmc_studmult_cc.Rd @@ -50,7 +50,7 @@ Berlin, Heidelberg. \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \link[=fdata_class]{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \link[=prior_class]{prior} for the \code{prior} class definition \item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmcoutput_class.Rd b/man/mcmcoutput_class.Rd index 75e8f8c..736782d 100644 --- a/man/mcmcoutput_class.Rd +++ b/man/mcmcoutput_class.Rd @@ -1,8 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/mcmcoutputfix.R, % R/mcmcoutputfixhier.R, R/mcmcoutputfixpost.R, R/mcmcoutputfixhierpost.R, -% R/mcmcoutputbase.R, R/mcmcoutputhier.R, R/mcmcoutputpost.R, -% R/mcmcoutputhierpost.R +% R/mcmcoutputhier.R, R/mcmcoutputpost.R, R/mcmcoutputhierpost.R \docType{class} \name{subseq} \alias{subseq} @@ -33,12 +32,6 @@ \alias{mcmcoutputfixhierpost-class} \alias{.mcmcoutputfixhierpost} \alias{plotHist,mcmcoutputfixhierpost-method} -\alias{plotTraces,mcmcoutputbase-method} -\alias{plotHist,mcmcoutputbase-method} -\alias{plotDens,mcmcoutputbase-method} -\alias{plotPointProc,mcmcoutputbase-method} -\alias{plotSampRep,mcmcoutputbase-method} -\alias{plotPostDens,mcmcoutputbase-method} \alias{plotPostDens,mcmcoutputhier-method} \alias{show,mcmcoutputpost-method} \alias{plotPostDens,mcmcoutputpost-method} @@ -88,18 +81,6 @@ subseq(object, index) \S4method{plotHist}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) -\S4method{plotTraces}{mcmcoutputbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputbase}(x, dev = TRUE, ...) - \S4method{plotPostDens}{mcmcoutputhier}(x, dev = TRUE, ...) \S4method{show}{mcmcoutputpost}(object) @@ -169,18 +150,6 @@ Posterior densities of the MCMC samples. Histograms of the MCMC samples. -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point processes of the MCMC samples. - -Sampling representations of the MCMC samples. - -Posterior densities of the MCMC samples. - Posterior densities of the MCMC samples. A console output listing the slots and summary information about @@ -313,31 +282,6 @@ weights and the posterior parameters are considered in the histogram plots. Note that this method calls the equivalent method from the parent class \code{mcmcoutputfixhier}. -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{0}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component parameters from MCMC sampling, if the number of components is two. @@ -420,18 +364,6 @@ Note, this method calls the equivalent method of the parent class. \item \code{plotHist,mcmcoutputfixhierpost-method}: -\item \code{plotTraces,mcmcoutputbase-method}: - -\item \code{plotHist,mcmcoutputbase-method}: - -\item \code{plotDens,mcmcoutputbase-method}: - -\item \code{plotPointProc,mcmcoutputbase-method}: - -\item \code{plotSampRep,mcmcoutputbase-method}: - -\item \code{plotPostDens,mcmcoutputbase-method}: - \item \code{plotPostDens,mcmcoutputhier-method}: \item \code{show,mcmcoutputpost-method}: Shows a short summary of the object's slots @@ -739,90 +671,6 @@ f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) plotHist(f_output) } -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPointProc(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotSampRep(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) - \dontrun{ # Define a Poisson mixture model with two components. f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) @@ -1103,60 +951,6 @@ indicators. \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values diff --git a/man/mcmcoutputbase-class.Rd b/man/mcmcoutputbase-class.Rd index 31387ef..408fed3 100644 --- a/man/mcmcoutputbase-class.Rd +++ b/man/mcmcoutputbase-class.Rd @@ -4,12 +4,111 @@ \name{mcmcoutputbase-class} \alias{mcmcoutputbase-class} \alias{.mcmcoutputbase} +\alias{show,mcmcoutputbase-method} +\alias{plotTraces,mcmcoutputbase-method} +\alias{plotHist,mcmcoutputbase-method} +\alias{plotDens,mcmcoutputbase-method} +\alias{plotPointProc,mcmcoutputbase-method} +\alias{plotSampRep,mcmcoutputbase-method} +\alias{plotPostDens,mcmcoutputbase-method} \title{Finmix \code{mcmcoutput} base class for unknown indicators} +\usage{ +\S4method{show}{mcmcoutputbase}(object) + +\S4method{plotTraces}{mcmcoutputbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputbase}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{object}{An \code{mcmcoutputbase} object.} + +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A console output listing the slots and summary information about +each of them. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point processes of the MCMC samples. + +Sampling representations of the MCMC samples. + +Posterior densities of the MCMC samples. +} \description{ This class defines the basic slots for the MCMC sampling output when indicators are not known. It inherits from the -\link[=mcmcoutput_class]{mcmcoutfix}. +\linkS4class{mcmcoutputfix}. + +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputbase} object gives an overview +of the \code{mcmcoutputbase} object. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{0}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. } +\section{Functions}{ +\itemize{ +\item \code{show,mcmcoutputbase-method}: Shows a short summary of the object's slots + +\item \code{plotTraces,mcmcoutputbase-method}: + +\item \code{plotHist,mcmcoutputbase-method}: + +\item \code{plotDens,mcmcoutputbase-method}: + +\item \code{plotPointProc,mcmcoutputbase-method}: + +\item \code{plotSampRep,mcmcoutputbase-method}: + +\item \code{plotPostDens,mcmcoutputbase-method}: +}} + \section{Slots}{ \describe{ @@ -36,3 +135,144 @@ indicators defining the last "clustering" of observations into the mixture components.} }} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd index bacb506..50a410e 100644 --- a/man/mcmcoutputperm-class.Rd +++ b/man/mcmcoutputperm-class.Rd @@ -1,28 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermhier.R +% Please edit documentation in R/mcmcoutputpermhierpost.R \docType{class} -\name{mcmcoutputpermhier-class} -\alias{mcmcoutputpermhier-class} -\alias{.mcmcoutputpermhier} -\title{Finmix \code{mcmcoutputpermhier} class} +\name{mcmcoutputperm-class} +\alias{mcmcoutputperm-class} +\title{Finmix \code{mcmcoutputperm} class} \description{ -This class defines objects to store the outputs from permuting the MCMC -samples. Due to label switching the sampled component parameters are usually -not assigned to the same component in each iteration. To overcome this issue -the samples are permuted by using a relabeling algorithm (usually K-means) -to reassign parameters. Note that due to assignment of parameters from the -same iteration to the same component, the sample size could shrink. - -This class stores the permuted parameters together with the new MCMC sample -size and the mixture log-likelihood, the prior log-likelihood, and the -complete data posterior log-likelihood. - -Note that this class inherits all of its slots from the parent classes. -} -\seealso{ -\itemize{ -\item \linkS4class{mcmcoutputhier} for the parent class -\item \linkS4class{mcmcpermindhier} for the parent class -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +The mcmcoutputperm class stores MCMC samples after relabeling (permuting). } +\details{ +Calling \code{\link[=mcmcpermute]{mcmcpermute()}} on an \code{mcmcoutput} class permutes the labels of the +components +This class union includes all classes that define objects for permuted +MCMC samples and is used to dispatch methods for \code{mcmcoutputperm} objects. } diff --git a/man/mcmcoutputperm_class.Rd b/man/mcmcoutputperm_class.Rd index f35d90a..8cca6c9 100644 --- a/man/mcmcoutputperm_class.Rd +++ b/man/mcmcoutputperm_class.Rd @@ -1,152 +1,31 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfixhier.R, -% R/mcmcoutputpermbase.R, R/mcmcoutputpermhier.R, R/mcmcoutputpermpost.R, -% R/mcmcoutputpermhierpost.R -\docType{class} +% Please edit documentation in R/mcmcoutputpermfixhier.R, R/mcmcoutputpermhier.R \name{plotPostDens,mcmcoutputpermfixhier-method} \alias{plotPostDens,mcmcoutputpermfixhier-method} -\alias{plotTraces,mcmcoutputpermbase-method} -\alias{plotHist,mcmcoutputpermbase-method} -\alias{plotDens,mcmcoutputpermbase-method} -\alias{plotPointProc,mcmcoutputpermbase-method} -\alias{plotSampRep,mcmcoutputpermbase-method} -\alias{plotPostDens,mcmcoutputpermbase-method} -\alias{plotTraces,mcmcoutputpermhier-method} -\alias{plotHist,mcmcoutputpermhier-method} -\alias{plotDens,mcmcoutputpermhier-method} \alias{plotPointProc,mcmcoutputpermhier-method} \alias{plotSampRep,mcmcoutputpermhier-method} -\alias{plotPostDens,mcmcoutputpermhier-method} -\alias{plotTraces,mcmcoutputpermpost-method} -\alias{plotHist,mcmcoutputpermpost-method} -\alias{plotDens,mcmcoutputpermpost-method} -\alias{plotPointProc,mcmcoutputpermpost-method} -\alias{plotSampRep,mcmcoutputpermpost-method} -\alias{plotPostDens,mcmcoutputpermpost-method} -\alias{mcmcoutputpermhierpost-class} -\alias{.mcmcoutputpermhierpost} -\alias{plotTraces,mcmcoutputpermhierpost-method} -\alias{plotHist,mcmcoutputpermhierpost-method} -\alias{plotDens,mcmcoutputpermhierpost-method} -\alias{plotPointProc,mcmcoutputpermhierpost-method} -\alias{plotSampRep,mcmcoutputpermhierpost-method} -\alias{plotPostDens,mcmcoutputpermhierpost-method} \title{Plot posterior densities of the component parameters} \usage{ \S4method{plotPostDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) -\S4method{plotTraces}{mcmcoutputpermbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputpermhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermhier}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermhier}(x, dev = TRUE, ...) - \S4method{plotPointProc}{mcmcoutputpermhier}(x, dev = TRUE, ...) \S4method{plotSampRep}{mcmcoutputpermhier}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermhier}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputpermpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermpost}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermpost}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermpost}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermpost}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermpost}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputpermhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) } \arguments{ -\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} \item{dev}{A logical indicating, if the plots should be shown by a graphical device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} \item{...}{Further arguments to be passed to the plotting function.} - -\item{lik}{An integer indicating, if the log-likelihood traces should be -plotted (default). If set to \code{0} the traces for the parameters -and weights are plotted instead.} - -\item{col}{A logical indicating, if the plot should be colored.} } \value{ Posterior densities of the MCMC samples. -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point process of the MCMC samples. - -Sampling representation of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - Densities of the MCMC samples. Densities of the MCMC samples. - -Posterior densities of the MCMC samples. } \description{ Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component @@ -155,155 +34,6 @@ parameters from MCMC sampling, if the number of components is two. Note, this method is so far only implemented for Poisson and Binomial mixture distributions. -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling. - -Note, this method is so far only implemented for mictures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson or Binomial -mixture distributions. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. - -If \code{lik} is set to \code{0} the parameters of the components and the hierarchical -prior are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling. In addition the parameters of the hierarchical prior are -plotted. - -Note, this method is so far only implemented for mictures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling. In addition, the parameters of the hierarchical prior -are plotted. - -Note, this method is so far only implemented for mixtures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson or Binomial -mixture distributions. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling. - -Note, this method is so far only implemented for mixtures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling. - -Note, this method is so far only implemented for mixtures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson or Binomial -mixture distributions. - -This class defines objects to store the outputs from permuting the MCMC -samples. Due to label switching the sampled component parameters are usually -not assigned to the same component in each iteration. To overcome this issue -the samples are permuted by using a relabeling algorithm (usually K-means) -to reassign parameters. Note that due to assignment of parameters from the -same iteration to the same component, the sample size could shrink. - -This class stores the permuted parameters together with the new MCMC sample -size and the mixture log-likelihood, the prior log-likelihood, and the -complete data posterior log-likelihood. - -Note that this class inherits all of its slots from the parent classes. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. - -If \code{lik} is set to \code{0} the parameters of the components, the posterior -parameters, and the parameters of the hierarchical prior are plotted -together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling. In addition the parameters of the hierarchical prior are -plotted. - -Note, this method is so far only implemented for mictures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling. In addition, the parameters of the hierarchical prior -are plotted. - -Note, this method is so far only implemented for mixtures of Poisson and -Binomial distributions. - Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component parameters from MCMC sampling. @@ -315,68 +45,14 @@ component parameters from MCMC sampling. Note, this method is only implemented for mixtures of Poisson and Binomial distributions. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson or Binomial -mixture distributions. } \section{Functions}{ \itemize{ \item \code{plotPostDens,mcmcoutputpermfixhier-method}: -\item \code{plotTraces,mcmcoutputpermbase-method}: - -\item \code{plotHist,mcmcoutputpermbase-method}: - -\item \code{plotDens,mcmcoutputpermbase-method}: - -\item \code{plotPointProc,mcmcoutputpermbase-method}: - -\item \code{plotSampRep,mcmcoutputpermbase-method}: - -\item \code{plotPostDens,mcmcoutputpermbase-method}: - -\item \code{plotTraces,mcmcoutputpermhier-method}: Plots traces of MCMC samples - -\item \code{plotHist,mcmcoutputpermhier-method}: - -\item \code{plotDens,mcmcoutputpermhier-method}: - \item \code{plotPointProc,mcmcoutputpermhier-method}: \item \code{plotSampRep,mcmcoutputpermhier-method}: - -\item \code{plotPostDens,mcmcoutputpermhier-method}: - -\item \code{plotTraces,mcmcoutputpermpost-method}: - -\item \code{plotHist,mcmcoutputpermpost-method}: Plots histograms of MCMC samples - -\item \code{plotDens,mcmcoutputpermpost-method}: Plots densities of MCMC samples - -\item \code{plotPointProc,mcmcoutputpermpost-method}: Plots point process of MCMC samples - -\item \code{plotSampRep,mcmcoutputpermpost-method}: Plots sampling representations of MCMC -samples - -\item \code{plotPostDens,mcmcoutputpermpost-method}: Plots posterior densities of component -parameters - -\item \code{mcmcoutputpermhierpost-class}: Finmix \code{mcmcoutputpermhierpost} class - -\item \code{plotTraces,mcmcoutputpermhierpost-method}: - -\item \code{plotHist,mcmcoutputpermhierpost-method}: - -\item \code{plotDens,mcmcoutputpermhierpost-method}: - -\item \code{plotPointProc,mcmcoutputpermhierpost-method}: - -\item \code{plotSampRep,mcmcoutputpermhierpost-method}: - -\item \code{plotPostDens,mcmcoutputpermhierpost-method}: }} \examples{ @@ -404,53 +80,6 @@ f_data <- simulate(f_model) f_mcmc <- mcmc(storepost = FALSE) # Define the prior distribution by relying on the data. f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE # Start MCMC sampling. f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) f_outputperm <- mcmcpermute(f_output) @@ -464,446 +93,32 @@ f_data <- simulate(f_model) f_mcmc <- mcmc(storepost = FALSE) # Define the prior distribution by relying on the data. f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE # Start MCMC sampling. f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) f_outputperm <- mcmcpermute(f_output) plotSampRep(f_outputperm) -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling @@ -914,80 +129,4 @@ plotPostDens(f_outputperm) \item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class -\item \link[=mcmcperm_class]{mcmcpermind} for the parent class -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} } diff --git a/man/mcmcoutputpermbase-class.Rd b/man/mcmcoutputpermbase-class.Rd index 117b25e..2ee6730 100644 --- a/man/mcmcoutputpermbase-class.Rd +++ b/man/mcmcoutputpermbase-class.Rd @@ -4,7 +4,61 @@ \name{mcmcoutputpermbase-class} \alias{mcmcoutputpermbase-class} \alias{.mcmcoutputpermbase} +\alias{show,mcmcoutputpermbase-method} +\alias{plotTraces,mcmcoutputpermbase-method} +\alias{plotHist,mcmcoutputpermbase-method} +\alias{plotDens,mcmcoutputpermbase-method} +\alias{plotPointProc,mcmcoutputpermbase-method} +\alias{plotSampRep,mcmcoutputpermbase-method} +\alias{plotPostDens,mcmcoutputpermbase-method} \title{Finmix \code{mcmcoutputpermbase} class} +\usage{ +\S4method{show}{mcmcoutputpermbase}(object) + +\S4method{plotTraces}{mcmcoutputpermbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) + +\S4method{plotHist}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotPointProc}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotSampRep}{mcmcoutputpermbase}(x, dev = TRUE, ...) + +\S4method{plotPostDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermbase} object.} + +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A console output listing the slots and summary information about +each of them. + +A plot of the traces of the MCMC samples. + +Histograms of the MCMC samples. + +Densities of the MCMC samples. + +Point process of the MCMC samples. + +Sampling representation of the MCMC samples. + +Posterior densities of the MCMC samples. +} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -18,11 +72,233 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note that this class inherits all of its slots from the parent classes. + +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermbase} object gives an overview +of the \code{mcmcoutputpermbase} object. + +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. + +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mictures of Poisson and +Binomial distributions. + +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. + +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. + +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. +} +\section{Functions}{ +\itemize{ +\item \code{show,mcmcoutputpermbase-method}: Shows a short summary of the object's +slots + +\item \code{plotTraces,mcmcoutputpermbase-method}: + +\item \code{plotHist,mcmcoutputpermbase-method}: Plot histograms of the parameters and +weights + +\item \code{plotDens,mcmcoutputpermbase-method}: + +\item \code{plotPointProc,mcmcoutputpermbase-method}: Plots point process for the component +parameters + +\item \code{plotSampRep,mcmcoutputpermbase-method}: Plots sampling representations of the +component parameters + +\item \code{plotPostDens,mcmcoutputpermbase-method}: Plots the posterior density of the +component parameters +}} + +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class -\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \linkS4class{mcmcoutputbase} for the parent class +\item \linkS4class{mcmcpermind} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} + +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} } diff --git a/man/mcmcoutputpermfixhier-class.Rd b/man/mcmcoutputpermfixhier-class.Rd index a9eea75..6d5d968 100644 --- a/man/mcmcoutputpermfixhier-class.Rd +++ b/man/mcmcoutputpermfixhier-class.Rd @@ -4,7 +4,18 @@ \name{mcmcoutputpermfixhier-class} \alias{mcmcoutputpermfixhier-class} \alias{.mcmcoutputpermfixhier} +\alias{show,mcmcoutputpermfixhier-method} \title{Finmix \code{mcmcoutputpermfixhier} class} +\usage{ +\S4method{show}{mcmcoutputpermfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -18,7 +29,16 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note this class inherits all slots from its parent classes. + +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhier} object gives an overview +of the \code{mcmcoutputpermfixhier} object. } +\section{Functions}{ +\itemize{ +\item \code{show,mcmcoutputpermfixhier-method}: Shows a short summary of the +object's slots +}} + \seealso{ \itemize{ \item \linkS4class{mcmcoutputpermfix} for the parent class diff --git a/man/mcmcoutputpermfixhierpost-class.Rd b/man/mcmcoutputpermfixhierpost-class.Rd index b1e0524..1052ac3 100644 --- a/man/mcmcoutputpermfixhierpost-class.Rd +++ b/man/mcmcoutputpermfixhierpost-class.Rd @@ -4,7 +4,18 @@ \name{mcmcoutputpermfixhierpost-class} \alias{mcmcoutputpermfixhierpost-class} \alias{.mcmcoutputpermfixhierpost} +\alias{show,mcmcoutputpermfixhierpost-method} \title{Finmix \code{mcmcoutputpermfixhierpost} class} +\usage{ +\S4method{show}{mcmcoutputpermfixhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -18,11 +29,21 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note this class inherits all slots from its parent classes. + +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhierpost} object gives an overview +of the \code{mcmcoutputpermfixhierpost} object. } +\section{Functions}{ +\itemize{ +\item \code{show,mcmcoutputpermfixhierpost-method}: Shows a short summary of the +object's slots +}} + \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputfixhierpost} for the parent class -\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class +\item \linkS4class{mcmcoutputfixhierpost} for the parent class +\item \linkS4class{mcmcpermfixhier} for the parent class +\item \linkS4class{mcmcpermfixpost} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } } diff --git a/man/mcmcoutputpermfixpost-class.Rd b/man/mcmcoutputpermfixpost-class.Rd index acd1d75..b711797 100644 --- a/man/mcmcoutputpermfixpost-class.Rd +++ b/man/mcmcoutputpermfixpost-class.Rd @@ -4,11 +4,31 @@ \name{mcmcoutputpermfixpost-class} \alias{mcmcoutputpermfixpost-class} \alias{.mcmcoutputpermfixpost} +\alias{show,mcmcoutputpermfixpost-method} \title{Finmix \code{mcmcoutput} class for fixed indicators and posterior parameters} +\usage{ +\S4method{show}{mcmcoutputpermfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} \description{ This class defines the storage of parameters of the posterior distribution. It inherits from the + +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixpost} object gives an overview +of the \code{mcmcoutputpermfixpost} object. } +\section{Functions}{ +\itemize{ +\item \code{show,mcmcoutputpermfixpost-method}: Shows a short summary of the +object's slots +}} + \seealso{ } diff --git a/man/mcmcoutputpermhier-class.Rd b/man/mcmcoutputpermhier-class.Rd index f2c8240..18bb65b 100644 --- a/man/mcmcoutputpermhier-class.Rd +++ b/man/mcmcoutputpermhier-class.Rd @@ -21,8 +21,9 @@ Note that this class inherits all of its slots from the parent classes. } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class -\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \linkS4class{mcmcoutputhier} for the parent class +\item \linkS4class{mcmcpermindhier} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } } +\keyword{internal} diff --git a/man/mcmcoutputpermpost-class.Rd b/man/mcmcoutputpermpost-class.Rd index 11a6451..e0b0963 100644 --- a/man/mcmcoutputpermpost-class.Rd +++ b/man/mcmcoutputpermpost-class.Rd @@ -21,8 +21,9 @@ Note that this class inherits all of its slots from the parent classes. } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputbase} for the parent class -\item \link[=mcmcperm_class]{mcmcpermind} for the parent class +\item \linkS4class{mcmcoutputbase} for the parent class +\item \linkS4class{mcmcpermind} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } } +\keyword{internal} diff --git a/man/mcmcperm_class.Rd b/man/mcmcperm_class.Rd index f2ae693..24db7eb 100644 --- a/man/mcmcperm_class.Rd +++ b/man/mcmcperm_class.Rd @@ -1,17 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcpermfixpost.R, R/mcmcpermind.R, -% R/mcmcpermindhier.R, R/mcmcpermindpost.R +% Please edit documentation in R/mcmcpermind.R, R/mcmcpermindhier.R, +% R/mcmcpermindpost.R \docType{class} -\name{mcmcpermfixpost-class} -\alias{mcmcpermfixpost-class} -\alias{.mcmcpermfixpost} +\name{mcmcpermind-class} \alias{mcmcpermind-class} \alias{.mcmcpermind} \alias{mcmcpermindhier-class} \alias{.mcmcpermindhier} \alias{mcmcpermindpost-class} \alias{.mcmcpermindpost} -\title{Finmix \code{mcmcpermfixpost} class} +\title{Finmix \code{mcmcpermind} class} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -20,18 +18,6 @@ the samples are permuted by using a relabeling algorithm (usually K-means) to reassign parameters. Note that due to assignment of parameters from the same iteration to the same component, the sample size could shrink. -This class is supplementing the parent class by adding a slot to store the -permuted parameter samples of the posterior densities. - -Note that for models with fixed indicators \code{weight}s do not get permuted. - -This class defines objects to store the outputs from permuting the MCMC -samples. Due to label switching the sampled component parameters are usually -not assigned to the same component in each iteration. To overcome this issue -the samples are permuted by using a relabeling algorithm (usually K-means) -to reassign parameters. Note that due to assignment of parameters from the -same iteration to the same component, the sample size could shrink. - This class stores the permuted parameters together with the new MCMC sample size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. All this slots are inherited from @@ -63,8 +49,6 @@ permuted parameter samples of the posterior densities. } \section{Functions}{ \itemize{ -\item \code{mcmcpermfixpost-class}: - \item \code{mcmcpermind-class}: \item \code{mcmcpermindhier-class}: @@ -75,9 +59,6 @@ permuted parameter samples of the posterior densities. \section{Slots}{ \describe{ -\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of -parameters from the posterior density.} - \item{\code{relabel}}{A character defining the used algorithm for relabeling.} \item{\code{weightperm}}{An array of dimension \verb{Mperm x K} containing the @@ -106,13 +87,6 @@ parameters from the posterior density.} }} \seealso{ -\itemize{ -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function -\item \link[=mcmcperm_class]{mcmcpermfix} for the parent class definition -\item \link[=mcmcperm_class]{mcmcpermindpost} for the corresponding class for models with -unknown indicators -} - \itemize{ \item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function \item \link[=mcmcperm_class]{mcmcperfix} for the corresponding class for models with diff --git a/man/prior-class.Rd b/man/prior-class.Rd index ffec9c2..4aa5023 100644 --- a/man/prior-class.Rd +++ b/man/prior-class.Rd @@ -65,15 +65,15 @@ f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) f_prior <- prior() # Check if the prior has appropriate parameters defined. hasPriorPar(f_prior, f_model) -hasPriorPar(f_prior, f_model, TRUE) +\dontrun{hasPriorPar(f_prior, f_model, TRUE)} # Define a Poisson mixture model. f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) # Call the default constructor. f_prior <- prior() # Check if the prior has appropriate parameters defined. -hasPriorWeight(f_prior) -hasPriorWeight(f_prior, TRUE) +hasPriorWeight(f_prior, f_model) +\dontrun{hasPriorWeight(f_prior, f_model, TRUE)} } \references{ @@ -88,8 +88,8 @@ hasPriorWeight(f_prior, TRUE) } \itemize{ -\item \link[=prior-class]{prior} for the definition of the \code{prior} class -\item \link[=model_class]{model} for the definition of the \code{model} class +\item \linkS4class{prior} for the definition of the \code{prior} class +\item \linkS4class{model} for the definition of the \code{model} class } \itemize{ diff --git a/man/show-csdatamoments-method.Rd b/man/show-csdatamoments-method.Rd deleted file mode 100644 index e2f8ba0..0000000 --- a/man/show-csdatamoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/csdatamoments.R -\name{show,csdatamoments-method} -\alias{show,csdatamoments-method} -\title{Shows a summary of an \code{csdatamoments} object.} -\usage{ -\S4method{show}{csdatamoments}(object) -} -\arguments{ -\item{object}{An \code{csdatamoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{csdatamoments} object gives an overview -of the moments of a finite mixture with continuous data. -} diff --git a/man/show-groupmoments-method.Rd b/man/show-groupmoments-method.Rd deleted file mode 100644 index 5dcef81..0000000 --- a/man/show-groupmoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/groupmoments.R -\name{show,groupmoments-method} -\alias{show,groupmoments-method} -\title{Shows a summary of a \code{groupmoments} object.} -\usage{ -\S4method{show}{groupmoments}(object) -} -\arguments{ -\item{object}{A \code{groupmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on a \code{groupmoments} object gives an overview -of the moments of a finit mixture with continuous data. -} diff --git a/man/show-mcmcoutputbase-method.Rd b/man/show-mcmcoutputbase-method.Rd deleted file mode 100644 index fe2c19f..0000000 --- a/man/show-mcmcoutputbase-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputbase.R -\name{show,mcmcoutputbase-method} -\alias{show,mcmcoutputbase-method} -\title{Shows a summary of an \code{mcmcoutputbase} object.} -\usage{ -\S4method{show}{mcmcoutputbase}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputbase} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputbase} object gives an overview -of the \code{mcmcoutputbase} object. -} diff --git a/man/show-mcmcoutputpermbase-method.Rd b/man/show-mcmcoutputpermbase-method.Rd deleted file mode 100644 index 82e348b..0000000 --- a/man/show-mcmcoutputpermbase-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermbase.R -\name{show,mcmcoutputpermbase-method} -\alias{show,mcmcoutputpermbase-method} -\title{Shows a summary of an \code{mcmcoutputpermbase} object.} -\usage{ -\S4method{show}{mcmcoutputpermbase}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermbase} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermbase} object gives an overview -of the \code{mcmcoutputpermbase} object. -} diff --git a/man/show-mcmcoutputpermfixhier-method.Rd b/man/show-mcmcoutputpermfixhier-method.Rd deleted file mode 100644 index a0b7978..0000000 --- a/man/show-mcmcoutputpermfixhier-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfixhier.R -\name{show,mcmcoutputpermfixhier-method} -\alias{show,mcmcoutputpermfixhier-method} -\title{Shows a summary of an \code{mcmcoutputpermfixhier} object.} -\usage{ -\S4method{show}{mcmcoutputpermfixhier}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfixhier} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhier} object gives an overview -of the \code{mcmcoutputpermfixhier} object. -} diff --git a/man/show-mcmcoutputpermfixhierpost-method.Rd b/man/show-mcmcoutputpermfixhierpost-method.Rd deleted file mode 100644 index 20e1f7c..0000000 --- a/man/show-mcmcoutputpermfixhierpost-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfixhierpost.R -\name{show,mcmcoutputpermfixhierpost-method} -\alias{show,mcmcoutputpermfixhierpost-method} -\title{Shows a summary of an \code{mcmcoutputpermfixhierpost} object.} -\usage{ -\S4method{show}{mcmcoutputpermfixhierpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfixhierpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhierpost} object gives an overview -of the \code{mcmcoutputpermfixhierpost} object. -} diff --git a/man/show-mcmcoutputpermfixpost-method.Rd b/man/show-mcmcoutputpermfixpost-method.Rd deleted file mode 100644 index 3d4e463..0000000 --- a/man/show-mcmcoutputpermfixpost-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfixpost.R -\name{show,mcmcoutputpermfixpost-method} -\alias{show,mcmcoutputpermfixpost-method} -\title{Shows a summary of an \code{mcmcoutputpermfixpost} object.} -\usage{ -\S4method{show}{mcmcoutputpermfixpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfixpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixpost} object gives an overview -of the \code{mcmcoutputpermfixpost} object. -} diff --git a/man/show-mcmcoutputpermhier-method.Rd b/man/show-mcmcoutputpermhier-method.Rd index 997b333..3c88202 100644 --- a/man/show-mcmcoutputpermhier-method.Rd +++ b/man/show-mcmcoutputpermhier-method.Rd @@ -17,3 +17,4 @@ each of them. Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermhier} object gives an overview of the \code{mcmcoutputpermhier} object. } +\keyword{internal} diff --git a/man/show-mcmcoutputpermhierpost-method.Rd b/man/show-mcmcoutputpermhierpost-method.Rd index 4c0b932..adc779b 100644 --- a/man/show-mcmcoutputpermhierpost-method.Rd +++ b/man/show-mcmcoutputpermhierpost-method.Rd @@ -17,3 +17,4 @@ each of them. Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermhierpost} object gives an overview of the \code{mcmcoutputpermhierpost} object. } +\keyword{internal} diff --git a/man/show-mcmcoutputpermpost-method.Rd b/man/show-mcmcoutputpermpost-method.Rd index 6805754..bcdb69c 100644 --- a/man/show-mcmcoutputpermpost-method.Rd +++ b/man/show-mcmcoutputpermpost-method.Rd @@ -17,3 +17,4 @@ each of them. Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermpost} object gives an overview of the \code{mcmcoutputpermpost} object. } +\keyword{internal} diff --git a/man/stephens1997a_binomial_cc.Rd b/man/stephens1997a_binomial_cc.Rd index 577ea8b..67a8cdd 100644 --- a/man/stephens1997a_binomial_cc.Rd +++ b/man/stephens1997a_binomial_cc.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/RcppExports.R \name{stephens1997a_binomial_cc} \alias{stephens1997a_binomial_cc} -\title{Relabeling algorithm from Stephens (1997a) for Binomial mixture models} +\title{Stephens (1997a) relabeling algorithm for Binomial mixtures} \usage{ stephens1997a_binomial_cc(values1, values2, pars, perm) } @@ -39,10 +39,11 @@ Statistical Society: Series B (Statistical Methodology), 59: 731-792. } \seealso{ \itemize{ -\item \code{\link{mcmcpermute}} for the calling function -\item \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \code{\link[=stephens1997b_poisson_cc]{stephens1997b_poisson_cc()}} for the re-labeling algorithm from Stephens (1997b) -\item \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +\item \code{\link[=stephens1997a_binomial_cc]{stephens1997a_binomial_cc()}} for the equivalent implementation for mixtures of Binomial distributions } } +\keyword{internal} diff --git a/man/stephens1997a_poisson_cc.Rd b/man/stephens1997a_poisson_cc.Rd index 5207ef5..fc17090 100644 --- a/man/stephens1997a_poisson_cc.Rd +++ b/man/stephens1997a_poisson_cc.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/RcppExports.R \name{stephens1997a_poisson_cc} \alias{stephens1997a_poisson_cc} -\title{Relabeling algorithm from Stephens (1997a) for Poisson mixture models} +\title{Stephens (1997a) relabeling algorithm for Poisson mixtures} \usage{ stephens1997a_poisson_cc(values1, values2, pars, perm) } @@ -39,10 +39,11 @@ Statistical Society: Series B (Statistical Methodology), 59: 731-792. } \seealso{ \itemize{ -\item \code{\link{mcmcpermute}} for the calling function -\item \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \code{\link[=stephens1997b_poisson_cc]{stephens1997b_poisson_cc()}} for the re-labeling algorithm from Stephens (1997b) -\item \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +\item \code{\link[=stephens1997a_binomial_cc]{stephens1997a_binomial_cc()}} for the equivalent implementation for mixtures of Binomial distributions } } +\keyword{internal} diff --git a/man/stephens1997b_binomial_cc.Rd b/man/stephens1997b_binomial_cc.Rd index 1d183e1..f55581a 100644 --- a/man/stephens1997b_binomial_cc.Rd +++ b/man/stephens1997b_binomial_cc.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/RcppExports.R \name{stephens1997b_binomial_cc} \alias{stephens1997b_binomial_cc} -\title{Relabeling algorithm from Stephens (1997b) for Binomial mixture models} +\title{Stephens (1997b) relabeling algorithm for Binomial mixtures} \usage{ stephens1997b_binomial_cc(values, reps, comp_par, weight_par) } @@ -34,10 +34,10 @@ distributions, DPhil Thesis, University of Oxford, Oxford. } \seealso{ \itemize{ -\item \code{\link{mcmcpermute}} for the calling function -\item \code{\link{stephens1997a_binomial_cc}} for the re-labeling algorithm from +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \code{\link[=stephens1997a_binomial_cc]{stephens1997a_binomial_cc()}} for the re-labeling algorithm from Stephens (1997a) -\item \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +\item \code{\link[=stephens1997b_poisson_cc]{stephens1997b_poisson_cc()}} for the equivalent implementation for mixtures of Poisson distributions } } diff --git a/man/stephens1997b_exponential_cc.Rd b/man/stephens1997b_exponential_cc.Rd index 97d669d..943fc11 100644 --- a/man/stephens1997b_exponential_cc.Rd +++ b/man/stephens1997b_exponential_cc.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/RcppExports.R \name{stephens1997b_exponential_cc} \alias{stephens1997b_exponential_cc} -\title{Relabeling algorithm from Stephens (1997b) for Exponential mixture models} +\title{Stephens (1997b) relabeling algorithm for Exponential mixtures} \usage{ stephens1997b_exponential_cc(values, comp_par, weight_par) } @@ -34,10 +34,11 @@ distributions, DPhil Thesis, University of Oxford, Oxford. } \seealso{ \itemize{ -\item \code{\link{mcmcpermute}} for the calling function -\item \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \code{\link[=stephens1997b_poisson_cc]{stephens1997b_poisson_cc()}} for the equivalent implementation for mixtures of Poisson distributions -\item \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +\item \code{\link[=stephens1997b_binomial_cc]{stephens1997b_binomial_cc()}} for the equivalent implementation for mixtures of Binomial distributions } } +\keyword{internal} diff --git a/man/stephens1997b_poisson_cc.Rd b/man/stephens1997b_poisson_cc.Rd index 5ab08d6..286e367 100644 --- a/man/stephens1997b_poisson_cc.Rd +++ b/man/stephens1997b_poisson_cc.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/RcppExports.R \name{stephens1997b_poisson_cc} \alias{stephens1997b_poisson_cc} -\title{Relabeling algorithm from Stephens (1997b) for Poisson mixture models} +\title{Stephens (1997b) relabeling algorithm for Poisson mixtures} \usage{ stephens1997b_poisson_cc(values, comp_par, weight_par, max_iter = 200L) } @@ -34,10 +34,10 @@ distributions, DPhil Thesis, University of Oxford, Oxford. } \seealso{ \itemize{ -\item \code{\link{mcmcpermute}} for the calling function -\item \code{\link{stephens1997a_poisson_cc}} for the re-labeling algorithm from +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \code{\link[=stephens1997a_poisson_cc]{stephens1997a_poisson_cc()}} for the re-labeling algorithm from Stephens (1997a) -\item \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +\item \code{\link[=stephens1997b_binomial_cc]{stephens1997b_binomial_cc()}} for the equivalent implementation for mixtures of Binomial distributions } } diff --git a/man/swap_cc.Rd b/man/swap_cc.Rd index 0846666..7149337 100644 --- a/man/swap_cc.Rd +++ b/man/swap_cc.Rd @@ -21,7 +21,7 @@ columns via the indices provided in the \code{index} matrix. All to \verb{C++} using the packages \code{Rcpp} and \code{RcppArmadillo}. } \examples{ -values <- matrix(rnorm(10), nrow = 2) +values <- matrix(rnorm(10), ncol = 2) index <- matrix(c(2,1), nrow = 5, ncol = 2) swap_cc(values, index) diff --git a/man/unsass.Rd b/man/unsass.Rd index ee2e392..3c35a47 100644 --- a/man/unsass.Rd +++ b/man/unsass.Rd @@ -27,7 +27,7 @@ via \code{lhs \%=\% rhs}. } \examples{ f_model <- model(K=2, dist= 'poisson', par=list(lambda=c(0.17, 0.12))) -f_data <- simulate(model) +f_data <- simulate(f_model) mcmc <- mcmc() (f_data~f_model~mcmc) \%=\% mcmcstart(f_data, f_model, mcmc) diff --git a/src/attributes.cpp b/src/attributes.cpp index a7a8084..dcca91b 100644 --- a/src/attributes.cpp +++ b/src/attributes.cpp @@ -42,7 +42,7 @@ //' @export //' //' @examples -//' values <- matrix(rnorm(10), nrow = 2) +//' values <- matrix(rnorm(10), ncol = 2) //' index <- matrix(c(2,1), nrow = 5, ncol = 2) //' swap_cc(values, index) //' diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index bf84f0d..087ac72 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -34,7 +34,7 @@ // Stephens Relabeling Algorithm (1997a) // ------------------------------------------------------------ -//' Relabeling algorithm from Stephens (1997a) for Poisson mixture models +//' Stephens (1997a) relabeling algorithm for Poisson mixtures //' //' @description //' For internal usage only. This function runs the re-labeling algorithm from @@ -54,12 +54,13 @@ //' @param perm A matrix with all possible permutations of the labels. //' @return A matrix of dimension `MxK` that holding the optimal labeling. //' @export +//' @keywords internal //' //' @seealso -//' * \code{\link{mcmcpermute}} for the calling function -//' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +//' * [mcmcpermute()] for the calling function +//' * [stephens1997b_poisson_cc()] for the re-labeling algorithm from //' Stephens (1997b) -//' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +//' * [stephens1997a_binomial_cc()] for the equivalent implementation //' for mixtures of Binomial distributions //' //' @references @@ -139,7 +140,7 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, return arma::conv_to::from(index); } -//' Relabeling algorithm from Stephens (1997a) for Binomial mixture models +//' Stephens (1997a) relabeling algorithm for Binomial mixtures //' //' @description For internal usage only. This function runs the re-labeling //' algorithm from Stephens (1997a) for MCMC samples of a Binomial mixture @@ -158,12 +159,12 @@ arma::imat stephens1997a_poisson_cc(Rcpp::NumericMatrix values1, //' @param perm A matrix with all possible permutations of the labels. //' @return A matrix of dimension `MxK` that holding the optimal labeling. //' @export -//' +//' @keywords internal //' @seealso -//' * \code{\link{mcmcpermute}} for the calling function -//' * \code{\link{stephens1997b_poisson_cc}} for the re-labeling algorithm from +//' * [mcmcpermute()] for the calling function +//' * [stephens1997b_poisson_cc()] for the re-labeling algorithm from //' Stephens (1997b) -//' * \code{\link{stephens1997a_binomial_cc}} for the equivalent implementation +//' * [stephens1997a_binomial_cc()] for the equivalent implementation //' for mixtures of Binomial distributions //' //' @references @@ -251,7 +252,7 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, return arma::conv_to::from(index); } -//' Relabeling algorithm from Stephens (1997b) for Poisson mixture models +//' Stephens (1997b) relabeling algorithm for Poisson mixtures //' //' @description //' For internal usage only. This function runs the re-labeling algorithm from @@ -267,12 +268,12 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, //' @return An integer matrix of dimension `MxK` that holding the optimal //' labeling. //' @export -//' +//' @kewords internal //' @seealso -//' * \code{\link{mcmcpermute}} for the calling function -//' * \code{\link{stephens1997a_poisson_cc}} for the re-labeling algorithm from +//' * [mcmcpermute()] for the calling function +//' * [stephens1997a_poisson_cc()] for the re-labeling algorithm from //' Stephens (1997a) -//' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +//' * [stephens1997b_binomial_cc()] for the equivalent implementation //' for mixtures of Binomial distributions //' //' @references @@ -378,7 +379,7 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, return arma::conv_to::from(index_out); } -//' Relabeling algorithm from Stephens (1997b) for Binomial mixture models +//' Stephens (1997b) relabeling algorithm for Binomial mixtures //' //' @description //' For internal usage only. This function runs the re-labeling algorithm from @@ -396,10 +397,10 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, //' @export //' //' @seealso -//' * \code{\link{mcmcpermute}} for the calling function -//' * \code{\link{stephens1997a_binomial_cc}} for the re-labeling algorithm from +//' * [mcmcpermute()] for the calling function +//' * [stephens1997a_binomial_cc()] for the re-labeling algorithm from //' Stephens (1997a) -//' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +//' * [stephens1997b_poisson_cc()] for the equivalent implementation //' for mixtures of Poisson distributions //' //' @references @@ -505,7 +506,7 @@ arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, return arma::conv_to::from(index_out); } -//' Relabeling algorithm from Stephens (1997b) for Exponential mixture models +//' Stephens (1997b) relabeling algorithm for Exponential mixtures //' //' @description //' For internal usage only. This function runs the re-labeling algorithm from @@ -521,12 +522,12 @@ arma::imat stephens1997b_binomial_cc(Rcpp::NumericVector values, //' @return An integer matrix of dimension `MxK` that holding the optimal //' labeling. //' @export -//' +//' @keywords internal //' @seealso -//' * \code{\link{mcmcpermute}} for the calling function -//' * \code{\link{stephens1997b_poisson_cc}} for the equivalent implementation +//' * [mcmcpermute()] for the calling function +//' * [stephens1997b_poisson_cc()] for the equivalent implementation //' for mixtures of Poisson distributions -//' * \code{\link{stephens1997b_binomial_cc}} for the equivalent implementation +//' * [stephens1997b_binomial_cc()] for the equivalent implementation //' for mixtures of Binomial distributions //' //' @references From 1f30e53d59dc3cdf4b6ca9508b11b3d2f0cb9918 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Tue, 12 Oct 2021 12:29:24 +0200 Subject: [PATCH 14/24] Fixed some bugs and modified the manuals. --- NAMESPACE | 1 + R/AllGenerics.R | 252 ++--- R/RcppExports.R | 82 +- R/binomialmodelmoments.R | 23 +- R/cdatamoments.R | 28 +- R/csdatamoments.R | 93 +- R/dataclass.R | 62 +- R/datamoments.R | 14 +- R/ddatamoments.R | 26 +- R/dmodelmoments.R | 2 +- R/exponentialmodelmoments.R | 11 +- R/fdata.R | 221 ++-- R/graphic_func.R | 8 +- R/groupmoments.R | 17 +- R/likelihood.R | 14 +- R/mcmc.R | 34 +- R/mcmcestfix.R | 27 +- R/mcmcestimate.R | 2 +- R/mcmcestind.R | 8 +- R/mcmcextract.R | 10 +- R/mcmcoutputbase.R | 6 +- R/mcmcoutputfix.R | 40 +- R/mcmcoutputfixhier.R | 20 +- R/mcmcoutputfixhierpost.R | 12 +- R/mcmcoutputfixpost.R | 29 +- R/mcmcoutputhier.R | 4 +- R/mcmcoutputhierpost.R | 136 ++- R/mcmcoutputpermfix.R | 4 +- R/mcmcoutputpermfixhier.R | 2 +- R/mcmcoutputpermfixhierpost.R | 3 +- R/mcmcoutputpermfixpost.R | 10 +- R/mcmcoutputpermhier.R | 3 +- R/mcmcoutputpermhierpost.R | 331 +++++- R/mcmcoutputpermpost.R | 1 - R/mcmcoutputpost.R | 6 +- R/mcmcpermfix.R | 14 +- R/mcmcpermfixhier.R | 11 +- R/mcmcpermfixpost.R | 2 +- R/mcmcpermind.R | 12 +- R/mcmcpermindpost.R | 4 +- R/mcmcpermute.R | 48 +- R/mcmcstart.R | 64 +- R/mixturemcmc.R | 26 +- R/model.R | 6 +- R/modelmoments.R | 20 +- R/normalmodelmoments.R | 13 +- R/normultmodelmoments.R | 9 +- R/poissonmodelmoments.R | 10 +- R/prior.R | 19 +- R/sdatamoments.R | 40 +- R/studentmodelmoments.R | 5 +- R/studmultmodelmoments.R | 2 +- man/binomialmodelmoments-class.Rd | 28 +- man/cdatamoments_class.Rd | 41 - man/csdatamoments-class.Rd | 39 +- man/csdatamoments_class.Rd | 39 - man/dataclass.Rd | 2 +- man/dataclass_class.Rd | 47 - man/datamoments.Rd | 6 +- man/datamoments_class.Rd | 87 -- man/ddatamoments_class.Rd | 36 - man/dmodelmoments.Rd | 27 - man/exponentialmodelmoments.Rd | 2 +- man/extract-mcmcoutputfix-numeric-method.Rd | 2 +- man/fdata_class.Rd | 586 ---------- ...nerateMoments-normalmodelmoments-method.Rd | 2 +- man/generatePrior-prior-method.Rd | 37 - man/getMperm-mcmcpermfix-method.Rd | 4 +- man/groupmoments-class.Rd | 39 +- man/groupmoments.Rd | 6 +- man/groupmoments_class.Rd | 39 - man/hasS-fdata-method.Rd | 2 +- ...nitialize-mcmcoutputpermhierpost-method.Rd | 8 +- man/initialize-sdatamoments-method.Rd | 4 +- man/mcmc.Rd | 2 +- man/mcmc_binomial_cc.Rd | 8 +- man/mcmc_class.Rd | 46 - man/mcmc_condpoisson_cc.Rd | 8 +- man/mcmc_exponential_cc.Rd | 8 +- man/mcmc_normal_cc.Rd | 8 +- man/mcmc_normult_cc.Rd | 8 +- man/mcmc_poisson_cc.Rd | 8 +- man/mcmc_student_cc.Rd | 8 +- man/mcmc_studmult_cc.Rd | 8 +- man/mcmcest_class.Rd | 88 -- man/mcmcestimate.Rd | 2 +- man/mcmcoutput-class.Rd | 103 +- man/mcmcoutput_class.Rd | 1007 ----------------- man/mcmcoutputbase-class.Rd | 4 +- man/mcmcoutputhierpost-class.Rd | 20 - man/mcmcoutputperm-class.Rd | 120 +- man/mcmcoutputperm_class.Rd | 132 --- man/mcmcoutputpermfix-class.Rd | 18 + man/mcmcoutputpermfixhierpost-class.Rd | 20 - man/mcmcoutputpermfixpost-class.Rd | 27 +- man/mcmcoutputpost-class.Rd | 2 +- man/mcmcpermfix-class.Rd | 4 +- man/mcmcpermfixhier-methods.Rd | 31 - man/mcmcpermute.Rd | 47 +- man/mcmcstart.Rd | 4 +- man/mixturemcmc.Rd | 6 +- man/model_class.Rd | 118 +- man/modelmoments-class.Rd | 43 +- man/modelmoments.Rd | 2 +- man/modelmoments_class.Rd | 84 -- man/moments-mcmcoutputfix-method.Rd | 19 - man/moments_cc.Rd | 4 +- man/normalmodelmoments.Rd | 7 +- man/normultmodelmoments.Rd | 2 +- man/permmoments_cc.Rd | 4 +- man/poissonmodelmoments.Rd | 28 - man/prior-class.Rd | 4 +- man/sdatamoments.Rd | 8 +- man/sdatamoments_class.Rd | 29 +- man/show-cdatamoments-method.Rd | 19 - man/show-dataclass-method.Rd | 19 - man/show-ddatamoments-method.Rd | 19 - man/show-exponentialmodelmoments-method.Rd | 19 - man/show-mcmc-method.Rd | 19 - man/show-mcmcestind-method.Rd | 19 - man/show-mcmcoutputfix-method.Rd | 19 - man/show-mcmcoutputfixhier-method.Rd | 19 - man/show-mcmcoutputfixhierpost-method.Rd | 19 - man/show-mcmcoutputfixpost-method.Rd | 19 - man/show-mcmcoutputhier-method.Rd | 19 - man/show-mcmcoutputpermfix-method.Rd | 19 - man/show-normalmodelmoments-method.Rd | 19 - man/show-normultmodelmoments-method.Rd | 19 - man/show-poissonmodelmoments-method.Rd | 19 - man/show-prior-method.Rd | 19 - man/show-studentmodelmoments-method.Rd | 19 - man/stephens1997b_poisson_cc.Rd | 1 + man/studmultmodelmoments.Rd | 2 +- man/swapInd_cc.Rd | 2 +- man/swapST_cc.Rd | 2 +- man/swap_3d_cc.Rd | 2 +- man/swap_cc.Rd | 2 +- src/attributes.cpp | 16 +- src/mcmc_binomial.cpp | 8 +- src/mcmc_condpoisson.cpp | 8 +- src/mcmc_exponential.cpp | 8 +- src/mcmc_normal.cpp | 8 +- src/mcmc_normult.cpp | 8 +- src/mcmc_poisson.cpp | 8 +- src/mcmc_student.cpp | 8 +- src/mcmc_studmult.cpp | 8 +- src/relabel_algorithms.cpp | 2 +- 147 files changed, 1737 insertions(+), 3708 deletions(-) delete mode 100644 man/cdatamoments_class.Rd delete mode 100644 man/csdatamoments_class.Rd delete mode 100644 man/dataclass_class.Rd delete mode 100644 man/datamoments_class.Rd delete mode 100644 man/ddatamoments_class.Rd delete mode 100644 man/dmodelmoments.Rd delete mode 100644 man/fdata_class.Rd delete mode 100644 man/generatePrior-prior-method.Rd delete mode 100644 man/groupmoments_class.Rd delete mode 100644 man/mcmc_class.Rd delete mode 100644 man/mcmcest_class.Rd delete mode 100644 man/mcmcoutput_class.Rd delete mode 100644 man/mcmcoutputperm_class.Rd delete mode 100644 man/mcmcpermfixhier-methods.Rd delete mode 100644 man/modelmoments_class.Rd delete mode 100644 man/moments-mcmcoutputfix-method.Rd delete mode 100644 man/poissonmodelmoments.Rd delete mode 100644 man/show-cdatamoments-method.Rd delete mode 100644 man/show-dataclass-method.Rd delete mode 100644 man/show-ddatamoments-method.Rd delete mode 100644 man/show-exponentialmodelmoments-method.Rd delete mode 100644 man/show-mcmc-method.Rd delete mode 100644 man/show-mcmcestind-method.Rd delete mode 100644 man/show-mcmcoutputfix-method.Rd delete mode 100644 man/show-mcmcoutputfixhier-method.Rd delete mode 100644 man/show-mcmcoutputfixhierpost-method.Rd delete mode 100644 man/show-mcmcoutputfixpost-method.Rd delete mode 100644 man/show-mcmcoutputhier-method.Rd delete mode 100644 man/show-mcmcoutputpermfix-method.Rd delete mode 100644 man/show-normalmodelmoments-method.Rd delete mode 100644 man/show-normultmodelmoments-method.Rd delete mode 100644 man/show-poissonmodelmoments-method.Rd delete mode 100644 man/show-prior-method.Rd delete mode 100644 man/show-studentmodelmoments-method.Rd diff --git a/NAMESPACE b/NAMESPACE index 7e6e7c3..d55e87d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -115,6 +115,7 @@ exportMethods("setType<-") exportMethods("setWeight<-") exportMethods("setY<-") exportMethods(Summary) +exportMethods(extract) exportMethods(getB) exportMethods(getBurnin) exportMethods(getBycolumn) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 3c36886..851dab8 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -15,408 +15,408 @@ # You should have received a copy of the GNU General Public License # along with Rcpp. If not, see . -## Load the dyanmic library +## Load the dynamic library #' @useDynLib finmix #' @importFrom Rcpp sourceCpp NULL ## Class 'model' -------------------------------------------------- -#' @describeIn model_class Simulates data from mixture model +#' @noRd setGeneric("simulate", function(model, N = 100, varargin, seed = 0) standardGeneric("simulate")) -#' @describeIn model_class Plots point process of mixture model +#' @noRd setGeneric("plotPointProc", function(x, dev = TRUE, ...) standardGeneric("plotPointProc")) -#' @describeIn model_class Checker for slot `weight` of model class +#' @noRd setGeneric("hasWeight", function(object, verbose = FALSE) standardGeneric("hasWeight")) -#' @describeIn model_class Checker for slot `T` of model class +#' @noRd setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) -#' @describeIn model_class Checker for slot `par` of model class +#' @noRd setGeneric("hasPar", function(object, verbose = FALSE) standardGeneric("hasPar")) -#' @describeIn model_class Extract marginal distribution +#' @noRd setGeneric("mixturemar", function(object, J) standardGeneric("mixturemar")) -#' @describeIn model_class Getter for slot `dist` of model class +#' @noRd setGeneric("getDist", function(object) standardGeneric("getDist")) -#' @describeIn model_class Getter for slot `r` of model class +#' @noRd setGeneric("getR", function(object) standardGeneric("getR")) -#' @describeIn model_class Getter for slot `K` of model class +#' @noRd setGeneric("getK", function(object) standardGeneric("getK")) -#' @describeIn model_class Getter for slot `weight` of model class +#' @noRd setGeneric("getWeight", function(object) standardGeneric("getWeight")) -#' @describeIn model_class Getter for slot `par` of model class +#' @noRd setGeneric("getPar", function(object) standardGeneric("getPar")) -#' @describeIn model_class Getter for slot `indicmod` of model class +#' @noRd setGeneric("getIndicmod", function(object) standardGeneric("getIndicmod")) -#' @describeIn model_class Getter for slot `indicfix` of model class +#' @noRd setGeneric("getIndicfix", function(object) standardGeneric("getIndicfix")) -#' @describeIn model_class Getter for slot `T` of model class +#' @noRd setGeneric("getT", function(object) standardGeneric("getT")) -#' @describeIn model_class Setter for slot `dist` of model class +#' @noRd setGeneric("setDist<-", function(object, value) standardGeneric("setDist<-")) -#' @describeIn model_class Setter for slot `r` of model class +#' @noRd setGeneric("setR<-", function(object, value) standardGeneric("setR<-")) -#' @describeIn model_class Setter for slot `K` of model class +#' @noRd setGeneric("setK<-", function(object, value) standardGeneric("setK<-")) -#' @describeIn model_class Setter for slot `weight` of model class +#' @noRd setGeneric("setWeight<-", function(object, value) standardGeneric("setWeight<-")) -#' @describeIn model_class Setter for slot `par` of model class +#' @noRd setGeneric("setPar<-", function(object, value) standardGeneric("setPar<-")) -#' @describeIn model_class Setter for slot `indicmod` of model class +#' @noRd setGeneric("setIndicmod<-", function(object, value) standardGeneric("setIndicmod<-")) -#' @describeIn model_class Setter for slot `indicfix` of model class +#' @noRd setGeneric("setIndicfix<-", function(object, value) standardGeneric("setIndicfix<-")) -#' @describeIn model_class Setter for slot `T` of model class +#' @noRd setGeneric("setT<-", function(object, value) standardGeneric("setT<-")) ## Class 'modelmoments' -------------------------------------------- -#' @describeIn modelmoments_class +#' @noRd setGeneric("getMean", function(object) standardGeneric("getMean")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getVar", function(object) standardGeneric("getVar")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getModel", function(object) standardGeneric("getModel")) ## Class 'cmodelmoments' ------------------------------------------- -#' @describeIn modelmoments_class +#' @noRd setGeneric("getHigher", function(object) standardGeneric("getHigher")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getSkewness", function(object) standardGeneric("getSkewness")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getKurtosis", function(object) standardGeneric("getKurtosis")) ## Class 'dmodelmoments' ------------------------------------------- -#' @describeIn modelmoments_class +#' @noRd setGeneric("getOver", function(object) standardGeneric("getOver")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getFactorial", function(object) standardGeneric("getFactorial")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getZero", function(object) standardGeneric("getZero")) ## Class 'normultmodelmoments' ------------------------------------- -#' @describeIn modelmoments_class +#' @noRd setGeneric("generateMoments", function(object) standardGeneric("generateMoments")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getB", function(object) standardGeneric("getB")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getW", function(object) standardGeneric("getW")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getRdet", function(object) standardGeneric("getRdet")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getRtr", function(object) standardGeneric("getRtr")) -#' @describeIn modelmoments_class +#' @noRd setGeneric("getCorr", function(object) standardGeneric("getCorr")) ## Class 'exponentialmodelmoments' --------------------------------- -#' @describeIn modelmoments_class +#' @noRd setGeneric("getExtrabinvar", function(object) standardGeneric("getExtrabinvar")) ## Class 'fdata' ---------------------------------------------------- -#' @describeIn fdata_class +#' @noRd setGeneric("hasY", function(object, verbose = FALSE) standardGeneric("hasY")) -#' @describeIn fdata_class +#' @noRd setGeneric("hasS", function(object, verbose = FALSE) standardGeneric("hasS")) -#' @describeIn fdata_class +#' @noRd setGeneric("hasExp", function(object, verbose = FALSE) standardGeneric("hasExp")) -#' @describeIn fdata_class +#' @noRd setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) -#' @describeIn fdata_class +#' @noRd setGeneric("getColY", function(object) standardGeneric("getColY")) -#' @describeIn fdata_class +#' @noRd setGeneric("getRowY", function(object) standardGeneric("getRowY")) -#' @describeIn fdata_class +#' @noRd setGeneric("getColS", function(object) standardGeneric("getColS")) -#' @describeIn fdata_class +#' @noRd setGeneric("getRowS", function(object) standardGeneric("getRowS")) -#' @describeIn fdata_class +#' @noRd setGeneric("getColExp", function(object) standardGeneric("getColExp")) -#' @describeIn fdata_class +#' @noRd setGeneric("getRowExp", function(object) standardGeneric("getRowExp")) -#' @describeIn fdata_class +#' @noRd setGeneric("getColT", function(object) standardGeneric("getColT")) -#' @describeIn fdata_class +#' @noRd setGeneric("getRowT", function(object) standardGeneric("getRowT")) -#' @describeIn fdata_class +#' @noRd setGeneric("getY", function(object) standardGeneric("getY")) -#' @describeIn fdata_class +#' @noRd setGeneric("getBycolumn", function(object) standardGeneric("getBycolumn")) -#' @describeIn fdata_class +#' @noRd setGeneric("getN", function(object) standardGeneric("getN")) -#' @describeIn fdata_class +#' @noRd setGeneric("getS", function(object) standardGeneric("getS")) -#' @describeIn fdata_class +#' @noRd setGeneric("getName", function(object) standardGeneric("getName")) -#' @describeIn fdata_class +#' @noRd setGeneric("getType", function(object) standardGeneric("getType")) -#' @describeIn fdata_class +#' @noRd setGeneric("getSim", function(object) standardGeneric("getSim")) -#' @describeIn fdata_class +#' @noRd setGeneric("getExp", function(object) standardGeneric("getExp")) -#' @describeIn fdata_class +#' @noRd setGeneric("setY<-", function(object, value) standardGeneric("setY<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setN<-", function(object, value) standardGeneric("setN<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setS<-", function(object, value) standardGeneric("setS<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setBycolumn<-", function(object, value) standardGeneric("setBycolumn<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setName<-", function(object, value) standardGeneric("setName<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setType<-", function(object, value) standardGeneric("setType<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setSim<-", function(object, value) standardGeneric("setSim<-")) -#' @describeIn fdata_class +#' @noRd setGeneric("setExp<-", function(object, value) standardGeneric("setExp<-")) ## Class 'groupmoments' ---------------------------------------------- -#' @describeIn groupmoments_class +#' @noRd setGeneric("getNK", function(object) standardGeneric("getNK")) -#' @describeIn groupmoments_class +#' @noRd setGeneric("getWK", function(object) standardGeneric("getWK")) -#' @describeIn groupmoments_class +#' @noRd setGeneric("getFdata", function(object) standardGeneric("getFdata")) ## Class 'sdatamoments' ---------------------------------------------- -#' @describeIn sdatamoments_class +#' @noRd setGeneric("getGmoments", function(object) standardGeneric("getGmoments")) ## Class 'cdatamoments' --------------------------------------------- -#' @describeIn cdatamoments_class +#' @noRd setGeneric("getSmoments", function(object) standardGeneric("getSmoments")) ## Class 'prior' ----------------------------------------------------- -#' @describeIn prior-class +#' @noRd setGeneric("hasPriorPar", function(object, model, verbose = FALSE) standardGeneric("hasPriorPar")) -#' @describeIn prior-class +#' @noRd setGeneric("hasPriorWeight", function(object, model, verbose = FALSE) standardGeneric("hasPriorWeight")) -#' @describeIn prior-class +#' @noRd setGeneric("generatePrior", function(object, ...) standardGeneric("generatePrior")) -#' @describeIn prior-class +#' @noRd setGeneric("getHier", function(object) standardGeneric("getHier")) -#' @describeIn prior-class +#' @noRd setGeneric("setHier<-", function(object, value) standardGeneric("setHier<-")) ## Class 'mcmc' ------------------------------------------------------- -#' @describeIn mcmc_class +#' @noRd setGeneric("getBurnin", function(object) standardGeneric("getBurnin")) -#' @describeIn mcmc_class +#' @noRd setGeneric("getM", function(object) standardGeneric("getM")) -#' @describeIn mcmc_class +#' @noRd setGeneric("getStartpar", function(object) standardGeneric("getStartpar")) -#' @describeIn mcmc_class +#' @noRd setGeneric("getStoreS", function(object) standardGeneric("getStoreS")) -#' @describeIn mcmc_class +#' @noRd setGeneric("getStorepost", function(object) standardGeneric("getStorepost")) -#' @describeIn mcmc_class +#' @noRd setGeneric("getRanperm", function(object) standardGeneric("getRanperm")) -#' @describeIn mcmc_class +#' @noRd setGeneric("setBurnin<-", function(object, value) standardGeneric("setBurnin<-")) -#' @describeIn mcmc_class +#' @noRd setGeneric("setM<-", function(object, value) standardGeneric("setM<-")) -#' @describeIn mcmc_class +#' @noRd setGeneric("setStartpar<-", function(object, value) standardGeneric("setStartpar<-")) -#' @describeIn mcmc_class +#' @noRd setGeneric("setStoreS<-", function(object, value) standardGeneric("setStoreS<-")) -#' @describeIn mcmc_class +#' @noRd setGeneric("setStorepost<-", function(object, value) standardGeneric("setStorepost<-")) -#' @describeIn mcmc_class +#' @noRd setGeneric("setRanperm<-", function(object, value) standardGeneric("setRanperm<-")) ## Class 'dataclass' ---------------------------------------------------- -#' @describeIn dataclass +#' @noRd setGeneric("getLogpy", function(object) standardGeneric("getLogpy")) -#' @describeIn dataclass +#' @noRd setGeneric("getProb", function(object) standardGeneric("getProb")) -#' @describeIn dataclass +#' @noRd setGeneric("getMixlik", function(object) standardGeneric("getMixlik")) -#' @describeIn dataclass +#' @noRd setGeneric("getEntropy", function(object) standardGeneric("getEntropy")) -#' @describeIn dataclass +#' @noRd setGeneric("getPostS", function(object) standardGeneric("getPostS")) -#' @describeIn dataclass +#' @noRd setGeneric("getLoglikcd", function(object) standardGeneric("getLoglikcd")) ## Class 'mcmcextract' -------------------------------------------------------------------------- -#' @describeIn mcmcextract_class +#' @noRd setGeneric("moments", function(object) standardGeneric("moments")) ## Class 'mcmcoutputfix' ------------------------------------------------ -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("plotTraces", function(x, dev = TRUE, lik = 1, col = FALSE, ...) standardGeneric("plotTraces")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("plotHist", function(x, dev = TRUE, ...) standardGeneric("plotHist")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("plotDens", function(x, dev = TRUE, ...) standardGeneric("plotDens")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSampRep")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPostDens")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("subseq", function(object, index) standardGeneric("subseq")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("swapElements", function(object, index) standardGeneric("swapElements")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("extract", function(object, index) standardGeneric("extract")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("getLog", function(object) standardGeneric("getLog")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("getPrior", function(object) standardGeneric("getPrior")) ## Class 'mcmcoutputhier' ----------------------------------------------- -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("getHyper", function(object) standardGeneric("getHyper")) ## Class 'mcmcoutputpost' ----------------------------------------------- -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("getPost", function(object) standardGeneric("getPost")) ## Class 'mcmcoutputbase' ----------------------------------------------- -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("getST", function(object) standardGeneric("getST")) -#' @describeIn mcmcoutput_class +#' @noRd setGeneric("getClust", function(object) standardGeneric("getClust")) ## Class 'mcmcpermfix' --------------------------------------------------- -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getMperm", function(object) standardGeneric("getMperm")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getParperm", function(object) standardGeneric("getParperm")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getLogperm", function(object) standardGeneric("getLogperm")) ## Class 'mcmcpermfixhier' ----------------------------------------------- -#' @noRd mcmcperm_class +#' @noRd setGeneric("getHyperperm", function(object) standardGeneric("getHyperperm")) ## Class 'mcmcpermfixpost' ----------------------------------------------- -#' @noRd mcmcperm_class +#' @noRd setGeneric("getPostperm", function(object) standardGeneric("getPostperm")) ## Class 'mcmcpermind' --------------------------------------------------- -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getRelabel", function(object) standardGeneric("getRelabel")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getWeightperm", function(object) standardGeneric("getWeightperm")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getEntropyperm", function(object) standardGeneric("getEntropyperm")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getSTperm", function(object) standardGeneric("getSTperm")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getSperm", function(object) standardGeneric("getSperm")) -#' @describeIn mcmcperm_class +#' @noRd setGeneric("getNKperm", function(object) standardGeneric("getNKperm")) ## Class 'mcmcestfix' ----------------------------------------------------- -#' @describeIn mcmcest_class +#' @noRd setGeneric("getMap", function(object) standardGeneric("getMap")) -#' @describeIn mcmcest_class +#' @noRd setGeneric("getBml", function(object) standardGeneric("getBml")) -#' @describeIn mcmcest_class +#' @noRd setGeneric("getIeavg", function(object) standardGeneric("getIeavg")) -#' @describeIn mcmcest_class +#' @noRd setGeneric("getSdpost", function(object) standardGeneric("getSdpost")) ## Class 'mcmcestind' ------------------------------------------------------ -#' @describeIn mcmcest_class +#' @noRd setGeneric("getEavg", function(object) standardGeneric("getEavg")) diff --git a/R/RcppExports.R b/R/RcppExports.R index 3b6a692..6b6ef91 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -20,7 +20,7 @@ #' swap_cc(values, index) #' #' @seealso -#' * [swapElements()][mcmcoutput_class] for the calling function +#' * [swapElements()] for the calling function swap_cc <- function(values, index) { .Call('_finmix_swap_cc', PACKAGE = 'finmix', values, index) } @@ -43,7 +43,7 @@ swap_cc <- function(values, index) { #' swap_3d_cc(values, index) #' #' @seealso -#' * [swapElements()][mcmcoutput_class] for the calling method +#' * [swapElements()] for the calling method #' * [swap_cc()] for the equivalent function for 2-dimensional arrays swap_3d_cc <- function(values, index) { .Call('_finmix_swap_3d_cc', PACKAGE = 'finmix', values, index) @@ -91,7 +91,7 @@ swapInteger_cc <- function(values, index) { #' #' @seealso #' * [mcmc()] for the hyper-parameter `storeS` -#' * [swapElements()][mcmcoutput_class] for the calling method +#' * [swapElements()] for the calling method #' * [swapInteger_cc()] for the equivalent function that swaps simple integer #' matrices #' * [swap_3d_cc()] for a function that swaps values in three-dimensional @@ -116,7 +116,7 @@ swapInd_cc <- function(values, index) { #' @seealso #' * [swapInteger_cc()] for the equivalent function not using R memory #' * [swap_3d_cc()] for an equivalent function for three-dimensional arrays -#' * [swapElements()][mcmcoutput_class] for the calling method +#' * [swapElements()] for the calling method swapST_cc <- function(values, index) { .Call('_finmix_swapST_cc', PACKAGE = 'finmix', values, index) } @@ -237,9 +237,9 @@ hungarian_cc <- function(cost) { #' iteration in the MCMC sample. #' @export #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the `mcmcoutput` class definition +#' * [mcmcoutput-class] for the `mcmcoutput` class definition #' * [mixturemcmc()] for performing MCMC sampling -#' * [plotTraces][mcmcoutput_class] for the calling function +#' * [plotTraces()] for the calling function moments_cc <- function(classS4) { .Call('_finmix_moments_cc', PACKAGE = 'finmix', classS4) } @@ -258,10 +258,10 @@ moments_cc <- function(classS4) { #' iteration in the re-labeled MCMC sample. #' @export #' @seealso -#' * [mcmcoutputperm][mcmcoutputperm_class] for the `mcmcoutput` class definition +#' * [mcmcoutputperm-class] for the `mcmcoutput` class definition #' * [mixturemcmc()] for performing MCMC sampling #' * [mcmcpermute()] for re-labeling MCMC samples -#' * [plotTraces][mcmcoutputperm_class] for the calling function +#' * [plotTraces()] for the calling function permmoments_cc <- function(classS4) { .Call('_finmix_permmoments_cc', PACKAGE = 'finmix', classS4) } @@ -295,10 +295,10 @@ permmoments_cc <- function(classS4) { #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -338,10 +338,10 @@ mcmc_binomial_cc <- function(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -381,10 +381,10 @@ mcmc_condpoisson_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -424,10 +424,10 @@ mcmc_exponential_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -467,10 +467,10 @@ mcmc_normal_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -510,10 +510,10 @@ mcmc_normult_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -553,10 +553,10 @@ mcmc_poisson_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -596,10 +596,10 @@ mcmc_student_cc <- function(data_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) #' #' @seealso #' * [mixturemcmc()] for performing MCMC sampling -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior_class] for the `prior` class definition -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition +#' * [mcmc-class] for the `mcmc` class definition #' #' @references #' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with @@ -698,7 +698,7 @@ stephens1997a_binomial_cc <- function(values1, values2, pars, perm) { #' @return An integer matrix of dimension `MxK` that holding the optimal #' labeling. #' @export -#' @kewords internal +#' @keywords internal #' @seealso #' * [mcmcpermute()] for the calling function #' * [stephens1997a_poisson_cc()] for the re-labeling algorithm from diff --git a/R/binomialmodelmoments.R b/R/binomialmodelmoments.R index 977b22d..a365797 100644 --- a/R/binomialmodelmoments.R +++ b/R/binomialmodelmoments.R @@ -20,17 +20,17 @@ #' @description #' Defines a class that holds modelmoments for a finite mixture of Binomial #' distributions. Note that this class is not directly used, but indirectly -#' when calling the `modelmoments` constructor \code{\link{modelmoments}}. +#' when calling the `modelmoments` constructor [modelmoments()]. #' #' This is a class that directly inherits from the `dmodelmoments` class. #' @import methods #' @exportClass binomialmodelmoments #' @name binomialmodelmoments-class -#' +#' @keywords internal #' @seealso -#' * [modelmoments_class] for the base class for model moments -#' * \code{\link{modelmoments}} for the constructor of `modelmoments` classes -#' * \code{\link{dmodelmoments-class}} class for the parent class +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes +#' * [dmodelmoments-class] class for the parent class .binomialmodelmoments <- setClass("binomialmodelmoments", representation(extrabinvar = "numeric"), contains = c("dmodelmoments"), @@ -57,8 +57,8 @@ #' @noRd #' #' @seealso -#' * \code{\link{Classes_Details}} for details of class definitions, and -#' * \code{\link{setOldClass}} for the relation to S3 classes +#' * [Classes_Details] for details of class definitions, and +#' * [setOldClass] for the relation to S3 classes setMethod( "initialize", "binomialmodelmoments", function(.Object, ..., model) { @@ -92,7 +92,10 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn binomialmodelmoments Shows a summary of an object +#' @noRd +#' @seealso +#' * [modelmoments()] for the mutual constructor for all modelmoments +#' * [binomialmodelmoments-class] for the class definition setMethod( "show", "binomialmodelmoments", function(object) { @@ -171,8 +174,8 @@ setMethod( #' @noRd #' #' @seealso -#' * \code{\link{dmodelmoments-class}} for the class definition of `dmodelmoments` -#' * \code{\link{modelmoments}} for the constructor calling this function +#' * [dmodelmoments-class] for the class definition of `dmodelmoments` +#' * [modelmoments()] for the constructor calling this function ".generateMomentsBinomial" <- function(object) { p <- object@model@par$p T <- object@model@T[1] diff --git a/R/cdatamoments.R b/R/cdatamoments.R index 92a05ac..ace2329 100644 --- a/R/cdatamoments.R +++ b/R/cdatamoments.R @@ -17,8 +17,8 @@ #' Finmix `cdatamoments` class #' -#' Stores moments of an [fdata][fdata_class] object containing continuous data. -#' The `fdata` object is stored in the parent [datamoments][datamoments_class] +#' Stores moments of an [fdata-class] object containing continuous data. +#' The `fdata` object is stored in the parent [datamoments-class] #' class. #' #' @slot higher An array containing the four higher centralized moments of the @@ -33,12 +33,13 @@ #' @slot smoments A `csdatamoments` object, if the `fdata` object also holds #' indicators. `NULL`, if no indicators are present in the `fdata` object. #' @exportClass cdatamoments -#' @name cdatamoments_class +#' @rdname cdatamoments-class +#' @keywords internal #' @seealso -#' * [datamoments][datamoments_class] for the parent class -#' * [ddatamoments][ddatamoments_class] for the corresponding class for +#' * [datamoments-class] for the parent class +#' * [ddatamoments-class] for the corresponding class for #' discrete data -#' * [csdatamoments][csdatamoments_class] for the contained class if indicators +#' * [csdatamoments-class] for the contained class if indicators #' are present in the `fdata` object .cdatamoments <- setClass("cdatamoments", representation( @@ -117,7 +118,10 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn cdatamoments_class +#' @noRd +#' @seealso +#' * [datamoments-class] for the parent class +#' * [datamoments()] for the class constructor setMethod( "show", "cdatamoments", function(object) { @@ -181,7 +185,7 @@ setMethod( #' getSmoments(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getSmoments", "cdatamoments", @@ -209,7 +213,7 @@ setMethod( #' getHigher(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getHigher", "cdatamoments", @@ -237,7 +241,7 @@ setMethod( #' getSkewness(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getSkewness", "cdatamoments", @@ -265,7 +269,7 @@ setMethod( #' getKurtosis(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getKurtosis", "cdatamoments", @@ -293,7 +297,7 @@ setMethod( #' getCorr(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getCorr", "cdatamoments", diff --git a/R/csdatamoments.R b/R/csdatamoments.R index e48b1da..bc4568d 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -18,7 +18,7 @@ #' Finmix `csdatamoments` class #' #' Stores moments for indicators of continuous data. Inherited directly from -#' the [sdatamoments][sdatamoments_class] class. +#' the [sdatamoments-class] class. #' #' @slot B A vector storing the between-group heterogeneity. #' @slot W A vector storing the within-group heterogeneity. @@ -30,12 +30,13 @@ #' @slot Rtr A numeric storing the coefficient of determination using the #' determinants for multivariate data. #' @exportClass csdatamoments -#' @name csdatamoments_class +#' @rdname csdatamoments-class +#' @keywords internal #' @seealso -#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments-class] for the base class for data moments #' * [datamoments()] for the constructor of any object of the `datamoments` #' class family -#' * [sdatamoments][csdatamoments_class] for the corresponding class defining +#' * [csdatamoments-class] for the corresponding class defining #' moments for data from a discrete-valued finite mixture .csdatamoments <- setClass("csdatamoments", representation( @@ -82,7 +83,7 @@ setClassUnion("csdatamomentsOrNULL", members = c("csdatamoments", "NULL")) #' [initialize]. #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. -#' @param model A finmix [fdata][fdata_class] object containing the observations. +#' @param model A finmix [fdata-class] object containing the observations. #' @noRd #' #' @seealso @@ -176,11 +177,11 @@ setMethod( #' getGmoments(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][csdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getGmoments", "csdatamoments", function(object) { @@ -207,11 +208,11 @@ setMethod( #' getWK(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getWK", "csdatamoments", function(object) { @@ -238,11 +239,11 @@ setMethod( #' getVar(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getVar", "csdatamoments", function(object) { @@ -256,7 +257,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `B` slot of the `object`. -#' @describeIn datamoments_class +#' @exportMethod getB #' #' @examples #' # Generate an exponential mixture model with two components. @@ -269,11 +270,11 @@ setMethod( #' getB(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getB", "csdatamoments", function(object) { @@ -300,11 +301,11 @@ setMethod( #' getW(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getW", "csdatamoments", function(object) { @@ -331,11 +332,11 @@ setMethod( #' getT(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getT", "csdatamoments", function(object) { @@ -362,11 +363,11 @@ setMethod( #' getR(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getR", "csdatamoments", function(object) { @@ -393,11 +394,11 @@ setMethod( #' getRtr(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getRtr", "csdatamoments", function(object) { @@ -424,11 +425,11 @@ setMethod( #' getRdet(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getRdet", "csdatamoments", function(object) { @@ -455,11 +456,11 @@ setMethod( #' getFdata(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [csdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [csdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getFdata", "csdatamoments", function(object) { diff --git a/R/dataclass.R b/R/dataclass.R index 14a472b..8d2d261 100644 --- a/R/dataclass.R +++ b/R/dataclass.R @@ -39,11 +39,12 @@ #' @slot postS A numeric storing the posterior probability of the indicators #' `S` in the data, if indicators have been simulated. #' @exportClass dataclass -#' @name dataclass_class +#' @rdname dataclass-class +#' #' #' @seealso -#' * [fdata][fdata_class] for the class holding the data -#' * [model][model_class] for the class defining a finite mixture model +#' * [fdata-class] for the class holding the data +#' * [model-class] for the class defining a finite mixture model #' * [dataclass()] for the constructor of this class #' #' @references @@ -89,7 +90,7 @@ #' @export #' #' @seealso -#' * [dataclass][dataclass_class] for the class definition +#' * [dataclass-class] for the class definition #' #' #' @references #' Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" @@ -131,7 +132,10 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn dataclass_class +#' @noRd +#' @seealso +#' * [dataclass-class] for the class definition +#' * [dataclass()] for the class constructor setMethod( "show", "dataclass", function(object) { @@ -188,7 +192,7 @@ setMethod( #' getLogpy(f_datamoms) #' #' @seealso -#' * [dataclass][dataclass_class] for the base class +#' * [dataclass-class] for the base class #' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getLogpy", "dataclass", @@ -215,7 +219,7 @@ setMethod( #' getProb(f_datamoms) #' #' @seealso -#' * [dataclass][dataclass_class] for the base class +#' * [dataclass-class] for the base class #' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getProb", "dataclass", @@ -242,7 +246,7 @@ setMethod( #' getMixlik(f_datamoms) #' #' @seealso -#' * [dataclass][dataclass_class] for the base class +#' * [dataclass-class] for the base class #' * [dataclass()] for the constructor of the `dataclass` class< setMethod( "getMixlik", "dataclass", @@ -269,7 +273,7 @@ setMethod( #' getEntropy(f_datamoms) #' #' @seealso -#' * [dataclass][dataclass_class] for the base class +#' * [dataclass-class] for the base class #' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getEntropy", "dataclass", @@ -297,7 +301,7 @@ setMethod( #' getLoglikcd(f_datamoms) #' #' @seealso -#' * [dataclass][dataclass_class] for the base class +#' * [dataclass-class] for the base class #' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getLoglikcd", "dataclass", @@ -325,7 +329,7 @@ setMethod( #' getPostS(f_datamoms) #' #' @seealso -#' * [dataclass][dataclass_class] for the base class +#' * [dataclass-class] for the base class #' * [dataclass()] for the constructor of the `dataclass` class setMethod( "getPostS", "dataclass", @@ -364,8 +368,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".check.fdata.model.Dataclass" <- function(fdata.obj, model.obj) { if (class(fdata.obj) != "fdata") { @@ -393,8 +397,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".check.model.Dataclass" <- function(model.obj) { if (class(model.obj) != "model") { @@ -425,8 +429,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".check.S.Dataclass" <- function(fdata.obj, model.obj) { values <- levels(as.factor(fdata.obj@S)) @@ -456,8 +460,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".check.Logdet.Norstud" <- function(model.obj) { has.sigmainv <- "sigmainv" %in% names(model.obj@par) @@ -499,8 +503,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".liklist.Dataclass" <- function(fdata.obj, model.obj) { K <- model.obj@K @@ -574,8 +578,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".multinomial.Dataclass" <- function(fdata.obj, model.obj, lik.list, simS) { @@ -650,8 +654,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".mixlik.Dataclass" <- function(model.obj, lik.list, prob = FALSE) { ## p is an N x K matrix ## @@ -687,8 +691,8 @@ setMethod( #' @noRd #' @importFrom stats runif #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".simulate.S.Dataclass" <- function(p, K, N) { ## Simulate classifications from classification probability @@ -722,8 +726,8 @@ setMethod( #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [fdata-class] for the `fdata` class definition +#' * [model-class] for the `model` class definition #' * [dataclass()] for the calling function ".indicfix.Dataclass" <- function(fdata.obj, model.obj, lik.list) { K <- model.obj@K diff --git a/R/datamoments.R b/R/datamoments.R index bf1cd14..e7cb44b 100644 --- a/R/datamoments.R +++ b/R/datamoments.R @@ -27,11 +27,11 @@ #' in the `fdata` object. #' @slot VIRTUAL Virtual class containing further data moments. #' @exportClass datamoments -#' @name datamoments_class +#' @rdname datamoments-class #' @seealso -#' * [cdatamoments] for data moments of continuous data -#' * [ddatamoments] for data moments of discrete data -#' * [sdatamoments] for data moments of the indicators +#' * [cdatamoments-class] for data moments of continuous data +#' * [ddatamoments-class] for data moments of discrete data +#' * [sdatamoments-class] for data moments of the indicators #' .datamoments <- setClass( "datamoments", @@ -66,9 +66,9 @@ #' datamoments(f_data) #' #' @seealso -#' * [datamoments] class for all slots of this class -#' * [cdatamoments] for the class for continuous data -#' * [ddatamoments] for the class for discrete data +#' * [datamoments-class] for all slots of this class +#' * [cdatamoments-class] for the class for continuous data +#' * [ddatamoments-class] for the class for discrete data "datamoments" <- function(value = fdata()) { hasY(value, verbose = TRUE) if (value@type == "continuous") { diff --git a/R/ddatamoments.R b/R/ddatamoments.R index 8cf640a..60dd56e 100644 --- a/R/ddatamoments.R +++ b/R/ddatamoments.R @@ -16,8 +16,8 @@ # along with finmix. If not, see . #' Finmix `ddatamoments` class #' -#' Stores moments of an [fdata][fdata_class] object containing discrete data. -#' The `fdata` object is stored in the parent [datamoments][datamoments_class] +#' Stores moments of an [fdata-class] object containing discrete data. +#' The `fdata` object is stored in the parent [datamoments-class] #' class. #' #' @slot factorial An array containing the first four factorial moments of the @@ -28,12 +28,13 @@ #' @slot smoments An `sdatamoments` object, if the `fdata` object also holds #' indicators. `NULL`, if no indicators are present in the `fdata` object. #' @exportClass ddatamoments -#' @name ddatamoments_class +#' @rdname ddatamoments-class +#' @keywords internal #' @seealso -#' * [datamoments][datamoments_class] for the parent class -#' * [ddatamoments][ddatamoments_class] for the corresponding class for +#' * [datamoments-class] for the parent class +#' * [ddatamoments-class] for the corresponding class for #' continuous data -#' * [sdatamoments][sdatamoments_class] for the contained class if indicators +#' * [sdatamoments-class] for the contained class if indicators #' are present in the `fdata` object .ddatamoments <- setClass("ddatamoments", representation( @@ -111,7 +112,10 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn ddatamoments_class +#' @noRd +#' @seealso +#' * [datamoments-class] for the parent class definition +#' * [datamoments()] for the mutual constructor of all datamoments classes setMethod( "show", "ddatamoments", function(object) { @@ -169,7 +173,7 @@ setMethod( #' getSmoments(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getSmoments", "ddatamoments", @@ -197,7 +201,7 @@ setMethod( #' getFactorial(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getFactorial", "ddatamoments", @@ -225,7 +229,7 @@ setMethod( #' getOver(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getOver", "ddatamoments", @@ -253,7 +257,7 @@ setMethod( #' getZero(f_datamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments +#' * [datamoments-class] for the base class for model moments #' * [datamoments()] for the constructor of the `datamoments` class family setMethod( "getZero", "ddatamoments", diff --git a/R/dmodelmoments.R b/R/dmodelmoments.R index e69ff25..d2578a3 100644 --- a/R/dmodelmoments.R +++ b/R/dmodelmoments.R @@ -24,7 +24,7 @@ #' @slot factorial An array containing the first four factorial moments. #' @slot zero An numeric cotaining the excess zeros. #' @exportClass dmodelmoments -#' @name dmodelmoments +#' @rdname dmodelmoments-class #' #' @seealso #' * [modelmoments] for the base class diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index ebfd60c..7883768 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -28,7 +28,7 @@ #' @name exponentialmodelmoments #' #' @seealso -#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes .exponentialmodelmoments <- setClass("exponentialmodelmoments", representation( @@ -97,8 +97,11 @@ setMethod( #' #' @param object An `exponentialmodelmoments` object. #' @returns A console output listing the slots and summary information about -#' each of them. -#' @describeIn exponentialmodelmoments +#' each of them. +#' @noRd +#' @seealso +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes setMethod( "show", "exponentialmodelmoments", function(object) { @@ -134,7 +137,7 @@ setMethod( #' #' @param object An `exponentialmodelmoments` object. #' @returns The `B` slot of the `object`. -#' @describeIn modelmoments Getter method for slot `B` +#' @noRd #' #' @examples #' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), diff --git a/R/fdata.R b/R/fdata.R index 848c674..a5286a4 100644 --- a/R/fdata.R +++ b/R/fdata.R @@ -15,10 +15,124 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -#' Finmix fdata class -#' -#' The [fdata] class holds the data for finite mixture distributions. +#' Finmix `fdata` class #' +#' @description +#' The `fdata` class holds the data for finite mixture distributions. +#' +#' @details +#' The `fdata` class defines an essential part of the `finmix` package and +#' MCMC sampling for finite mixture distributions. It stores the data for +#' finite mixture distributions which includes always the observations stored +#' in slot `y` and occasionally also known indicators in slot `S`. The latter +#' ones define either a so-called finite mixture model with *fixed* indicators +#' or are used as starting indicators in MCMC sampling for a model with unknown +#' indicators. +#' +#' Observations can be stored in either in row or column format (default). In +#' the former case the slot `bycolumn` has to be set to `FALSE` to indicate the +#' safeguard functions in methods that the observations are stored in row +#' format. If indicators are stored in the `fdata` object they must be stored +#' in the same format as the observations. When using the setter `setS()<-` +#' converting the repetitions to the right format is handled for the user. +#' +#' For discrete mixture models with Poisson or Exponential distributions +#' exposures can be added to the data (and model). Exposures scale the rate +#' parameters individually for each observation. Exposures get stored in the +#' slot `exp` and have to be either of dimension `Nx1` or of dimension `1x1`. +#' Like observations and indicators, exposures also have to be provided in the +#' same data format, i.e. either row or column depending on the slot `bycolumn` +#' set to `FALSE` or `TRUE`. When using the setter `setExp()<-` converting the +#' repetitions to the right format is handled for the user. +#' +#' For mixtures of binomial distributions it is possible to include repetitions +#' in the slot `T` of the `fdata` object. Repetitions can be constant or +#' varying. In the former case the dimension of slot `T` is `1x1` and in the +#' latter one it is `Nx1`. Depending on the slot `bycolumn` the repetitions +#' have to be provided in row or column format. When using the setter +#' `setT()<-` converting the repetitions to the right format is handled for the +#' user. +#' +#' For mixtures of multivariate data the slot `r` is larger than one. For all +#' other mixtures it is equal to one. Note that in case of multivariate mixture +#' models the data in slot `y` has to be of dimension `Nxr` or `rxN` depending +#' on the slot `bycolumn` set to `TRUE` or `FALSE`. +#' +#' ## Methods +#' There are a couple of methods that intend to simplify the handling of data +#' for the user. These methods are listed below. +#' +#' ### Show +#' * `show()` gives a short summary of the object's slots. +#' +#' ### Getters +#' * `getY()` returns the `y` slot. +#' * `getColY()` returns the `y` slot in column format independent of +#' `bycolumn`. +#' * `getRowY()` returns the `y` slot in row format independent of `bycolumn`. +#' * `getN()` returns the `N` slot. +#' * `getr()` returns the `r` slot. +#' * `getS()` returns the `S` slot. +#' * `getColS()` returns the `S` slot in column format independent of +#' `bycolumn`. +#' * `getRowS()` returns the `S` slot in row format independent of `bycolumn`. +#' * `getBycolumn()` returns the `bycolumn` slot. +#' * `getName()` returns the `name` slot. +#' * `getType()` returns the `type` slot. +#' * `getSim()` returns the `sim` slot. +#' * `getExp()` returns the `exp` slot. +#' * `getColExp()` returns the `y` slot in column format independent of +#' `bycolumn`. +#' * `getRowExp()` returns the `y` slot in row format independent of `bycolumn`. +#' * `getT()` returns the `T` slot. +#' * `getColT()` returns the `T` slot in column format independent of +#' `bycolumn`. +#' * `getRowT()` returns the `T` slot in row format independent of `bycolumn`. +#' +#' ### Setters +#' All setters help the user to set the slots in the right format and with the +#' correct class (integer, matrix, etc.). It is internally checked, if the +#' new value fits the other slots of the object. +#' +#' * `setY()<-` sets the `y` slot. +#' * `setN()<-` sets the `N` slot. +#' * `setR()<-` sets the `r` slot. +#' * `setS()<-` sets the `S` slot. +#' * `setBycolumn` sets the `bycolumn` slot. +#' * `setName()<-` sets the `name` slot. +#' * `setType()<-` sets the `type` slot. +#' * `setSim()<-` sets the `sim` slot. +#' * `setExp()<-` sets the `exp` slot. +#' * `setT()<-` sets the `T` slot. +#' +#' ### Checking methods +#' The checking methods are provided to allow a user to integrate the `finmix` +#' classes more easily into a larger code basis. They check, if the slots are +#' available and return a `logical`. +#' +#' * `hasY()` checks, if slot `y` is not empty. +#' * `hasS()` checks, if slot `S` is not empty. +#' * `hasExp()` checks, if the slot `exp` is not empty. +#' * `hasT()` checks, if the slot `T` is not empty. +#' +#' ### Plotting +#' The plotting function should help the user to get an impression of how the +#' data in the `fdata` object is distributed. This is important for evaluating +#' what kind of distribution to choose and how many mixture components to test +#' for. +#' +#' * `plot(x, y, dev=TRUE, ...)` plots the observations in the `y` slot. If the +#' `type` is `"discrete"` a [barplot()] is shown. In the `"continuous"` case +#' the plot depends on the number of dimensions: if the dimension `r` of the +#' data is one, a [histogram()] shows the distribution of the observations. +#' In case of a two-dimensional data set, histograms of the marginal +#' distributions are plotted together with a scatter [plot()] and a +#' two-dimensional kernel-density (see [bkde2D()]). In case of a multivariate +#' data set with more than two dimensions a [pairs()] plot is returned. The +#' argument `dev` should be put to `FALSE` if the output should be in a file. +#' `...` allows the user to pass further arguments to the internal functions. +#' +#' ## Slots #' @slot y A matrix containing the observations for finite mixture estimation. #' Can be by column or row depending on the slot `bycolumn`. #' @slot N An integer holding the number of observations. @@ -39,7 +153,13 @@ #' @slot T A matrix containing the (optional) repetitions of binomial or Poisson #' data. Must be of type integer. #' @exportClass fdata -#' @name fdata_class +#' @rdname fdata-class +#' +#' @seealso +#' * [fdata()] for the class constructor +#' * [model-class] for the class from which data can be simulated +#' * [simulate()] for the method of the `model` class simulating data from a +#' finite mixture model .fdata <- setClass("fdata", representation( y = "matrix", @@ -165,7 +285,6 @@ #' @param ... Further arguments passed to the plotting functions `hist` or #' `barplot`. #' @exportMethod plot -#' @describeIn fdata_class #' #' @examples #' # Generate Poisson data and plot it. @@ -200,7 +319,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn fdata_class +#' @noRd #' #' @examples #' # Generate some Poisson data and show the `fdata` object @@ -262,7 +381,6 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `y` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasY -#' @describeIn fdata_class #' #' @examples #' # Generate an fdata object with Poisson data @@ -291,14 +409,13 @@ setMethod( #' Checker method for `S` slot of an `fdata` object. #' #' @description -#' [hasY()] checks, if the object contains `S` data. +#' [hasS()] checks, if the object contains `S` data. #' #' @param object An `fdata` object. #' @param verbose A logical indicating, if the function should print out #' messages. #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `S` slot is #' empty or filled or a message, if `verbose` is `TRUE`. -#' @describeIn fdata_class #' @exportMethod hasS #' @examples #' # Generate an fdata object with Poisson data @@ -335,7 +452,6 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `exp` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasExp -#' @describeIn fdata_class #' #' @examples #' # Generate an fdata object with Poisson data @@ -372,7 +488,6 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `T` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasT -#' @describeIn fdata_class #' #' @examples #' # Generate an fdata object with Poisson data @@ -407,7 +522,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `y` slot of the `object` as a column-ordered matrix. #' @exportMethod getColY -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -433,7 +547,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `y` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowY -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -459,7 +572,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `S` slot of the `object` as a column-ordered matrix. #' @exportMethod getColS -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -485,7 +597,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `S` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowS -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -511,7 +622,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `exp` slot of the `object` as a column-ordered matrix. #' @exportMethod getColExp -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -537,7 +647,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `exp` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowExp -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -563,7 +672,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `T` slot of the `object` as a column-ordered matrix. #' @exportMethod getColT -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -589,7 +697,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `T` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowT -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -617,7 +724,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `y` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getY -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -639,7 +745,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `N` slot of the `object`. #' @exportMethod getN -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -661,7 +766,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `r` slot of the `object`. #' @exportMethod getR -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -683,7 +787,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `S` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getS -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -705,7 +808,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `bycolumn` slot of the `object`. #' @exportMethod getBycolumn -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -727,7 +829,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `name` slot of the `object`. #' @exportMethod getName -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -749,7 +850,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `type` slot of the `object`. #' @exportMethod getType -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -771,7 +871,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `sim` slot of the `object`. #' @exportMethod getSim -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -793,7 +892,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `exp` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getExp -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -815,7 +913,6 @@ setMethod( #' @param object An `fdata` object. #' @returns The `T` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getT -#' @describeIn fdata_class #' #' @examples #' # Create an fdata object with Poisson data @@ -842,13 +939,12 @@ setMethod( #' @returns The `fdata` object with slot `y` set to `value` or an error message #' if the `value` cannot be set as slot `y`. #' @exportMethod setY<- -#' @describeIn fdata_class #' #' @examples #' f_data <- fdata() #' setY(f_data) <- rpois(100, 312) #' -#' @seealso [fdata] for all slots of the `fdata` class +#' @seealso [fdata-class] for all slots of the `fdata` class setReplaceMethod( "setY", "fdata", function(object, value) { @@ -882,7 +978,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `N` set to `value` or an error message #' if the `value` cannot be set as slot `N`. #' @exportMethod setN<- -#' @describeIn fdata_class #' #' @examples #' f_data <- fdata() @@ -909,7 +1004,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `R` set to `value` or an error message #' if the `value` cannot be set as slot `R`. #' @exportMethod setR<- -#' @describeIn fdata_class #' #' @examples #' f_data <- fdata() @@ -931,13 +1025,12 @@ setReplaceMethod( #' Sets the slot `S` of an `fdata` object and validates the slot data before #' setting. #' -#' @param object An `fdata` objects, whose slot `S` should be set. +#' @param object An `fdata` object, whose slot `S` should be set. #' @param value A matrix that should be set as `S` slot of the `fdata` object. #' Has to be of type integer. #' @returns The `fdata` object with slot `S` set to `value` or an error message #' if the `value` cannot be set as slot `S`. #' @exportMethod setS<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -971,7 +1064,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `bycolumn` set to `value` or an error message #' if the `value` cannot be set as slot `bycolumn`. #' @exportMethod setBycolumn<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -1016,7 +1108,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `name` set to `value` or an error message #' if the `value` cannot be set as slot `name`. #' @exportMethod setName<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -1044,7 +1135,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `type` set to `value` or an error message #' if the `value` cannot be set as slot `type`. #' @exportMethod setType<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -1073,7 +1163,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `sim` set to `value` or an error message #' if the `value` cannot be set as slot `sim`. #' @exportMethod setSim<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -1102,7 +1191,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `exp` set to `value` or an error message #' if the `value` cannot be set as slot `exp`. #' @exportMethod setExp<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -1137,7 +1225,6 @@ setReplaceMethod( #' @returns The `fdata` object with slot `T` set to `value` or an error message #' if the `value` cannot be set as slot `T`. #' @exportMethod setT<- -#' @describeIn fdata_class #' #' @examples #' # Generate an empty fdata object. @@ -1171,7 +1258,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class +#' #' @noRd #' #' @seealso @@ -1200,7 +1287,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class +#' #' @noRd #' #' @seealso @@ -1232,7 +1319,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1283,7 +1370,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1334,7 +1421,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1360,7 +1447,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1391,7 +1478,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1419,7 +1506,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1446,7 +1533,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1469,7 +1556,7 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1495,7 +1582,7 @@ setReplaceMethod( #' @param obj An `fdata` object. Must contain data. #' @returns A barplot. #' -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1553,7 +1640,7 @@ setReplaceMethod( #' @returns A histogram. #' @importFrom KernSmooth bkde2D #' @importFrom stats sd -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1562,6 +1649,9 @@ setReplaceMethod( #' * [hist()] the default plotting function for histogram plots in R. ".plot.continuous.Fdata" <- function(obj, dev) { datam <- getColY(obj) + if (is.null(colnames(datam))) { + colnames(datam) <- paste("y", seq(1, ncol(datam)),sep = "") + } if (obj@r == 1) { .symmetric.Hist(datam, colnames(datam)) } else if (obj@r == 2) { ## 2-dimensional @@ -1608,6 +1698,7 @@ setReplaceMethod( ) if (.check.grDevice() && dev) { dev.new("Perspective plot") + par(mfrow = c(1, 1)) } if (!is.null(colnames(datam))) { col.names <- colnames(datam) @@ -1619,7 +1710,7 @@ setReplaceMethod( xlab = col.names[1], ylab = col.names[2], zlab = "", col = "gray65", border = "gray47", theta = 55, phi = 30, - expand = 0.5, lphi = 190, ltheta = 90, + expand = 1.6, lphi = 190, ltheta = 90, r = 40, d = 0.1, cex = 0.7, cex.axis = 0.7, cex.lab = 0.7, ticktype = "detailed" ) @@ -1650,7 +1741,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1680,7 +1771,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1707,7 +1798,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1765,7 +1856,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1829,7 +1920,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1898,7 +1989,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -1971,7 +2062,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -2039,7 +2130,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -2111,7 +2202,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -2179,7 +2270,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso @@ -2250,7 +2341,7 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. -#' @describeIn fdata_class + #' @noRd #' #' @seealso diff --git a/R/graphic_func.R b/R/graphic_func.R index 8079d2c..5c7ac2c 100644 --- a/R/graphic_func.R +++ b/R/graphic_func.R @@ -48,7 +48,6 @@ #' or multivariate. #' @param lab.names A vector of characters describing the axis names. #' @return A plot containing the histograms of each of `y`'s dimensions. -#' @describeIn graphical_funs #' @noRd ".symmetric.Hist" <- function(y, lab.names) { r <- NCOL(y) @@ -163,7 +162,6 @@ #' or multivariate. #' @param lab.names A vector of characters describing the axis names. #' @return A plot containing the densities of each of `y`'s dimensions. -#' @describeIn graphical_funs #' @noRd ".symmetric.Dens" <- function(y, lab.names) { r <- NCOL(y) @@ -279,7 +277,6 @@ #' @param lab.name A vector of characters describing the axis names. #' @return A plot containing the histogram of the data stored in `y` together #' with rug representation of the data. -#' @describeIn graphical_funs #' @import graphics #' @noRd ".comb.Hist" <- function(y, lab.name) { @@ -291,7 +288,7 @@ ) rug(y, col = "gray47") mtext( - side = 1, do.call(bquote, lab.name), + side = 1, do.call(bquote, as.list(lab.name)), cex = 0.7, line = 3 ) } @@ -309,7 +306,6 @@ #' @param lab.name A vector of characters describing the axis names. #' @return A plot containing the density of the data stored in `y` together #' with rug representation of the data. -#' @describeIn graphical_funs #' @importFrom KernSmooth bkde #' @noRd ".comb.Dens" <- function(y, lab.name) { @@ -322,7 +318,7 @@ ) rug(y, col = "gray47") mtext( - side = 1, do.call(bquote, lab.name), + side = 1, do.call(bquote, as.list(lab.name)), cex = 0.7, line = 3 ) } diff --git a/R/groupmoments.R b/R/groupmoments.R index 84cad67..ef4e6b7 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -20,7 +20,7 @@ #' Stores moments for finite mixture component distributions. These are only #' available, if the data contains in addition to observations also indicators #' defining to which component a certain observation belongs. These indicators -#' are stored in an [fdata][fdata_class] object in the slot `S`. +#' are stored in an [fdata-class] object in the slot `S`. #' #' @slot NK An array containing the group sizes for each component. #' @slot mean A matrix containing the group averages for each component. @@ -30,12 +30,13 @@ #' @slot var An array containing the within-group (co)variance. For multivariate #' data this is an array of dimension `K x r x r` and for univariate #' data this is simply an array of dimension `1 x K`. -#' @slot fdata An [fdata][fdata_class] object containing the data. +#' @slot fdata An [fdata-class] object containing the data. #' @exportClass groupmoments -#' @name groupmoments_class +#' @rdname groupmoments-class +#' @keywords internal #' @seealso #' * [groupmoments()] for the class constructor -#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments-class] for the base class for data moments #' * [datamoments()] for the constructor of any object of the `datamoments` #' class family .groupmoments <- setClass("groupmoments", @@ -64,7 +65,7 @@ #' @description #' Calling [groupmoments()] creates an object holding various #' component-specific moments. These moments can only constructed if the -#' [fdata][fdata_class] object contains in addition to observations also +#' [fdata-class] object contains in addition to observations also #' indicators defining from which component a certain observation stems. #' #' @param value An `fdata` object containing observations in slot `y` and @@ -83,10 +84,10 @@ #' groupmoments(f_data) #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [groupmoments][groupmments_class] for the definition of the `groupmoments` #' class -#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments-class] for the base class for data moments #' * [datamoments()] for the constructor of any object of the `datamoments` #' class family "groupmoments" <- function(value = fdata()) { @@ -108,7 +109,7 @@ #' [initialize]. #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. -#' @param model A finmix [fdata][fdata_class] object containing the observations. +#' @param model A finmix [fdata-class] object containing the observations. #' @noRd #' #' @seealso diff --git a/R/likelihood.R b/R/likelihood.R index 93c6620..7c7ec5d 100644 --- a/R/likelihood.R +++ b/R/likelihood.R @@ -32,7 +32,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.normal" <- function(y, mu, sigma) { @@ -75,7 +75,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.student" <- function(y, mu, sigma, df) { @@ -118,7 +118,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.exponential" <- function(y, lambda) { @@ -154,7 +154,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.poisson" <- function(y, lambda) { @@ -195,7 +195,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.binomial" <- function(y, T, p) { @@ -237,7 +237,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.normult" <- function(y, mu, sigmainv, logdet) { @@ -279,7 +279,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [dataclass()] for the constructor of the `dataclass` class ".likelihood.studmult" <- function(y, mu, sigmainv, logdet, df) { diff --git a/R/mcmc.R b/R/mcmc.R index 9a72c84..9bb099f 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -38,7 +38,7 @@ #' @slot storeinv A logical indicating if the inverse variance-covariance #' matrices for multivariate normal or Student-t mixtures should be stored. #' @exportClass mcmc -#' @name mcmc_class +#' @rdname mcmc-class #' #' @seealso #' * [mcmc()] for the class constructor @@ -103,7 +103,7 @@ #' f_mcmc <- mcmc() #' #' @seealso -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mcmcstart()] for setting up all objects for MCMC sampling #' * [mixturemcmc()] for running MCMC sampling for finite mixture models "mcmc" <- function(burnin = 0, M = 5000, @@ -127,7 +127,11 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmc_class +#' @noRd +#' +#' @seealso +#' * [mcmc-class] for the class definition +#' * [mcmc()] for the constructor of the class setMethod( "show", "mcmc", function(object) { @@ -159,7 +163,7 @@ setMethod( #' getBurnin(f_mcmc) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getBurnin", "mcmc", @@ -183,7 +187,7 @@ setMethod( #' getM(f_mcmc) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getM", "mcmc", @@ -207,7 +211,7 @@ setMethod( #' getStartpar(f_mcmc) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getStartpar", "mcmc", @@ -231,7 +235,7 @@ setMethod( #' getStoreS(f_mcmc) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getStoreS", "mcmc", @@ -255,7 +259,7 @@ setMethod( #' getStorepost(f_mcmc) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getStorepost", "mcmc", @@ -279,7 +283,7 @@ setMethod( #' getRanperm(f_mcmc) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setMethod( "getRanperm", "mcmc", @@ -305,7 +309,7 @@ setMethod( #' setBurnin(f_mcmc) <- as.integer(2000) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setBurnin", "mcmc", @@ -332,7 +336,7 @@ setReplaceMethod( #' setM(f_mcmc) <- as.integer(20000) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setM", "mcmc", @@ -359,7 +363,7 @@ setReplaceMethod( #' setStartpar(f_mcmc) <- FALSE #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setStartpar", "mcmc", @@ -386,7 +390,7 @@ setReplaceMethod( #' setStoreS(f_mcmc) <- as.integer(500) #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setStoreS", "mcmc", @@ -414,7 +418,7 @@ setReplaceMethod( #' setStorepost(f_mcmc) <- FALSE #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setStorepost", "mcmc", @@ -441,7 +445,7 @@ setReplaceMethod( #' setRanperm(f_mcmc) <- FALSE #' #' @seealso -#' * [mcmc][mcmc_class] for the class definition +#' * [mcmc-class] for the class definition #' * [mcmc()] for the constructor of the `mcmc` class setReplaceMethod( "setRanperm", "mcmc", diff --git a/R/mcmcestfix.R b/R/mcmcestfix.R index e2d0089..38633e1 100644 --- a/R/mcmcestfix.R +++ b/R/mcmcestfix.R @@ -50,7 +50,8 @@ #' @slot sdpost A named list containing the standard deviations of the #' parameter estimates from the posterior distributions. #' @exportClass mcmcestfix -#' @name mcmcest_class +#' @rdname mcmcest-class +#' @keywords internal #' #' @seealso #' * [mcmcestind][mcmcest_class] for the equivalent class for models with @@ -98,7 +99,6 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcest_class setMethod( "show", "mcmcestfix", function(object) { @@ -144,7 +144,6 @@ setMethod( #' @returns A console output listing the formatted slots and summary #' information about each of them. #' @exportMethod Summary -#' @describeIn mcmcest_class setMethod( "Summary", "mcmcestfix", function(x, ..., na.rm = FALSE) { @@ -225,7 +224,7 @@ setMethod( #' getDist(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -260,7 +259,7 @@ setMethod( #' getK(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -295,7 +294,7 @@ setMethod( #' getIndicmod(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -330,7 +329,7 @@ setMethod( #' getBurnin(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -365,7 +364,7 @@ setMethod( #' getM(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -400,7 +399,7 @@ setMethod( #' getRanperm(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -435,7 +434,7 @@ setMethod( #' getRelabel(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -470,7 +469,7 @@ setMethod( #' getMap(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -505,7 +504,7 @@ setMethod( #' getBml(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -540,7 +539,7 @@ setMethod( #' getIeavg(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( @@ -575,7 +574,7 @@ setMethod( #' getIeavg(f_output) #' #' @seealso -#' * [mcmcestind][mcmcoutput_class] for the corresponding class for models +#' * [mcmcestind-class] for the corresponding class for models #' with unknown indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( diff --git a/R/mcmcestimate.R b/R/mcmcestimate.R index aedcb41..509f924 100644 --- a/R/mcmcestimate.R +++ b/R/mcmcestimate.R @@ -60,7 +60,7 @@ #' case of fixed indicators #' * [mcmcestfix][mcmcest_class] for object storing the parameter estimates in #' case of unknown indicators -#' * [mcmcoutputperm][mcmcoutputperm_class] for classes storing re-labeled +#' * [mcmcoutputperm-class] for classes storing re-labeled #' MCMC samples "mcmcestimate" <- function(mcmcout, method = "kmeans", fdata = NULL, permOut = FALSE, opt_ctrl = list(max_iter = 200L)) { diff --git a/R/mcmcestind.R b/R/mcmcestind.R index 29e8d4a..3f9e62c 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -33,7 +33,8 @@ #' `weight` contains the weight estimates. The difference between the EAVG #' and the IEAVG is that the IEAVG is based on re-labeled samples. #' @exportClass mcmcestind -#' @describeIn mcmcest_class Finmix `mcmcestind` class +#' @rdname mcmcestind-class +#' @keywords internal #' #' @seealso #' * [mcmcestfix][mcmcest_class] for the parent class with fixed indicators @@ -73,7 +74,7 @@ setClassUnion( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcest_class +#' @noRd setMethod( "show", "mcmcestind", function(object) { @@ -124,7 +125,6 @@ setMethod( #' @returns A console output listing the formatted slots and summary #' information about each of them. #' @exportMethod Summary -#' @describeIn mcmcest_class setMethod( "Summary", "mcmcestind", function(x, ..., na.rm = FALSE) { @@ -220,7 +220,7 @@ setMethod( #' getEavg(f_output) #' #' @seealso -#' * [mcmcestfix][mcmcoutput_class] for the parent class with fixed indicators +#' * [mcmcestfix-class] for the parent class with fixed indicators #' * [mcmcestimate()] for calculating point estimates from MCMC samples setMethod( "getEavg", "mcmcestind", diff --git a/R/mcmcextract.R b/R/mcmcextract.R index a7ee9a8..3aa02f2 100644 --- a/R/mcmcextract.R +++ b/R/mcmcextract.R @@ -1,6 +1,6 @@ #' Finmix `mcmcextract` class #' -#' @desfription +#' @description #' This is a leight-weighted class containing the major results from MCMC #' sampling to calculate model moments from MCMC samples. Note that momentarily #' only methods for the multivariate Normal mixture are implemented. @@ -50,8 +50,8 @@ #' @exportMethod moments #' @noRd #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the results from MCMC sampling -#' * [extract()][mcmcoutput_class] for the calling method +#' * [mcmcoutput-class] for the results from MCMC sampling +#' * [extract()] for the calling method setMethod( "moments", signature(object = "mcmcextract"), function(object) { @@ -73,8 +73,8 @@ setMethod( #' @return A list containing the model moments calculated from MCMC samples. #' @noRd #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the results from MCMC sampling -#' * [extract()][mcmcoutput_class] for the calling method +#' * [mcmcoutput-class] for the results from MCMC sampling +#' * [extract()] for the calling method ".moments.Normult.Mcmcextract" <- function(obj) { K <- obj@K r <- obj@r diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index 452a3b7..aba868d 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -29,11 +29,11 @@ #' @slot entropy An `array` of dimension `M x 1` containing the entropy #' for each MCMC draw. #' @slot ST An `array` of dimension `M x 1` containing all MCMC states, -#' for the last observation in slot `@@y` of the `fdata` object passed in to +#' for the last observation in slot `y` of the `fdata` object passed in to #' [mixturemcmc()] where a state is defined for non-Markov models as the #' last indicator of this observation. #' @slot S An `array` of dimension `N x storeS` containing the last -#' `storeS` indicators sampled. `storeS` is defined in the slot `@@storeS` of +#' `storeS` indicators sampled. `storeS` is defined in the slot `storeS` of #' the `mcmc` object passed into [mixturemcmc()]. #' @slot NK An `array` of dimension `M x K` containing the number of #' observations assigned to each component for each MCMC draw. @@ -41,7 +41,7 @@ #' indicators defining the last "clustering" of observations into the #' mixture components. #' @exportClass mcmcoutputbase -#' @rdnam mcmcoutputbase-class +#' @rdname mcmcoutputbase-class .mcmcoutputbase <- setClass("mcmcoutputbase", representation( weight = "array", diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index 0f35417..da60976 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -38,7 +38,8 @@ #' @slot prior The `prior` object defining the prior distributions for the #' component parameters that has been used in MCMC sampling. #' @exportClass mcmcoutputfix -#' @name mcmcoutput_class +#' @rdname mcmcoutput-class +#' @keywords internal .mcmcoutputfix <- setClass("mcmcoutputfix", representation( M = "integer", @@ -74,7 +75,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class +#' @noRd setMethod( "show", "mcmcoutputfix", function(object) { @@ -123,7 +124,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -194,7 +195,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -256,7 +257,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -318,7 +319,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -370,7 +371,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -420,7 +421,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -542,7 +543,7 @@ setMethod( #' Extracts samples from `mcmcoutput` object of a multivariate Normal mixture #' -#' @ðescription +#' @description #' This function extracts samples from a multivariate Normal mixture output. #' #' @param object An `mcmcoutput` object from MCMC sampling of a multivariate @@ -551,7 +552,7 @@ setMethod( #' mixture should be extracted. #' @return An object class `mcmcextract` containing all samples of an extracted #' dimension. -#' @describeIn mcmcoutput_class +#' @export setMethod( "extract", signature( object = "mcmcoutputfix", @@ -570,13 +571,14 @@ setMethod( #' Computes multivariate Normal sample moments #' #' @description -#' Calling [moments()] calculates the sample moments for the samples of a +#' Calling `moments()` calculates the sample moments for the samples of a #' multivariate Normal mixture model. #' #' @param object An `mcmcoutputfix` object containing all data from MCMC #' sampling. #' @return The moments on the samples of a multivariate Normal mixture. -#' @describeIn mcmcoutput_class +#' @exportMethod moments +#' @noRd setMethod( "moments", signature(object = "mcmcoutputfix"), function(object) { @@ -612,7 +614,7 @@ setMethod( #' getM(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getM", "mcmcoutputfix", @@ -645,7 +647,7 @@ setMethod( #' getBurnin(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getBurnin", "mcmcoutputfix", @@ -678,7 +680,7 @@ setMethod( #' getRanperm(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getRanperm", "mcmcoutputfix", @@ -711,7 +713,7 @@ setMethod( #' getPar(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPar", "mcmcoutputfix", @@ -744,7 +746,7 @@ setMethod( #' getLog(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getLog", "mcmcoutputfix", @@ -778,7 +780,7 @@ setMethod( #' getModel(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getModel", "mcmcoutputfix", @@ -811,7 +813,7 @@ setMethod( #' getPrior(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPrior", "mcmcoutputfix", diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index db6fcd7..a60523d 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -24,10 +24,10 @@ #' @slot hyper A list storing the sampled parameters from the hierarchical #' prior. #' @exportClass mcmcoutputfixhier -#' @describeIn mcmcoutput_class +#' @rdname mcmcoutputfixhier-class #' #' @seealso -#' * [mcmcoutputfix][mcmcoutput_class] for the parent class`` +#' * [mcmcoutputfix-class] for the parent class`` .mcmcoutputfixhier <- setClass("mcmcoutputfixhier", representation(hyper = "list"), contains = c("mcmcoutputfix"), @@ -47,7 +47,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class +#' @noRd setMethod( "show", "mcmcoutputfixhier", function(object) { @@ -106,7 +106,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -175,7 +175,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -236,7 +236,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -296,7 +296,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -342,7 +342,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -388,7 +388,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -505,7 +505,7 @@ setMethod( #' getHyper(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getHyper", "mcmcoutputfixhier", diff --git a/R/mcmcoutputfixhierpost.R b/R/mcmcoutputfixhierpost.R index 7f97531..e50d925 100644 --- a/R/mcmcoutputfixhierpost.R +++ b/R/mcmcoutputfixhierpost.R @@ -20,19 +20,19 @@ #' @description #' This class inherits from the `mcmcoutputfixhier` class and adds posterior #' density parameters to the MCMC sampling output. The storage of posterior -#' parameters is controlled by the slot `storepost` in the [mcmc][mcmc_class] +#' parameters is controlled by the slot `storepost` in the [mcmc-class] #' class. If set to `TRUE` posterior parameters are stored in the output of the #' MCMC sampling. #' #' @slot post A named list containing a named list `par` with arrays for the #' posterior density parameters. #' @exportClass mcmcoutputfixhierpost -#' @describeIn mcmcoutput_class +#' @rdname mcmcoutputfixhierpost-class #' #' @seealso -#' * [mcmcoutputfixhier][mcmcoutput_class] for the parent class +#' * [mcmcoutputfixhier-class] for the parent class #' * [mixturemcmc()] for performing MCMC sampling -#' * [mcmc][mcmc_class] for the class defining the MCMC hyper-parameters +#' * [mcmc-class] for the class defining the MCMC hyper-parameters #' * [mcmc()] for the `mcmc` class constructor .mcmcoutputfixhierpost <- setClass("mcmcoutputfixhierpost", representation(post = "list"), @@ -54,7 +54,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class +#' @noRd setMethod( "show", "mcmcoutputfixhierpost", function(object) { @@ -165,7 +165,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputfixpost.R b/R/mcmcoutputfixpost.R index 9b58a59..846e8d0 100644 --- a/R/mcmcoutputfixpost.R +++ b/R/mcmcoutputfixpost.R @@ -21,20 +21,21 @@ #' The `mcmcoutputfixpost` class inherits from the `mcmcoutputfix` class and #' adds a slot to store the parameters of the posterior distribution from which #' the component parameters are drawn. The storage of posterior parameters is -#' controlled by the slot `storepost` in the [mcmc][mcmc_class] class. If set +#' controlled by the slot `storepost` in the [mcmc-class] class. If set #' to `TRUE` posterior parameters are stored in the output of the MCMC sampling. #' #' @slot post A named list containing a list `par` that contains the posterior #' parameters as named arrays. #' @exportClass mcmcoutputfixpost -#' @describeIn mcmcoutput_class +#' @rdname mcmcoutputfixpost-class +#' @keywords internal #' #' @seealso -#' * [mcmcoutputfix][mcmcoutput_class] for the parent class -#' * [mcmcoutputpost][mcmcoutput_class] for the corresponding class for unknown +#' * [mcmcoutputfix-class] for the parent class +#' * [mcmcoutputpost-class] for the corresponding class for unknown #' indicators. -#' * [mcmc][mcmc_class] for the class defining the MCMC hyper-parameters -#' * [mcmc()] for the constructor of the [mcmc][mcmc_class] class +#' * [mcmc-class] for the class defining the MCMC hyper-parameters +#' * [mcmc()] for the constructor of the [mcmc-class] class .mcmcoutputfixpost <- setClass("mcmcoutputfixpost", representation(post = "list"), contains = c("mcmcoutputfix"), @@ -55,7 +56,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class +#' @noRd setMethod( "show", "mcmcoutputfixpost", function(object) { @@ -109,7 +110,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -161,7 +162,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -212,7 +213,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -261,7 +262,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -310,7 +311,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -359,7 +360,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -489,7 +490,7 @@ setMethod( #' getPost(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPost", "mcmcoutputfixpost", diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index 3cd9f0d..ebfe9f4 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -55,7 +55,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class +#' @noRd setMethod( "show", "mcmcoutputhier", function(object) { @@ -393,7 +393,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index 6f867f6..dda1be1 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -52,17 +52,124 @@ prototype(post = list()) ) -## Set 'mcmcoutput' to the virtual class inheriting ## -## to each other 'mcmcoutput' class. ## -## This is done to simplify dispatching methods. ## -#' Finmix `mcmcoutput` class union +#' Finmix `mcmcoutput` class #' #' @description -#' This class union is set to dispatch methods for `mcmcoutput` objects from -#' MCMC sampling. -#' +#' The `mcmcoutput` class stores all MCMC samples and corresponding information. +#' +#' @detail +#' Calling [mixturemcmc()] on appropriate input arguments performs MCMC +#' sampling and returns an `mcmcoutput` object that stores all samples and +#' corresponding information like hyper-parameters, the finite mixture model +#' specified in a `model` object and the `prior` that specifies the prior +#' distribution. All slots are listed below. Note that not all slots must be +#' available in a object of class `mcmcoutput`. Some slots get only occupied, +#' if a hierarchical prior had been used in MCMC sampling, or if posterior +#' samples should be stored. Furthermore, the slots also look different, if +#' MCMC sampling had been performed for a model with fixed indicators (see for +#' subclasses for example [mcmcoutputfix-class], [mcmcoutputbase-class], +#' [mcmcoutputhier-class] or [mcmcoutputpost-class]). +#' +#' The class `mcmcoutput` is a class union and includes all classes that +#' define objects to store MCMC samples and is used to dispatch methods for +#' `mcmcoutput` objects. For the user this detail is not important, +#' especially as this class has no exported constructor. Objects are solely +#' constructed internally within the function [mixturemcmc()]. +#' +#' ## Class methods +#' +#' This class comes along with a couple of methods that should give the user +#' some comfort in handling the MCMC sampling results. There are no setters for +#' this class as the slots are only set internally. +#' +#' ### Show +#' * `show()` shows a short summary of the object's slots. +#' +#' ### Getters +#' * `getM()` returns the `M` slot. +#' * `getBurnin()` returns the `burnin` slot. +#' * `getRanperm()` returns the `ranperm` slot. +#' * `getPar()` returns the `par` slot. +#' * `gteWeight()` returns the `weight` slot, if available. +#' * `getLog()` returns the `log` slot. +#' * `getEntropy()` returns the `entropy` slot, if available. +#' * `getHyper()` returns the `hyper` slot, if available. +#' * `getPost()` returns the `post` slot, if available. +#' * `getST()` returns the `ST` slot, if available. +#' * `getS()` returns the `S` slot, if available. +#' * `getNK()` returns the `NK` slot, if available. +#' * `getClust()` returns the `clust` slot, if available. +#' * `getModel()` returns the `model` slot. +#' * `getPrior()` returns the `prior` slot. +#' +#' ### Plotting +#' Plotting functionality for the `mcmcoutput` helps the user to inspect MCMC +#' results. +#' +#' * `plotTraces()` plots traces of MCMC samples. See [plotTraces()] for +#' further information. +#' * `plotHist()` plots histograms of parameters and weights. See [plotHist()] +#' for further information. +#' * `plotDens()` plots densities of parameters and weights. See [plotDens()] +#' for further information. +#' * `plotPointProc()` plots the point process of component parameters. See +#' [plotPointProc] for further information. +#' * `plotSampRep()` plots the sampling representation of component parameters. +#' See [plotSampRep()] for further information. +#' * `plotPostDens()` plots the posterior density of component parameters. Note +#' that this function can only be applied for mixtures of two components. See +#' [plotPostDens()] for further information. +#' +#' ## Slots +#' @slot M An integer defining the number of iterations in MCMC sampling. +#' @slot burnin An integer defining the number of iterations in the burn-in +#' phase of MCMC sampling. These number of sampling steps are not stored +#' in the output. +#' @slot ranperm A logical indicating, if MCMC sampling has been performed +#' with random permutations of components. +#' @slot par A named list containing the sampled component parameters. +#' @slot weight An `array` of dimension `M x K` containing the sampled +#' weights. +#' @slot log A named list containing the values of the mixture log-likelihood, +#' mixture prior log-likelihood, and the complete data posterior +#' log-likelihood. +#' @slot hyper A list storing the sampled parameters from the hierarchical +#' prior. +#' @slot post A named list containing a list `par` that contains the posterior +#' parameters as named arrays. +#' @slot entropy An `array` of dimension `M x 1` containing the entropy +#' for each MCMC draw. +#' @slot ST An `array` of dimension `M x 1` containing all MCMC states, +#' for the last observation in slot `y` of the `fdata` object passed in to +#' [mixturemcmc()] where a state is defined for non-Markov models as the +#' last indicator of this observation. +#' @slot S An `array` of dimension `N x storeS` containing the last +#' `storeS` indicators sampled. `storeS` is defined in the slot `@@storeS` of +#' the `mcmc` object passed into [mixturemcmc()]. +#' @slot NK An `array` of dimension `M x K` containing the number of +#' observations assigned to each component for each MCMC draw. +#' @slot clust An `array` of dimension `N x 1` containing the recent +#' indicators defining the last "clustering" of observations into the +#' mixture components. +#' @slot model The `model` object that specifies the finite mixture model for +#' whcih MCMC sampling has been performed. +#' @slot prior The `prior` object defining the prior distributions for the +#' component parameters that has been used in MCMC sampling. +#' #' @exportClass mcmcoutput -#' @describeIn mcmcoutput_class +#' @rdname mcmcoutput-class +#' +#' @seealso +#' * [mcmcoutputperm-class] for the corresponding class defined for relabeled +#' MCMC samples +#' * [mcmcoutputfix-class] for the `mcmcoutput` sub-class for models with +#' fixed indicators +#' * [mcmcoutputbase-class] for the `mcmcoutput` sub-class for models with +#' unknown indicators +#' * [mcmcoutputhier-class] for the `mcmcoutput` sub-class for MCMC samples +#' with hierarchical priors +#' * [mcmcoutputpost-class] for the `mcmcoutput` sub-class for MCMC samples +#' with stored posterior density parameters setClassUnion( "mcmcoutput", c( @@ -87,8 +194,7 @@ setClassUnion( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputhierpost-class SHows a short summary of the object's -#' slots +#' @noRd setMethod( "show", "mcmcoutputhierpost", function(object) { @@ -167,7 +273,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ @@ -219,7 +325,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ @@ -270,7 +376,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ @@ -416,7 +522,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ @@ -548,7 +654,7 @@ setMethod( #' getPost(f_output) #' #' @seealso -#' * [mcmcoutput][mcmcoutput_class] for the class definition +#' * [mcmcoutput-class] for the class definition #' * [mixturemcmc()] for performing MCMC sampling setMethod( "getPost", "mcmcoutputhierpost", diff --git a/R/mcmcoutputpermfix.R b/R/mcmcoutputpermfix.R index 442eb29..22287b7 100644 --- a/R/mcmcoutputpermfix.R +++ b/R/mcmcoutputpermfix.R @@ -95,7 +95,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfix-class +#' @noRd setMethod( "show", "mcmcoutputpermfix", function(object) { @@ -228,7 +228,7 @@ setMethod( #' @describeIn mcmcoutputpermfix-class #' #' @examples -#' \dontrun{} +#' \dontrun{ #' # Define a Poisson mixture model with two components. #' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, #' indicfix = TRUE) diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index 13d5d2c..902642e 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -463,7 +463,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputperm_class +#' @noRd #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index 79fd3c6..171af97 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -109,8 +109,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfixhierpost-class Shows a short summary of the -#' object's slots +#' @noRd setMethod( "show", "mcmcoutputpermfixhierpost", function(object) { diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index 18b5911..739a945 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -23,7 +23,11 @@ #' #' @exportClass mcmcoutputpermfixpost #' @rdname mcmcoutputpermfixpost-class +#' @keywords internal #' @seealso +#' * [mcmcoutputfixpost-class] for the parent class +#' * [mcmcpermfixpost] for the parent class +#' * [mcmcpermute()] for permuting MCMC samples .mcmcoutputpermfixpost <- setClass("mcmcoutputpermfixpost", contains = c( "mcmcpermfixpost", @@ -91,8 +95,10 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfixpost-class Shows a short summary of the -#' object's slots +#' @noRd +#' +#' @seealso +#' * [mcmcoutputpermfixpost-class] for the class definition setMethod( "show", "mcmcoutputpermfixpost", function(object) { diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index 8a82db7..2385084 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -424,7 +424,6 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputperm_class #' #' @examples #' # Define a Poisson mixture model with two components. @@ -478,7 +477,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputperm_class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index fbe81d5..f13ef6e 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -81,7 +81,7 @@ #' MCMC states, for the last observation in slot `@@y` of the `fdata` object #' passed in to [mixturemcmc()] where a state is defined for non-Markov #' models as the last indicator of this observation. -#' @param An `array` of dimension `N x storeS` containing the last +#' @param Sperm An `array` of dimension `N x storeS` containing the last #' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` #' of the `mcmc` object passed into [mixturemcmc()]. #' @param NKperm An `array` of dimension `Mperm x K` containing the numbers @@ -598,7 +598,7 @@ setMethod( #' Finmix `mcmcoutputperm` class #' #' @description -#' The mcmcoutputperm class stores MCMC samples after relabeling (permuting). +#' The `mcmcoutputperm` class stores MCMC samples after relabeling (permuting). #' #' @details #' Calling [mcmcpermute()] on an `mcmcoutput` class permutes the labels of the @@ -608,9 +608,90 @@ setMethod( #' get assigned to the same label and henceforth get eliminated from further #' analysis. #' -#' This class union includes all classes that define objects for permuted -#' MCMC samples and is used to dispatch methods for `mcmcoutputperm` objects. -#' +#' The class `mcmcoutputperm` is a class union and includes all classes that +#' define objects for permuted MCMC samples and is used to dispatch methods for +#' `mcmcoutputperm` objects. For the user this detail is not important, +#' especially as this class has no exported constructor. Objects are solely +#' constructed internally within the function [mcmcpermute()]. +#' +#' An object of class `mcmcoutputperm` inherits all slots from its parent class +#' [mcmcoutput][mcmcoutput-class]. In addition it contains slots that store +#' data from permutation. These slots are listed below +#' +#' ## Class methods +#' Similar to the parent class [mcmcoutput][mcmcoutput-class] this class comes +#' along with a couple of methods that should give the user some comfort in +#' handling the permuted sampling results. There are no setters for this class +#' as the slots are only set internally. +#' +#' ### Show +#' * `show()` shows a short summary of the object's slots. +#' +#' ### Getters +#' * `getMperm()` returns the `Mperm` slot. +#' * `getParperm()` returns the `parperm` slot. +#' * `getLogperm()` returns the `parperm` slot. +#' * `getHyperperm()` returns the `hyperparm` slot. +#' * `getPostperm()` returns the `postperm` slot. +#' * `getEntropyperm()` returns the `entropyperm` slot. +#' * `getSTperm()` returns the `STperm` slot. +#' * `getSperm()` returns the `Sperm` slot. +#' * `getNKperm()` returns the `NKperm` slot. +#' +#' ### Plotting +#' Plotting functionality for the `mcmcoutputperm` class is so far only +#' implemented for mixtures of Binomial or Poisson distributions. +#' +#' * `plotTraces()` plots traces of relabeled MCMC sampling. See [plotTraces()] +#' for further information. +#' * `plotHist()` plots histograms of relabeled parameters and weights. See +#' [plotHist()] for further information. +#' * `plotDens()` plots densities of relabeled parameters and weights. See +#' [plotDens()] for further information. +#' * `plotPointProc()` plots the point process of relabeled component +#' parameters. See [plotPointProc] for further information. +#' * `plotSampRep()` plots the sampling representation of relabeled component +#' parameters. See [plotSampRep()] for further information. +#' * `plotPostDens()` plots the posterior density of component parameters. Note +#' that this function can only be applied for mixtures of two components. See +#' [plotPostDens()] for further information. +#' +#' ## Slots +#' @slot Mperm An integer defining the number of permuted MCMC samples. +#' @slot parperm A named list containing the permuted component parameter +#' samples from MCMC sampling. +#' @slot relabel A character specifying the relabeling algorithm used for +#' permuting the MCMC samples. +#' @slot weightperm An array of dimension `MpermxK` containing the +#' relabeled weight parameters. This slot is not available for models with +#' fixed indicators as weights do not get sampled for such models. +#' @slot logperm A named list containing the mixture log-likelihood, the +#' prior log-likelihood, and for models with unknown indicators the complete +#' data posterior log-likelihood for the permuted MCMC samples. +#' @slot hyperperm A named list containing the (permuted) parameters of the +#' hierarchical prior. This slot is only available, if a hierarchical prior +#' had been used for sampling, i.e. the slot `hier` of the +#' [prior][prior-class] had been set to `TRUE`. +#' @slot postperm A named list containing a named list `par` with array(s) of +#' parameters from the posterior density. This slot is only available if +#' the hyperparameter `storepost` in the [mcmc][mcmc-class] object had been +#' set to `TRUE`. +#' @slot entropyperm An `array` of dimension `Mpermx1` containing the +#' entropy for each MCMC permuted draw. This slot is only available for +#' models with unknown indicators. +#' @slot STperm An `array` of dimension `Mpermx1` containing all permuted +#' MCMC states, for the last observation in slot `y` of the `fdata` object +#' passed in to [mixturemcmc()] where a state is defined for non-Markov +#' models as the last indicator of this observation. This slot is only +#' available for models with unknown indicators. +#' @slot Sperm An `array` of dimension `N x storeS` containing the last +#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' of the `mcmc` object passed into [mixturemcmc()]. This slot is only +#' available for models with unknown indicators. +#' @slot NKperm An `array` of dimension `Mperm x K` containing the numbers +#' of observations assigned to each component. This slot is only available for +#' models with unknown indicators. +#' #' @exportClass mcmcoutputperm #' @rdname mcmcoutputperm-class setClassUnion( @@ -625,4 +706,242 @@ setClassUnion( "mcmcoutputpermpost", "mcmcoutputpermhierpost" ) -) \ No newline at end of file +) + +#' Plots traces of MCMC sampling +#' +#' @description +#' `plotTraces()` is a class method for [mcmcoutput][mcmcoutput-class] and +#' [mcmcoutputperm][mcmcoutputperm-class] objects. For the former class it +#' plots the traces of MCMC samples and for the latter of the corresponding +#' permuted samples coming from relabeling. +#' +#' @details +#' Calling [plotTraces()] with `lik` set to `1`, plots the MCMC traces of the +#' mixture log-likelihood, the mixture log-likelihood of the prior +#' distribution, or the log-likelihood of the complete data posterior, if the +#' model has unknown indicators. +#' +#' If `lik` is set to `0` the parameters of the components, the posterior +#' parameters, and the parameters of the hierarchical prior are plotted +#' together with `K-1` weights. +#' +#' ## Hierarchical priors +#' In case of hierarchical priors, the function also plots traces from the +#' sampled hierarchical prior's parameters, in case `lik` is set to `1`. +#' +#' ## Posterior density parameters +#' In case posterior density parameters had been stored in MCMC sampling, the +#' traces of these parameters are added to the plot. +#' +#' @param x An `mcmcoutput` or `mcmcoutputperm` object containing all sampled +#' values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param lik An integer indicating, if the log-likelihood traces should be +#' plotted (default). If set to `0` the traces for the parameters +#' and weights are plotted instead. +#' @param col A logical indicating, if the plot should be colored. +#' @param ... Further arguments to be passed to the plotting function. +#' @return A plot of the traces of the MCMC samples. +#' @name plotTraces +#' @rdname plotTraces-method +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotTraces(f_outputperm, lik = 0) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters +#' * [mcmcoutput-class] for the class definition of `mcmcoutput` +#' * [mcmcoutputperm-class] for the class definition of `mcmcoutputperm` +NULL + +#' Plot histograms of the parameters and weights +#' +#' @description +#' #' `plotHist()` is a class method for [mcmcoutput][mcmcoutput-class] and +#' [mcmcoutputperm][mcmcoutputperm-class] objects. For the former class it +#' plots histograms of MCMC samples and for the latter of the corresponding +#' permuted samples coming from relabeling. +#' +#' @details +#' Calling [plotHist()] plots histograms of the sampled parameters and weights +#' from MCMC sampling. Note, for relabeled MCMC samples this method is so far +#' only implemented for mixtures of Poisson and Binomial distributions. +#' +#' ## Hierarchical priors +#' In case that hierarchical priors had been used in MCMC sampling histograms +#' of the sampled parameters of the hierarchical prior are added to the plot. +#' +#' ## Posterior density parameters +#' In case that posterior density parameters had been stored in MCMC sampling, +#' histograms of these parameters are added to the plot. +#' +#' @param x An `mcmcoutput` or `mcmcoutputperm` object containing all sampled +#' values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Histograms of the MCMC samples. +#' @name plotHist +#' @rdname plotHist-method +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotHist(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters +#' * [mcmcoutput-class] for the class definition of `mcmcoutput` +#' * [mcmcoutputperm-class] for the class definition of `mcmcoutputperm` +NULL + +#' @title Plot densities of the parameters and weights +#' +#' @description +#' #' `plotDens()` is a class method for [mcmcoutput][mcmcoutput-class] and +#' [mcmcoutputperm][mcmcoutputperm-class] objects. For the former class it +#' plots densities of MCMC samples and for the latter of the corresponding +#' permuted samples coming from relabeling. +#' +#' @details +#' Calling [plotDens()] plots densities of the sampled parameters and weights +#' from MCMC sampling. Note, for relabeled MCMC samples this method is so far +#' only implemented for mixtures of Poisson and Binomial distributions. +#' +#' ## Hierarchical priors +#' In case that hierarchical priors had been used in MCMC sampling densities +#' of the sampled parameters of the hierarchical prior are added to the plot. +#' +#' ## Posterior density parameters +#' In case that posterior density parameters had been stored in MCMC sampling, +#' densities of these parameters are added to the plot. +#' +#' @param x An `mcmcoutput` or `mcmcoutputperm` object containing all sampled +#' values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return Densities of the MCMC samples. +#' @name plotDens +#' @rdname plotDens-method +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotDens(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPointProc()] for plotting point processes for sampled values +#' * [plotPostDens()] for plotting the posterior density of component parameters +#' * [mcmcoutput-class] for the class definition of `mcmcoutput` +#' * [mcmcoutputperm-class] for the class definition of `mcmcoutputperm` +NULL + +#' Plot the point process of the component parameters +#' +#' @description +#' Calling [plotPointProc()] on an object of class `mcmcoutput` or +#' `mcmcoutputperm` plots the point process of the sampled component parameters +#' from MCMC sampling, either the original parameters or the relabeled ones. +#' +#' @details +#' The point process is used to identify the number of components in the +#' underlying distribution of the data for mixtures with unknown number of +#' components (see Frühwirth-Schnatter (2006, Subsection 3.7.1)). The number of +#' clusters that evolve in the plot give a hint on the true number of +#' components in the mixture distribution. The MCMC draws will scatter around +#' the points corresponding to the true point process of the mixture model. The +#' spread of the clusters represent the uncertainty of estimating the points. +#' +#' For mixtures with univariate component parameters (e.g. Poisson, +#' Exponential) the component parameters are plotted against draws from a +#' standard normal distribution. For mixtures with bivariate component +#' parameters (e.g. Normal) the first parameters are plotted against the +#' second ones. For mixtures with multivariate component parameters a point +#' process for each type of mixture model is plotted. +#' +#' Note that this method for `mcmcoutputperm` objects is only implemented for +#' mixtures of Poisson and Binomial distributions. +#' +#' @param x An `mcmcoutput` or `mcmcoutputperm` object containing all sampled +#' values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return The point process of the MCMC samples. +#' @rdname plotPointProc-method +#' @name plotPointProc +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' f_outputperm <- mcmcpermute(f_output) +#' plotPointProc(f_outputperm) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotSampRep()] for plotting sampling representations of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values +NULL \ No newline at end of file diff --git a/R/mcmcoutputpermpost.R b/R/mcmcoutputpermpost.R index 41059f9..53265c1 100644 --- a/R/mcmcoutputpermpost.R +++ b/R/mcmcoutputpermpost.R @@ -32,7 +32,6 @@ #' Note that this class inherits all of its slots from the parent classes. #' #' @exportClass mcmcoutputpermpost -#' @describeIn mcmcoutputpermpost-class #' @keywords internal #' @seealso #' * [mcmcoutputbase-class] for the parent class diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index bd0ba54..6bb1b36 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -20,7 +20,7 @@ #' @description #' This class inherits from the `mcmcoutputbase` class and adds posterior #' density parameters to the MCMC sampling output. The storage of posterior -#' parameters is controlled by the slot `storepost` in the [mcmc][mcmc_class] +#' parameters is controlled by the slot `storepost` in the [mcmc-class] #' class. If set to `TRUE` posterior parameters are stored in the output of the #' MCMC sampling. #' @@ -53,7 +53,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutput_class Shows a short summary of the object's slots +#' @noRd setMethod( "show", "mcmcoutputpost", function(object) { @@ -368,7 +368,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutput_class +#' @noRd #' #' @examples #' \dontrun{ diff --git a/R/mcmcpermfix.R b/R/mcmcpermfix.R index 6011e39..b21a722 100644 --- a/R/mcmcpermfix.R +++ b/R/mcmcpermfix.R @@ -34,14 +34,14 @@ #' @slot Mperm An integer storing the MCMC sample size after relabeling. #' @slot parperm A named list containing the permuted component parameters. #' @slot logperm A named list containing the mixture log-likelihood, the prior -#' log-likelihood, and the complete data posterior log-likelihood. +#' log-likelihood, and the complete data posterior log-likelihood. #' @exportClass mcmcpermfix #' @family mcmcperm-classes #' @rdname mcmcpermfix-class #' #' @seealso -#' * \code{\link{mcmcpermute}} for the calling function -#' * \code{\link{mcmcpermind}} for the corresponding class for models with +#' * [mcmcpermute()] for the calling function +#' * [mcmcpermind-class] for the corresponding class for models with #' unknown indicators .mcmcpermfix <- setClass("mcmcpermfix", representation( @@ -75,8 +75,8 @@ #' \dontrun{getMperm(mcmcperm)} #' #' @seealso -#' * \code{\link{mcmcoutputpermfix_class}} for the inheriting class -#' * \code{\link{mcmcpermute}} for function permuting MCMC samples +#' * [mcmcoutputpermfix-class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getMperm", "mcmcpermfix", function(object) { @@ -96,7 +96,7 @@ setMethod( #' \dontrun{getParperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermfix][mcmcoutput_class] for the inheriting class +#' * [mcmcoutput-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getParperm", "mcmcpermfix", @@ -117,7 +117,7 @@ setMethod( #' \dontrun{getLogperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermfix][mcmcoutput_class] for the inheriting class +#' * [mcmcoutput-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getLogperm", "mcmcpermfix", diff --git a/R/mcmcpermfixhier.R b/R/mcmcpermfixhier.R index bae9161..011eb91 100644 --- a/R/mcmcpermfixhier.R +++ b/R/mcmcpermfixhier.R @@ -60,19 +60,16 @@ #' #' @param object An `mcmcpermfixhier` object. #' @returns The `hyperperm` slot of the `object`. -#' @docType methods -#' @rdname mcmcpermfixhier-methods -#' @aliases mcmcpermfixhierpost_class, mcmcoutputpermfixhier_class, -#' mcmcpermoutputpermfixhierpost_class +#' @noRd #' #' @examples #' \dontrun{getHyperpem(mcmcperm)} #' #' @seealso -#' * \code{\link{mcmcoutputpermfix-class}} for the inheriting class -#' * \code{\link{mcmcpermute}} for function permuting MCMC samples +#' * [mcmcpermfixhier-class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( - "getHyperperm", "mcmcpermfixpost", + "getHyperperm", "mcmcpermfixhier", function(object) { return(object@hyperperm) } diff --git a/R/mcmcpermfixpost.R b/R/mcmcpermfixpost.R index a80402b..2bd4f3e 100644 --- a/R/mcmcpermfixpost.R +++ b/R/mcmcpermfixpost.R @@ -65,7 +65,7 @@ #' \dontrun{getMperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermfix][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermfix-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getPostperm", "mcmcpermfixpost", diff --git a/R/mcmcpermind.R b/R/mcmcpermind.R index f93be8b..a807fa1 100644 --- a/R/mcmcpermind.R +++ b/R/mcmcpermind.R @@ -91,7 +91,7 @@ #' \dontrun{getRelabel(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermbase-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getRelabel", "mcmcpermind", @@ -112,7 +112,7 @@ setMethod( #' \dontrun{getWeightperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermbase-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getWeightperm", "mcmcpermind", @@ -133,7 +133,7 @@ setMethod( #' \dontrun{getEntropyperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermbase-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getEntropyperm", "mcmcpermind", @@ -154,7 +154,7 @@ setMethod( #' \dontrun{getSTperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermbase-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getSTperm", "mcmcpermind", @@ -175,7 +175,7 @@ setMethod( #' \dontrun{getSperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermbase-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getSperm", "mcmcpermind", @@ -196,7 +196,7 @@ setMethod( #' \dontrun{getNKperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermbase][mcmcoutput_class] for the inheriting class +#' * [mcmcoutputpermbase-class] for the inheriting class #' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getNKperm", "mcmcpermind", diff --git a/R/mcmcpermindpost.R b/R/mcmcpermindpost.R index ab710b7..00b9dc9 100644 --- a/R/mcmcpermindpost.R +++ b/R/mcmcpermindpost.R @@ -62,8 +62,8 @@ #' \dontrun{getMperm(mcmcperm)} #' #' @seealso -#' * [mcmcoutputpermpost][mcmcoutput_class] for the inheriting class -#' * [mcmcoutputpermhierpost][mcmcoutput_class] for the inheriting class with +#' * [mcmcoutputpermpost-class] for the inheriting class +#' * [mcmcoutputpermhierpost-class] for the inheriting class with #' hierarchical prior #' * [mcmcpermute()] for function permuting MCMC samples setMethod( diff --git a/R/mcmcpermute.R b/R/mcmcpermute.R index a58b9e3..309c7ab 100644 --- a/R/mcmcpermute.R +++ b/R/mcmcpermute.R @@ -20,11 +20,55 @@ #' Permute MCMC samples #' #' @description -#' This function +#' Calling `mcmcpermute()` on an `mcmcoutput` object relabels the MCMC samples +#' by using a relabeling algorithm. `"kmeans"` is the standard relabeling +#' algorithm used. For mixtures of Poisson and Binomial distributions there are +#' also the relabeling algorithms `"Stephens1997a"` of Stephens (1997a) and +#' `"Stephens1997b"` of Stephens (1997b) available. For Exponential mixture +#' models only the alternative `"Stephens1997b"` is available. Note that the +#' argument `opt_ctrl` is a relict from older versions and deprecated. In +#' future versions this argument will be removed from the R function. +#' +#' @details +#' Relabeling of the MCMC samples is performed to assign each MCMC draw to its +#' "right" component as in MCMC sampling the components are from time to time +#' permuted or, if random permutation sampling was used, samples were +#' intentionally permuted. This results ususally in multimodal posterior +#' distributions. To reassign each draw to its potentially correct +#' component, a relabeling algorithm is used (see Frühwirth-Schnatter (2006) +#' as well as Stephens (1997a) and Stephens (1997b)). +#' +#' Relabeling is performed on the point process of the component parameters +#' and parameter pairs which are both assigned to the same component get +#' removed from the resulting MCMC sample. Note that this results usually in +#' a reduced number of MCMC samples. the returned object is of class +#' `mcmcoutputperm` and carries the samples and statistics (like +#' log-likelihood values) of the permuted samples. #' #' @export mcmcpermute +#' @rdname mcmcpermute #' @import nloptr -"mcmcpermute" <- function(mcmcout, fdata = NULL, method = "kmeans", opt_ctrl = list(max_iter = 200L)) { +#' +#' @examples +#' # Define a mixture model. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Relabel the MCMC samples. +#' f_outputperm <- mcmcpermute(f_output) +#' f_outputperm +#' +#' @seealso +#' * [mcmcoutputperm-class] for the class definition of the output objects +#' * [mcmcestimate()] for a function that uses relabeling +"mcmcpermute" <- function(mcmcout, fdata = NULL, method = "kmeans", + opt_ctrl = list(max_iter = 200L)) { ## Check arguments ## .check.arg.Mcmcpermute(mcmcout) match.arg(method, c("kmeans", "Stephens1997a", "Stephens1997b")) diff --git a/R/mcmcstart.R b/R/mcmcstart.R index 36f7b12..d13d47e 100644 --- a/R/mcmcstart.R +++ b/R/mcmcstart.R @@ -48,9 +48,9 @@ #' (f_data ~ f_model ~ f_mcmc) %=% mcmcstart(f_data, f_model) #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling "mcmcstart" <- function(fdata, model, varargin) { ## Check arguments @@ -122,9 +122,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".check.fdata.model.Mcmcstart" <- function(fdata.obj, model.obj) { .valid.Fdata(fdata.obj) @@ -161,9 +161,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".check.mcmc.Mcmcstart" <- function(mcmc.obj) { if (class(mcmc.obj) != "mcmc") { @@ -192,9 +192,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".parameters.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { K <- model.obj@K @@ -236,9 +236,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".mcmcstart.Exp" <- function(data.obj) { r <- data.obj@r @@ -293,9 +293,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".parameters.multinomial.Mcmcstart" <- function(model.obj) { K <- model.obj@K @@ -317,9 +317,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".parameters.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { K <- model.obj@K datam <- getColY(fdata.obj) @@ -355,9 +355,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".parameters.exponential.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { if (!hasPar(model.obj)) { @@ -385,9 +385,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".parameters.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { if (!hasPar(model.obj) && hasT(fdata.obj, verbose = TRUE)) { datam <- getColY(fdata.obj) @@ -418,9 +418,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".parameters.Norstud.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { datam <- getColY(fdata.obj) @@ -472,9 +472,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".parameters.Norstudmult.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { K <- model.obj@K @@ -532,9 +532,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".mcmcstart.Student.Df" <- function(model.obj) { K <- model.obj@K has.par <- (length(model.obj@par) > 0) @@ -564,9 +564,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".indicators.Mcmcstart" <- function(fdata.obj, model.obj) { dist <- model.obj@dist if (dist %in% c("poisson", "cond.poisson", "exponential")) { @@ -598,9 +598,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".indicators.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { K <- model.obj@K if (!hasS(fdata.obj)) { @@ -630,9 +630,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".indicators.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { if (!hasS(fdata.obj)) { K <- model.obj@K @@ -679,9 +679,9 @@ #' @keywords internal #' #' @seealso -#' * [fdata][fdata_class] for the definition of the `fdata` class +#' * [fdata-class] for the definition of the `fdata` class #' * [model][model_class] for the definition of the `model` class -#' * [mcmc][mcmc_class] for the definition of the `mcmc` class +#' * [mcmc-class] for the definition of the `mcmc` class ".mcmcstart.Ind.Norstud" <- function(data.obj, model.obj) { K <- model.obj@K # Checks, if slot 'S' ist in 'data.obj'. If not, throws an error diff --git a/R/mixturemcmc.R b/R/mixturemcmc.R index a88515c..95191df 100644 --- a/R/mixturemcmc.R +++ b/R/mixturemcmc.R @@ -76,7 +76,7 @@ #' @param mcmc An `mcmc` object storing the hyper-parameters for MCMC sampling. #' If slot `@@startpar` is `TRUE` sampling starts by sampling the parameters. #' Henceforth, it needs starting indicators. -#' @return An object of class [mcmcoutput][mcmcoutput_class] storing the MCMC +#' @return An object of class [mcmcoutput-class] storing the MCMC #' sampling results. #' @export #' @@ -97,12 +97,12 @@ #' getPar(f_output) #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition #' * [prior][prior-class] for the `prior` class definition #' * [prior()] for the `prior` class constructor #' * [priordefine()] for the advanced class constructor of the `prior` class -#' * [mcmc][mcmc_class] for the `mcmc` class definition +#' * [mcmc-class] for the `mcmc` class definition #' * [mcmc()] for the `mcmc` class constructor #' * [mcmcstart()] for defining starting parameters and/or indicators #' @@ -169,7 +169,7 @@ #' @param n.args An integer specifying how many arguments have been provided #' by the user. As all arguments must be provided values below four throw an #' error. -#' @return An object of class [mcmc][mcmc_class]. If any check does not pass an +#' @return An object of class [mcmc-class]. If any check does not pass an #' error is thrown to let the user know, why MCMC sampling cannot be #' performed with the actual setting. #' @noRd @@ -318,7 +318,7 @@ #' @noRd #' #' @seealso -#' * [fdata][fdata_class] for the `fdata` class definition +#' * [fdata-class] for the `fdata` class definition #' * [model][model_class] for the `model` class definition ".valid.Reps.Binomial" <- function(data, model) { has.reps <- !all(is.na(data@T)) @@ -419,7 +419,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -645,7 +645,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -765,7 +765,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -870,7 +870,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -1105,7 +1105,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -1335,7 +1335,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -1567,7 +1567,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' @@ -1813,7 +1813,7 @@ #' @param prior.obj A `prior` object specifying the prior distribution. #' @param mcmc.obj An `mcmc` object cotnaining the hyper-parameters for MCMC #' sampling. -#' @param An object of class [mcmcoutput][mcmcoutput_class] containing the +#' @param An object of class [mcmcoutput-class] containing the #' results of MCMC sampling. #' @noRd #' diff --git a/R/model.R b/R/model.R index 2fce96e..54a4e88 100644 --- a/R/model.R +++ b/R/model.R @@ -37,8 +37,12 @@ #' therefore fixed. #' @slot T A matrix containing the repetitions in case of a \code{"binomial"} or #' \code{"poisson"} model. -#' @noRd #' @exportClass model +#' @rdname model-class +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling with a mixture model +#' * [modelmoments()] for compute theoretical moments of a finite mixture model .model <- setClass("model", representation( dist = "character", diff --git a/R/modelmoments.R b/R/modelmoments.R index 0637cc7..c4bb83c 100644 --- a/R/modelmoments.R +++ b/R/modelmoments.R @@ -25,10 +25,9 @@ #' distributions covariance matrices. #' @slot model The corresponding `model` object. #' @exportClass modelmoments -#' -#' @name modelmoments_class +#' @rdname modelmoments-class #' @seealso -#' * [modelmoments()] the constructor of the `modelmoments` class +#' * [modelmoments()] for the constructor of the `modelmoments` class setClass("modelmoments", representation( mean = "vector", @@ -64,7 +63,7 @@ setClass("modelmoments", #' modelmoments(f_model) #' #' @seealso -#' * [modelmoments_class] for all slots of the `modelmoments` class +#' * [modelmoments-class] for all slots of the `modelmoments` class "modelmoments" <- function(model) { dist <- model@dist if (dist == "normult") { @@ -92,7 +91,7 @@ setClass("modelmoments", #' @param object A `modelmoments` object. #' @returns The `mean` slot of the `object`. #' @exportMethod getMean -#' @describeIn modelmoments_class +#' @noRd #' #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), @@ -100,7 +99,7 @@ setClass("modelmoments", #' f_moments <- modelmoments(f_model) #' getMean(f_moments) #' -#' @seealso [modelmoments_class] for all slots of the `modelmoments` class +#' @seealso [modelmoments-class] for all slots of the `modelmoments` class setMethod( "getMean", "modelmoments", function(object) { @@ -115,15 +114,14 @@ setMethod( #' @param object A `modelmoments` object. #' @returns The `var` slot of the `object`. #' @exportMethod getVar -#' @describeIn modelmoments_class -#' +#' @noRd #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getVar(f_moments) #' -#' @seealso [modelmoments_class] for all slots of the `modelmoments` class +#' @seealso [modelmoments-class] for all slots of the `modelmoments` class setMethod( "getVar", "modelmoments", function(object) { @@ -138,7 +136,7 @@ setMethod( #' @param object A `modelmoments` object. #' @returns The `model` slot of the `object`. #' @exportMethod getModel -#' @describeIn modelmoments_class +#' @noRd #' #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), @@ -146,7 +144,7 @@ setMethod( #' f_moments <- modelmoments(f_model) #' getModel(f_moments) #' -#' @seealso [modelmoments_class] for all slots of the `modelmoments` class +#' @seealso [modelmoments-class] for all slots of the `modelmoments` class setMethod( "getModel", "modelmoments", function(object) { diff --git a/R/normalmodelmoments.R b/R/normalmodelmoments.R index b3ec38a..8df1c4c 100644 --- a/R/normalmodelmoments.R +++ b/R/normalmodelmoments.R @@ -25,10 +25,10 @@ #' @slot W A numeric defining the within-group heterogeneity. #' @slot R A numeric defining the coefficient of determination. #' @exportClass normalmodelmoments -#' @name normalmodelmoments -#' +#' @rdname normalmodelmoments +#' @keywords internal #' @seealso -#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes .normalmodelmoments <- setClass("normalmodelmoments", representation( @@ -78,7 +78,7 @@ setMethod( #' Generate moments for normal mixture #' #' @description -#' Implicit method. Calling [generateMoments()] generates the moments of an +#' Implicit method. Calling `generateMoments()` generates the moments of an #' normal mixture distribution. #' #' @param object An `normalmodelmoments` object. @@ -99,7 +99,10 @@ setMethod( #' @param object An `normalmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @describeIn normalmodelmoments +#' @noRd +#' @seealso +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes setMethod( "show", "normalmodelmoments", function(object) { diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index 09076d3..e71ef7c 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -28,7 +28,7 @@ #' @name normultmodelmoments #' #' @seealso -#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes .normultmodelmoments <- setClass("normultmodelmoments", representation( @@ -102,7 +102,10 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @describeIn normultmodelmoments +#' @noRd +#' @seealso +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes setMethod( "show", "normultmodelmoments", function(object) { @@ -158,7 +161,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @returns The `B` slot of the `object`. -#' @describeIn datamoments_class Getter method for slot `B` +#' @noRd #' #' @examples #' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) diff --git a/R/poissonmodelmoments.R b/R/poissonmodelmoments.R index 66271f3..8060791 100644 --- a/R/poissonmodelmoments.R +++ b/R/poissonmodelmoments.R @@ -25,10 +25,11 @@ #' @slot W A numeric defining the within-group heterogeneity. #' @slot R A numeric defining the coefficient of determination. #' @exportClass poissonmodelmoments -#' @name poissonmodelmoments +#' @rdname poissonmodelmoments-class +#' @keywords internal #' #' @seealso -#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes .poissonmodelmoments <- setClass("poissonmodelmoments", contains = c("dmodelmoments"), @@ -88,7 +89,10 @@ setMethod( #' @param object An `poissonmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @describeIn poissonmodelmoments +#' @noRd +#' @seealso +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes setMethod( "show", "poissonmodelmoments", function(object) { diff --git a/R/prior.R b/R/prior.R index 7613069..960698e 100644 --- a/R/prior.R +++ b/R/prior.R @@ -35,11 +35,11 @@ #' Hierarchical prior are often more robust, but need an additional layer in #' sampling, so computing costs increase. #' @exportClass prior -#' @name prior-class +#' @rdname prior-class #' #' @seealso -#' * \code{\link{prior}} for the general constructor of this class -#' * \code{\link{priordefine}} for the advanced constructor of this class +#' * [prior()] for the general constructor of this class +#' * [priordefine()] for the advanced constructor of this class #' #' @references #' * Frühwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" @@ -264,7 +264,7 @@ setMethod( #' Generates `prior` object #' #' @description -#' Calling [generatePrior()] generates the `prior` object when [priordefine()] +#' Calling `generatePrior()` generates the `prior` object when [priordefine()] #' had been called. When this function is called all checks have been passed #' and `prior` construction can take place. #' @@ -277,11 +277,12 @@ setMethod( #' @param prior.wagner A logical indicating, if the prior from Wagner (2007) #' should be used in case of an exponential mixture model. #' @param s A numeric specifying the standard deviation `s` for the -#' Metropolis-Hastings proposal. +#' Metropolis-Hastings proposal. +#' @rdname generatePrior #' @keywords internal #' #' @seealso -#' * [prior][prior-class] for the class definition +#' * [prior-class] for the class definition #' * [priordefine()] for the advanced class constructor using this method setMethod( "generatePrior", "prior", @@ -331,7 +332,11 @@ setMethod( #' @param object A `prior` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @describeIn prior-class +#' @noRd +#' @seealso +#' * [prior-class] for the class definition +#' * [prior()] for the basic constructor of the class +#' * [priordefine()] for the advanced constructor of the class setMethod( "show", "prior", function(object) { diff --git a/R/sdatamoments.R b/R/sdatamoments.R index 94bedff..34f3b1e 100644 --- a/R/sdatamoments.R +++ b/R/sdatamoments.R @@ -19,18 +19,18 @@ #' #' Stores moments for indicators of discrete data. #' -#' @slot gmoments A [groupmoments][groupmoments_class] object storing the +#' @slot gmoments A [groupmoments-class] object storing the #' moments for each mixture component. -#' @slot fdata An [fdata][fdata_class] object with data from a discrete valued +#' @slot fdata An [fdata-class] object with data from a discrete valued #' mixture distribution. #' @exportClass sdatamoments -#' @name sdatamoments_class +#' @rdname sdatamoments-class #' @seealso -#' * [datamoments][datamoments_class] for the base class for data moments +#' * [datamoments-class] for the base class for data moments #' * [datamoments()] for the constructor of any object of the `datamoments` #' class family -#' * [groupmoments][groupmoments_class] for the parent class -#' * [csdatamoments][csdatamoments_class] for the corresponding class defining +#' * [groupmoments-class] for the parent class +#' * [csdatamoments-class] for the corresponding class defining #' moments for data from a continuous-valued finite mixture .sdatamoments <- setClass("sdatamoments", representation( @@ -61,7 +61,7 @@ setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) #' this slot is `"discrete"` an `sdatamoments` object is returned and if the #' slot is `"continuous"`, a `csdatamoments` object is returned. #' -#' @param value An [fdata][fdata_class] object containing the indicators for +#' @param value An [fdata-class] object containing the indicators for #' which moments should be calculated. #' @return If slot `type` of the argument `value` is `"discrete"` an #' `sdatamoments` object is returned and if the slot is `"continuous"`, @@ -78,11 +78,11 @@ setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) #' sdatamoments(f_data) #' #' @seealso -#' * [sdatamoments][sdatamoments_class] for the class of indicator +#' * [sdatamoments-class] for the class of indicator #' moments for discrete data -#' * [csdatamoments][csdatamoments_class] for the class of indicator moments +#' * [csdatamoments-class] for the class of indicator moments #' for continuous -#' * [groupmoments][groupmoments_class] for the parent class## Copyright (C) 2013 Lars Simon Zehnder +#' * [groupmoments-class] for the parent class## Copyright (C) 2013 Lars Simon Zehnder "sdatamoments" <- function(value = fdata()) { hasY(value, verbose = TRUE) hasS(value, verbose = TRUE) @@ -98,14 +98,14 @@ setClassUnion("sdatamomentsOrNULL", members = c("sdatamoments", "NULL")) #' #' @description #' Only used implicitly. The initializer calls the constructor for a -#' [groupmoments][groupmoments_class] object. to generate in the initialization +#' [groupmoments-class] object. to generate in the initialization #' step the moments for a passed-in `fdata` object. #' #' @param .Object An object: see the "initialize Methods" section in #' [initialize]. #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. -#' @param model A finmix [fdata][fdata_class] object containing the observations. +#' @param model A finmix [fdata-class] object containing the observations. #' @keywords internal #' #' @seealso @@ -166,11 +166,11 @@ setMethod( #' getGmoments(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [sdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [sdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getGmoments", "sdatamoments", function(object) { @@ -197,11 +197,11 @@ setMethod( #' getFdata(f_sdatamoms) #' #' @seealso -#' * [datamoments][datamoments_class] for the base class for model moments -#' * [datamoments()][datamoments] for the constructor of the `datamoments` +#' * [datamoments-class] for the base class for model moments +#' * [datamoments()] for the constructor of the `datamoments` #' class family -#' * [sdatamoments][sdatamoments_class] for the class definition -#' * [sdatamoments()][sdatamoments] for the constructor of the class +#' * [sdatamoments-class] for the class definition +#' * [sdatamoments()] for the constructor of the class setMethod( "getFdata", "sdatamoments", function(object) { diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index 6d77a36..ba5725e 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -99,7 +99,10 @@ setMethod( #' @param object An `studentmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @describeIn studentmodelmoments +#' @noRd +#' @seealso +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes setMethod( "show", "studentmodelmoments", function(object) { diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index ae770cf..86dfac0 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -28,7 +28,7 @@ #' @name studmultmodelmoments #' #' @seealso -#' * [modelmoments_class] for the base class for model moments +#' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes .studmultmodelmoments <- setClass("studmultmodelmoments", representation( diff --git a/man/binomialmodelmoments-class.Rd b/man/binomialmodelmoments-class.Rd index 81ca8a3..c0142e8 100644 --- a/man/binomialmodelmoments-class.Rd +++ b/man/binomialmodelmoments-class.Rd @@ -4,37 +4,19 @@ \name{binomialmodelmoments-class} \alias{binomialmodelmoments-class} \alias{.binomialmodelmoments} -\alias{show,binomialmodelmoments-method} \title{Finmix \code{binomialmodelmoments} class} -\usage{ -\S4method{show}{binomialmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{binomialmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ Defines a class that holds modelmoments for a finite mixture of Binomial distributions. Note that this class is not directly used, but indirectly -when calling the \code{modelmoments} constructor \code{\link{modelmoments}}. +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. This is a class that directly inherits from the \code{dmodelmoments} class. - -Calling \code{\link[=show]{show()}} on an \code{binomialmodelmoments} object gives an overview -of the moments of an binomial finite mixture. } -\section{Methods (by generic)}{ -\itemize{ -\item \code{show}: Shows a summary of an object -}} - \seealso{ \itemize{ -\item \link{modelmoments_class} for the base class for model moments -\item \code{\link{modelmoments}} for the constructor of \code{modelmoments} classes -\item \code{\link{dmodelmoments-class}} class for the parent class +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +\item \linkS4class{dmodelmoments} class for the parent class } } +\keyword{internal} diff --git a/man/cdatamoments_class.Rd b/man/cdatamoments_class.Rd deleted file mode 100644 index 3dc9be8..0000000 --- a/man/cdatamoments_class.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cdatamoments.R -\docType{class} -\name{cdatamoments_class} -\alias{cdatamoments_class} -\alias{.cdatamoments} -\title{Finmix \code{cdatamoments} class} -\description{ -Stores moments of an \link[=fdata_class]{fdata} object containing continuous data. -The \code{fdata} object is stored in the parent \link[=datamoments_class]{datamoments} -class. -} -\section{Slots}{ - -\describe{ -\item{\code{higher}}{An array containing the four higher centralized moments of the -continuous data stored in the \code{fdata} object.} - -\item{\code{skewness}}{A vector storing the skewness of the continuous data in the -corresponding \code{fdata} object.} - -\item{\code{kurtosis}}{A vector storing the kurtosis of the continuous data in the -corresponding \code{fdata} object.} - -\item{\code{corr}}{A matrix containing the correlations between the data dimensions -in case of multivariate data (i.e. slot \code{r} in the \code{fdata} object is -larger than one).} - -\item{\code{smoments}}{A \code{csdatamoments} object, if the \code{fdata} object also holds -indicators. \code{NULL}, if no indicators are present in the \code{fdata} object.} -}} - -\seealso{ -\itemize{ -\item \link[=datamoments_class]{datamoments} for the parent class -\item \link[=ddatamoments_class]{ddatamoments} for the corresponding class for -discrete data -\item \link[=csdatamoments_class]{csdatamoments} for the contained class if indicators -are present in the \code{fdata} object -} -} diff --git a/man/csdatamoments-class.Rd b/man/csdatamoments-class.Rd index 3cedd04..bbed271 100644 --- a/man/csdatamoments-class.Rd +++ b/man/csdatamoments-class.Rd @@ -1,8 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/csdatamoments.R -\name{show,csdatamoments-method} +\docType{class} +\name{csdatamoments-class} +\alias{csdatamoments-class} +\alias{.csdatamoments} \alias{show,csdatamoments-method} -\title{Shows a summary of an \code{csdatamoments} object.} +\title{Finmix \code{csdatamoments} class} \usage{ \S4method{show}{csdatamoments}(object) } @@ -14,6 +17,9 @@ A console output listing the slots and summary information about each of them. } \description{ +Stores moments for indicators of continuous data. Inherited directly from +the \linkS4class{sdatamoments} class. + Calling \code{\link[=show]{show()}} on an \code{csdatamoments} object gives an overview of the moments of a finite mixture with continuous data. } @@ -22,3 +28,32 @@ of the moments of a finite mixture with continuous data. \item \code{show,csdatamoments-method}: Shows a short summary of the object's slots. }} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A vector storing the between-group heterogeneity.} + +\item{\code{W}}{A vector storing the within-group heterogeneity.} + +\item{\code{T}}{A vector storing the total variance.} + +\item{\code{R}}{A numeric storing the coefficient of determination for univariate +data.} + +\item{\code{Rdet}}{A numeric storing the coefficient of determination using the +trace for multivariate data.} + +\item{\code{Rtr}}{A numeric storing the coefficient of determination using the +determinants for multivariate data.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the corresponding class defining +moments for data from a discrete-valued finite mixture +} +} +\keyword{internal} diff --git a/man/csdatamoments_class.Rd b/man/csdatamoments_class.Rd deleted file mode 100644 index 75aff5f..0000000 --- a/man/csdatamoments_class.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/csdatamoments.R -\docType{class} -\name{csdatamoments_class} -\alias{csdatamoments_class} -\alias{.csdatamoments} -\title{Finmix \code{csdatamoments} class} -\description{ -Stores moments for indicators of continuous data. Inherited directly from -the \link[=sdatamoments_class]{sdatamoments} class. -} -\section{Slots}{ - -\describe{ -\item{\code{B}}{A vector storing the between-group heterogeneity.} - -\item{\code{W}}{A vector storing the within-group heterogeneity.} - -\item{\code{T}}{A vector storing the total variance.} - -\item{\code{R}}{A numeric storing the coefficient of determination for univariate -data.} - -\item{\code{Rdet}}{A numeric storing the coefficient of determination using the -trace for multivariate data.} - -\item{\code{Rtr}}{A numeric storing the coefficient of determination using the -determinants for multivariate data.} -}} - -\seealso{ -\itemize{ -\item \link[=datamoments_class]{datamoments} for the base class for data moments -\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} -class family -\item \link[=csdatamoments_class]{sdatamoments} for the corresponding class defining -moments for data from a discrete-valued finite mixture -} -} diff --git a/man/dataclass.Rd b/man/dataclass.Rd index 497050a..b66ea4c 100644 --- a/man/dataclass.Rd +++ b/man/dataclass.Rd @@ -28,7 +28,7 @@ indicators in slot \verb{@S} of the corresponding \code{fdata} object. } \seealso{ \itemize{ -\item \link[=dataclass_class]{dataclass} for the class definition +\item \linkS4class{dataclass} for the class definition } #' @references diff --git a/man/dataclass_class.Rd b/man/dataclass_class.Rd deleted file mode 100644 index 789520c..0000000 --- a/man/dataclass_class.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dataclass.R -\docType{class} -\name{dataclass_class} -\alias{dataclass_class} -\alias{.dataclass} -\title{Finmix \code{dataclass} class} -\description{ -Stores objects to classify observations using a fully specified mixture -model. If the indicators a finite mixture model is fully specified as then -the likelihood can be calculated for each observation depending on the -component it stems from. -} -\section{Slots}{ - -\describe{ -\item{\code{logpy}}{An array containing the logarithmized} - -\item{\code{prob}}{An array storing the probability classification matrix that -defines for each observation the probability of belonging to component -\code{k}. Henceforth, each row sums to one. The dimension of this array is -\verb{N x K}.} - -\item{\code{mixlik}}{A numeric storing the logarithm of the mixture likelihood -evaluated at certain parameters \code{par} from a finmix \code{model} object and -corresponding \code{weights}.} - -\item{\code{entropy}}{A numeric storing the entropy of the classification.} - -\item{\code{loglikcd}}{An array storing the logarithm of the conditional likelihood -of each component parameter, if indicators have not been simulated. The -array has dimension \verb{1 x K}.} - -\item{\code{postS}}{A numeric storing the posterior probability of the indicators -\code{S} in the data, if indicators have been simulated.} -}} - -\references{ -Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" -} -\seealso{ -\itemize{ -\item \link[=fdata_class]{fdata} for the class holding the data -\item \link[=model_class]{model} for the class defining a finite mixture model -\item \code{\link[=dataclass]{dataclass()}} for the constructor of this class -} -} diff --git a/man/datamoments.Rd b/man/datamoments.Rd index 1eedc77..73dad10 100644 --- a/man/datamoments.Rd +++ b/man/datamoments.Rd @@ -29,8 +29,8 @@ datamoments(f_data) } \seealso{ \itemize{ -\item \link{datamoments} class for all slots of this class -\item \link{cdatamoments} for the class for continuous data -\item \link{ddatamoments} for the class for discrete data +\item \linkS4class{datamoments} for all slots of this class +\item \linkS4class{cdatamoments} for the class for continuous data +\item \linkS4class{ddatamoments} for the class for discrete data } } diff --git a/man/datamoments_class.Rd b/man/datamoments_class.Rd deleted file mode 100644 index 26b22fb..0000000 --- a/man/datamoments_class.Rd +++ /dev/null @@ -1,87 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/normultmodelmoments.R, R/csdatamoments.R, -% R/datamoments.R -\docType{class} -\name{getB,normultmodelmoments-method} -\alias{getB,normultmodelmoments-method} -\alias{getB,csdatamoments-method} -\alias{datamoments_class} -\alias{.datamoments} -\title{Getter method of \code{normultmodelmoments} class.} -\usage{ -\S4method{getB}{normultmodelmoments}(object) - -\S4method{getB}{csdatamoments}(object) -} -\arguments{ -\item{object}{An \code{csdatamoments} object.} -} -\value{ -The \code{B} slot of the \code{object}. - -The \code{B} slot of the \code{object}. -} -\description{ -Returns the \code{B} slot. - -Returns the \code{B} slot. - -Stores moments of a corresponding \code{fdata} object. -} -\section{Functions}{ -\itemize{ -\item \code{getB,normultmodelmoments-method}: Getter method for slot \code{B} - -\item \code{getB,csdatamoments-method}: -}} - -\section{Slots}{ - -\describe{ -\item{\code{mean}}{A numeric storing the mean of the slot \code{y} in the \code{fdata} object.} - -\item{\code{var}}{A matrix storing the variance(s and covariances) of the \code{y} slot -in the \code{fdata} object.} - -\item{\code{VIRTUAL}}{Virtual class containing further data moments.} -}} - -\examples{ -f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) -means <- matrix(c(-2, -2, 2, 2),nrow = 2) -covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) -sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) -setPar(f_model) <- list(mu = means, sigma = sigmas) -f_moments <- modelmoments(f_model) -getB(f_moments) - -# Generate an exponential mixture model with two components. -f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) -# Simulate data from the model. -f_data <- simulate(f_model) -# Calculate the mixture moments. -f_sdatamoms <- sdatamoments(f_data) -# Get the moments for the included indicators of the data. -getB(f_sdatamoms) - -} -\seealso{ -\itemize{ -\item \link{modelmoments} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family -} - -\itemize{ -\item \link[=datamoments_class]{datamoments} for the base class for model moments -\item \link[=datamoments]{datamoments()} for the constructor of the \code{datamoments} -class family -\item \link[=sdatamoments_class]{csdatamoments} for the class definition -\item \link[=sdatamoments]{sdatamoments()} for the constructor of the class -} - -\itemize{ -\item \link{cdatamoments} for data moments of continuous data -\item \link{ddatamoments} for data moments of discrete data -\item \link{sdatamoments} for data moments of the indicators -} -} diff --git a/man/ddatamoments_class.Rd b/man/ddatamoments_class.Rd deleted file mode 100644 index 14e8bf2..0000000 --- a/man/ddatamoments_class.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ddatamoments.R -\docType{class} -\name{ddatamoments_class} -\alias{ddatamoments_class} -\alias{.ddatamoments} -\title{Finmix \code{ddatamoments} class} -\description{ -Stores moments of an \link[=fdata_class]{fdata} object containing discrete data. -The \code{fdata} object is stored in the parent \link[=datamoments_class]{datamoments} -class. -} -\section{Slots}{ - -\describe{ -\item{\code{factorial}}{An array containing the first four factorial moments of the -discrete data stored in the \code{fdata} object.} - -\item{\code{over}}{A vector storing the overdispersion of the discrete data in the -corresponding \code{fdata} object.} - -\item{\code{zero}}{A vector storing the fractions of zeros in the observed data. <} - -\item{\code{smoments}}{An \code{sdatamoments} object, if the \code{fdata} object also holds -indicators. \code{NULL}, if no indicators are present in the \code{fdata} object.} -}} - -\seealso{ -\itemize{ -\item \link[=datamoments_class]{datamoments} for the parent class -\item \link[=ddatamoments_class]{ddatamoments} for the corresponding class for -continuous data -\item \link[=sdatamoments_class]{sdatamoments} for the contained class if indicators -are present in the \code{fdata} object -} -} diff --git a/man/dmodelmoments.Rd b/man/dmodelmoments.Rd deleted file mode 100644 index 2aad5a1..0000000 --- a/man/dmodelmoments.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dmodelmoments.R -\docType{class} -\name{dmodelmoments} -\alias{dmodelmoments} -\alias{.dmodelmoments} -\title{Finmix \code{dmodelmoments} class} -\description{ -This class defines the general theoretical moments of a finite mixture model -with discrete data. -} -\section{Slots}{ - -\describe{ -\item{\code{over}}{A numeric containing the over-dispersion.} - -\item{\code{factorial}}{An array containing the first four factorial moments.} - -\item{\code{zero}}{An numeric cotaining the excess zeros.} -}} - -\seealso{ -\itemize{ -\item \link{modelmoments} for the base class -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of any \code{modelmoments} inherited class -} -} diff --git a/man/exponentialmodelmoments.Rd b/man/exponentialmodelmoments.Rd index 2ed4cde..a7fd36d 100644 --- a/man/exponentialmodelmoments.Rd +++ b/man/exponentialmodelmoments.Rd @@ -22,7 +22,7 @@ when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{mode \seealso{ \itemize{ -\item \link{modelmoments_class} for the base class for model moments +\item \linkS4class{modelmoments} for the base class for model moments \item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes } } diff --git a/man/extract-mcmcoutputfix-numeric-method.Rd b/man/extract-mcmcoutputfix-numeric-method.Rd index a5dc40a..8e73b46 100644 --- a/man/extract-mcmcoutputfix-numeric-method.Rd +++ b/man/extract-mcmcoutputfix-numeric-method.Rd @@ -18,5 +18,5 @@ An object class \code{mcmcextract} containing all samples of an extracted dimension. } \description{ -Extracts samples from \code{mcmcoutput} object of a multivariate Normal mixture +This function extracts samples from a multivariate Normal mixture output. } diff --git a/man/fdata_class.Rd b/man/fdata_class.Rd deleted file mode 100644 index 586684d..0000000 --- a/man/fdata_class.Rd +++ /dev/null @@ -1,586 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fdata.R -\docType{class} -\name{fdata_class} -\alias{fdata_class} -\alias{.fdata} -\alias{plot,fdata,missing-method} -\alias{show,fdata-method} -\alias{hasY,fdata-method} -\alias{hasExp,fdata-method} -\alias{hasT,fdata-method} -\alias{getColY,fdata-method} -\alias{getRowY,fdata-method} -\alias{getColS,fdata-method} -\alias{getRowS,fdata-method} -\alias{getColExp,fdata-method} -\alias{getRowExp,fdata-method} -\alias{getColT,fdata-method} -\alias{getRowT,fdata-method} -\alias{getY,fdata-method} -\alias{getN,fdata-method} -\alias{getR,fdata-method} -\alias{getS,fdata-method} -\alias{getBycolumn,fdata-method} -\alias{getName,fdata-method} -\alias{getType,fdata-method} -\alias{getSim,fdata-method} -\alias{getExp,fdata-method} -\alias{getT,fdata-method} -\alias{setY<-,fdata-method} -\alias{setN<-,fdata-method} -\alias{setR<-,fdata-method} -\alias{setS<-,fdata-method} -\alias{setBycolumn<-,fdata-method} -\alias{setName<-,fdata-method} -\alias{setType<-,fdata-method} -\alias{setSim<-,fdata-method} -\alias{setExp<-,fdata-method} -\alias{setT<-,fdata-method} -\title{Finmix fdata class} -\usage{ -\S4method{plot}{fdata,missing}(x, y, dev = TRUE, ...) - -\S4method{show}{fdata}(object) - -\S4method{hasY}{fdata}(object, verbose = FALSE) - -\S4method{hasExp}{fdata}(object, verbose = FALSE) - -\S4method{hasT}{fdata}(object, verbose = FALSE) - -\S4method{getColY}{fdata}(object) - -\S4method{getRowY}{fdata}(object) - -\S4method{getColS}{fdata}(object) - -\S4method{getRowS}{fdata}(object) - -\S4method{getColExp}{fdata}(object) - -\S4method{getRowExp}{fdata}(object) - -\S4method{getColT}{fdata}(object) - -\S4method{getRowT}{fdata}(object) - -\S4method{getY}{fdata}(object) - -\S4method{getN}{fdata}(object) - -\S4method{getR}{fdata}(object) - -\S4method{getS}{fdata}(object) - -\S4method{getBycolumn}{fdata}(object) - -\S4method{getName}{fdata}(object) - -\S4method{getType}{fdata}(object) - -\S4method{getSim}{fdata}(object) - -\S4method{getExp}{fdata}(object) - -\S4method{getT}{fdata}(object) - -\S4method{setY}{fdata}(object) <- value - -\S4method{setN}{fdata}(object) <- value - -\S4method{setR}{fdata}(object) <- value - -\S4method{setS}{fdata}(object) <- value - -\S4method{setBycolumn}{fdata}(object) <- value - -\S4method{setName}{fdata}(object) <- value - -\S4method{setType}{fdata}(object) <- value - -\S4method{setSim}{fdata}(object) <- value - -\S4method{setExp}{fdata}(object) <- value - -\S4method{setT}{fdata}(object) <- value -} -\arguments{ -\item{x}{An \code{fdata} object. Cannot be empty.} - -\item{y}{Unused.} - -\item{dev}{A logical indicating if the plot should be output via a graphical -device.} - -\item{...}{Further arguments passed to the plotting functions \code{hist} or -\code{barplot}.} - -\item{object}{An \code{fdata} objects, whose slot \code{T} should be set.} - -\item{verbose}{A logical indicating, if the function should print out -messages.} - -\item{value}{A matrix that should be set as \code{T} slot of the \code{fdata} object. -Has to be of type integer.} -} -\value{ -A console output listing the slots and summary information about -each of them. - -Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{y} slot is -empty or filled or a message, if \code{verbose} is \code{TRUE}. - -Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{exp} slot is -empty or filled or a message, if \code{verbose} is \code{TRUE}. - -Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{T} slot is -empty or filled or a message, if \code{verbose} is \code{TRUE}. - -The \code{y} slot of the \code{object} as a column-ordered matrix. - -The \code{y} slot of the \code{object} as a row-ordered matrix. - -The \code{S} slot of the \code{object} as a column-ordered matrix. - -The \code{S} slot of the \code{object} as a row-ordered matrix. - -The \code{exp} slot of the \code{object} as a column-ordered matrix. - -The \code{exp} slot of the \code{object} as a row-ordered matrix. - -The \code{T} slot of the \code{object} as a column-ordered matrix. - -The \code{T} slot of the \code{object} as a row-ordered matrix. - -The \code{y} slot of the \code{object} in the order defined \code{bycolumn}. - -The \code{N} slot of the \code{object}. - -The \code{r} slot of the \code{object}. - -The \code{S} slot of the \code{object} in the order defined \code{bycolumn}. - -The \code{bycolumn} slot of the \code{object}. - -The \code{name} slot of the \code{object}. - -The \code{type} slot of the \code{object}. - -The \code{sim} slot of the \code{object}. - -The \code{exp} slot of the \code{object} in the order defined \code{bycolumn}. - -The \code{T} slot of the \code{object} in the order defined \code{bycolumn}. - -The \code{fdata} object with slot \code{y} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{y}. - -The \code{fdata} object with slot \code{N} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{N}. - -The \code{fdata} object with slot \code{R} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{R}. - -The \code{fdata} object with slot \code{S} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{S}. - -The \code{fdata} object with slot \code{bycolumn} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{bycolumn}. - -The \code{fdata} object with slot \code{name} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{name}. - -The \code{fdata} object with slot \code{type} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{type}. - -The \code{fdata} object with slot \code{sim} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{sim}. - -The \code{fdata} object with slot \code{exp} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{exp}. - -The \code{fdata} object with slot \code{T} set to \code{value} or an error message -if the \code{value} cannot be set as slot \code{T}. -} -\description{ -The \link{fdata} class holds the data for finite mixture distributions. - -\code{\link[=plot]{plot()}} plots the data in an \link{fdata} object by either a histogram in case of -continuous data or a barplot in case of discrete data. - -Calling \code{\link[=show]{show()}} on an \code{fdata} object gives an overview of the different -slots and dimensions. - -\code{\link[=hasY]{hasY()}} checks, if the object contains \code{y} data. - -\code{\link[=hasY]{hasY()}} checks, if the object contains \code{exp} data. - -\code{\link[=hasY]{hasY()}} checks, if the object contains \code{T} data. - -Returns the \code{y} slot as a column-ordered matrix. - -Returns the \code{y} slot as a row-ordered matrix. - -Returns the \code{S} slot as a column-ordered matrix. - -Returns the \code{S} slot as a row-ordered matrix. - -Returns the \code{exp} slot as a column-ordered matrix. - -Returns the \code{exp} slot as a row-ordered matrix. - -Returns the \code{T} slot as a column-ordered matrix. - -Returns the \code{T} slot as a row-ordered matrix. - -Returns the \code{y} slot in the order defined by the slot \code{bycolumn}. - -Returns the \code{N} slot of an \code{fdata} object. - -Returns the \code{r} slot of an \code{fdata} object. - -Returns the \code{S} slot in the order defined by the slot \code{bycolumn}. - -Returns the \code{bycolumn} slot of an \code{fdata} object. - -Returns the \code{name} slot of an \code{fdata} object. - -Returns the \code{type} slot of an \code{fdata} object. - -Returns the \code{sim} slot of an \code{fdata} object. - -Returns the \code{exp} slot in the order defined by the slot \code{bycolumn}. - -Returns the \code{T} slot in the order defined by the slot \code{bycolumn}. - -Sets the slot \code{y} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{N} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{R} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{S} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{bycolumn} of an \code{fdata} object and validates the slot data -before setting. - -Sets the slot \code{name} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{type} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{sim} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{exp} of an \code{fdata} object and validates the slot data before -setting. - -Sets the slot \code{T} of an \code{fdata} object and validates the slot data before -setting. -} -\section{Functions}{ -\itemize{ -\item \code{plot,fdata,missing-method}: - -\item \code{show,fdata-method}: - -\item \code{hasY,fdata-method}: - -\item \code{hasExp,fdata-method}: - -\item \code{hasT,fdata-method}: - -\item \code{getColY,fdata-method}: - -\item \code{getRowY,fdata-method}: - -\item \code{getColS,fdata-method}: - -\item \code{getRowS,fdata-method}: - -\item \code{getColExp,fdata-method}: - -\item \code{getRowExp,fdata-method}: - -\item \code{getColT,fdata-method}: - -\item \code{getRowT,fdata-method}: - -\item \code{getY,fdata-method}: - -\item \code{getN,fdata-method}: - -\item \code{getR,fdata-method}: - -\item \code{getS,fdata-method}: - -\item \code{getBycolumn,fdata-method}: - -\item \code{getName,fdata-method}: - -\item \code{getType,fdata-method}: - -\item \code{getSim,fdata-method}: - -\item \code{getExp,fdata-method}: - -\item \code{getT,fdata-method}: - -\item \code{setY<-,fdata-method}: - -\item \code{setN<-,fdata-method}: - -\item \code{setR<-,fdata-method}: - -\item \code{setS<-,fdata-method}: - -\item \code{setBycolumn<-,fdata-method}: - -\item \code{setName<-,fdata-method}: - -\item \code{setType<-,fdata-method}: - -\item \code{setSim<-,fdata-method}: - -\item \code{setExp<-,fdata-method}: - -\item \code{setT<-,fdata-method}: -}} - -\section{Slots}{ - -\describe{ -\item{\code{y}}{A matrix containing the observations for finite mixture estimation. -Can be by column or row depending on the slot \code{bycolumn}.} - -\item{\code{N}}{An integer holding the number of observations.} - -\item{\code{r}}{An integer defining the dimension of the data. Only for multivariate -distributions like \code{normult} or \code{studmult} the dimension is -larger one.} - -\item{\code{S}}{A matrix containing the indicators of the data. If the \code{fdata} class -contains indicators estimation is performed with a fixed indicator -approach.} - -\item{\code{bycolumn}}{A logical indicating if the data in \code{y} and \code{S} is sorted by -by column (\code{TRUE}) or row (\code{FALSE}).} - -\item{\code{name}}{A character specifying a name for the data. Optional.} - -\item{\code{type}}{A character specifying the data type: either \code{discrete} for -discrete data or \code{continuous} for continuous data. The two data types are -treated differently when calculating data moments.} - -\item{\code{sim}}{A logical indicating, if the data was simulated.} - -\item{\code{exp}}{A matrix containing the \emph{exposures} of Poisson data.} - -\item{\code{T}}{A matrix containing the (optional) repetitions of binomial or Poisson -data. Must be of type integer.} -}} - -\examples{ -# Generate Poisson data and plot it. -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -plot(f_data) - -# Generate some Poisson data and show the `fdata` object -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -show(f_data) - -# Generate an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -hasY(f_data) - -# Generate an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -hasExp(f_data) - -# Generate an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -hasT(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getColY(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getRowY(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getColS(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getRowS(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getColExp(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getRowExp(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getColT(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getRowT(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getY(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getN(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getR(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getS(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getBycolumn(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getName(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getType(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getSim(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getExp(f_data) - -# Create an fdata object with Poisson data -f_data <- fdata(y = rpois(100, 312), sim = TRUE) -getT(f_data) - -f_data <- fdata() -setY(f_data) <- rpois(100, 312) - -f_data <- fdata() -setN(f_data) <- as.integer(100) - -f_data <- fdata() -setR(f_data) <- as.integer(2) - -# Generate an empty fdata object. -f_data <- fdata() -setS(f_data) <- matrix(sample.int(4, 100, replace = TRUE)) - -# Generate an empty fdata object. -f_data <- fdata() -setBycolumn(f_data) <- TRUE - -# Generate an empty fdata object. -f_data <- fdata() -setName(f_data) <- "poisson_data" - -# Generate an empty fdata object. -f_data <- fdata() -setType(f_data) <- "discrete" - -# Generate an empty fdata object. -f_data <- fdata() -setSim(f_data) <- TRUE - -# Generate an empty fdata object. -f_data <- fdata() -setExp(f_data) <- matrix(rep(100, 100)) - -# Generate an empty fdata object. -f_data <- fdata() -setT(f_data) <- matrix(rep(100, 100)) - -} -\seealso{ -\link{fdata} class - -\link{fdata} class for an overview of the slots - -\link{fdata} class for an overview of its slots - -\link{fdata} class for an overview of its slots - -\link{fdata} class for an overview of its slots - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class - -\link{fdata} for all slots of the \code{fdata} class -} diff --git a/man/generateMoments-normalmodelmoments-method.Rd b/man/generateMoments-normalmodelmoments-method.Rd index 264827d..6173fbe 100644 --- a/man/generateMoments-normalmodelmoments-method.Rd +++ b/man/generateMoments-normalmodelmoments-method.Rd @@ -13,7 +13,7 @@ An \code{normalmodelmoments} object with calculated moments. } \description{ -Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +Implicit method. Calling \code{generateMoments()} generates the moments of an normal mixture distribution. } \keyword{internal} diff --git a/man/generatePrior-prior-method.Rd b/man/generatePrior-prior-method.Rd deleted file mode 100644 index 2c0a734..0000000 --- a/man/generatePrior-prior-method.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/prior.R -\name{generatePrior,prior-method} -\alias{generatePrior,prior-method} -\title{Generates \code{prior} object} -\usage{ -\S4method{generatePrior}{prior}(object, fdata, model, varargin, prior.wagner, s) -} -\arguments{ -\item{object}{A \code{prior} object to store the prior parameters and weights.} - -\item{fdata}{An \code{fdata} object holding the data. Observations in slot \verb{@y} -must be existent.} - -\item{model}{A \code{model} object specifying the finite mixture model.} - -\item{varargin}{\code{NULL} or a \code{prior} object. This enables the user to pass in -an already constructed prior object that gets then completed.} - -\item{prior.wagner}{A logical indicating, if the prior from Wagner (2007) -should be used in case of an exponential mixture model.} - -\item{s}{A numeric specifying the standard deviation \code{s} for the -Metropolis-Hastings proposal.} -} -\description{ -Calling \code{\link[=generatePrior]{generatePrior()}} generates the \code{prior} object when \code{\link[=priordefine]{priordefine()}} -had been called. When this function is called all checks have been passed -and \code{prior} construction can take place. -} -\seealso{ -\itemize{ -\item \link[=prior-class]{prior} for the class definition -\item \code{\link[=priordefine]{priordefine()}} for the advanced class constructor using this method -} -} -\keyword{internal} diff --git a/man/getMperm-mcmcpermfix-method.Rd b/man/getMperm-mcmcpermfix-method.Rd index 1c43dcf..bea434a 100644 --- a/man/getMperm-mcmcpermfix-method.Rd +++ b/man/getMperm-mcmcpermfix-method.Rd @@ -25,7 +25,7 @@ Returns the \code{Mperm} slot. } \seealso{ \itemize{ -\item \code{\link{mcmcoutputpermfix_class}} for the inheriting class -\item \code{\link{mcmcpermute}} for function permuting MCMC samples +\item \linkS4class{mcmcoutputpermfix} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples } } diff --git a/man/groupmoments-class.Rd b/man/groupmoments-class.Rd index 604775b..48a500c 100644 --- a/man/groupmoments-class.Rd +++ b/man/groupmoments-class.Rd @@ -1,8 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/groupmoments.R -\name{show,groupmoments-method} +\docType{class} +\name{groupmoments-class} +\alias{groupmoments-class} +\alias{.groupmoments} \alias{show,groupmoments-method} -\title{Shows a summary of a \code{groupmoments} object.} +\title{Finmix \code{groupmoments} class} \usage{ \S4method{show}{groupmoments}(object) } @@ -14,6 +17,11 @@ A console output listing the slots and summary information about each of them. } \description{ +Stores moments for finite mixture component distributions. These are only +available, if the data contains in addition to observations also indicators +defining to which component a certain observation belongs. These indicators +are stored in an \linkS4class{fdata} object in the slot \code{S}. + Calling \code{\link[=show]{show()}} on a \code{groupmoments} object gives an overview of the moments of a finit mixture with continuous data. } @@ -22,3 +30,30 @@ of the moments of a finit mixture with continuous data. \item \code{show,groupmoments-method}: Shows a short summary of the object's slots }} +\section{Slots}{ + +\describe{ +\item{\code{NK}}{An array containing the group sizes for each component.} + +\item{\code{mean}}{A matrix containing the group averages for each component.} + +\item{\code{WK}}{An array containing the within-group variability. For multivariate +data this is an array of dimension \verb{K x r x r} and for univariate +data this is simply an array of dimension \verb{1 x K}.} + +\item{\code{var}}{An array containing the within-group (co)variance. For multivariate +data this is an array of dimension \verb{K x r x r} and for univariate +data this is simply an array of dimension \verb{1 x K}.} + +\item{\code{fdata}}{An \linkS4class{fdata} object containing the data.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +\item \linkS4class{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +} +} +\keyword{internal} diff --git a/man/groupmoments.Rd b/man/groupmoments.Rd index e6d5080..335fbc5 100644 --- a/man/groupmoments.Rd +++ b/man/groupmoments.Rd @@ -17,7 +17,7 @@ A \code{groupmoments} object containing component-specific moments of the \description{ Calling \code{\link[=groupmoments]{groupmoments()}} creates an object holding various component-specific moments. These moments can only constructed if the -\link[=fdata_class]{fdata} object contains in addition to observations also +\linkS4class{fdata} object contains in addition to observations also indicators defining from which component a certain observation stems. } \examples{ @@ -31,10 +31,10 @@ groupmoments(f_data) } \seealso{ \itemize{ -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition \item \link[=groupmments_class]{groupmoments} for the definition of the \code{groupmoments} class -\item \link[=datamoments_class]{datamoments} for the base class for data moments +\item \linkS4class{datamoments} for the base class for data moments \item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} class family } diff --git a/man/groupmoments_class.Rd b/man/groupmoments_class.Rd deleted file mode 100644 index 84c916f..0000000 --- a/man/groupmoments_class.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/groupmoments.R -\docType{class} -\name{groupmoments_class} -\alias{groupmoments_class} -\alias{.groupmoments} -\title{Finmix \code{groupmoments} class} -\description{ -Stores moments for finite mixture component distributions. These are only -available, if the data contains in addition to observations also indicators -defining to which component a certain observation belongs. These indicators -are stored in an \link[=fdata_class]{fdata} object in the slot \code{S}. -} -\section{Slots}{ - -\describe{ -\item{\code{NK}}{An array containing the group sizes for each component.} - -\item{\code{mean}}{A matrix containing the group averages for each component.} - -\item{\code{WK}}{An array containing the within-group variability. For multivariate -data this is an array of dimension \verb{K x r x r} and for univariate -data this is simply an array of dimension \verb{1 x K}.} - -\item{\code{var}}{An array containing the within-group (co)variance. For multivariate -data this is an array of dimension \verb{K x r x r} and for univariate -data this is simply an array of dimension \verb{1 x K}.} - -\item{\code{fdata}}{An \link[=fdata_class]{fdata} object containing the data.} -}} - -\seealso{ -\itemize{ -\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor -\item \link[=datamoments_class]{datamoments} for the base class for data moments -\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} -class family -} -} diff --git a/man/hasS-fdata-method.Rd b/man/hasS-fdata-method.Rd index 9a820b7..4d4bd47 100644 --- a/man/hasS-fdata-method.Rd +++ b/man/hasS-fdata-method.Rd @@ -17,7 +17,7 @@ Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code empty or filled or a message, if \code{verbose} is \code{TRUE}. } \description{ -\code{\link[=hasY]{hasY()}} checks, if the object contains \code{S} data. +\code{\link[=hasS]{hasS()}} checks, if the object contains \code{S} data. } \examples{ # Generate an fdata object with Poisson data diff --git a/man/initialize-mcmcoutputpermhierpost-method.Rd b/man/initialize-mcmcoutputpermhierpost-method.Rd index 4cb3954..88c98f1 100644 --- a/man/initialize-mcmcoutputpermhierpost-method.Rd +++ b/man/initialize-mcmcoutputpermhierpost-method.Rd @@ -56,12 +56,12 @@ MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} obje passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the last indicator of this observation.} -\item{NKperm}{An \code{array} of dimension \verb{Mperm x K} containing the numbers -of observations assigned to each component.} - -\item{An}{\code{array} of dimension \verb{N x storeS} containing the last +\item{Sperm}{An \code{array} of dimension \verb{N x storeS} containing the last \code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} + +\item{NKperm}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +of observations assigned to each component.} } \description{ Only used implicitly. The initializer stores the data into the slots of the diff --git a/man/initialize-sdatamoments-method.Rd b/man/initialize-sdatamoments-method.Rd index c954785..292f128 100644 --- a/man/initialize-sdatamoments-method.Rd +++ b/man/initialize-sdatamoments-method.Rd @@ -13,11 +13,11 @@ \item{...}{Arguments to specify properties of the new object, to be passed to \code{initialize()}.} -\item{model}{A finmix \link[=fdata_class]{fdata} object containing the observations.} +\item{model}{A finmix \linkS4class{fdata} object containing the observations.} } \description{ Only used implicitly. The initializer calls the constructor for a -\link[=groupmoments_class]{groupmoments} object. to generate in the initialization +\linkS4class{groupmoments} object. to generate in the initialization step the moments for a passed-in \code{fdata} object. } \seealso{ diff --git a/man/mcmc.Rd b/man/mcmc.Rd index 1a94528..259542e 100644 --- a/man/mcmc.Rd +++ b/man/mcmc.Rd @@ -54,7 +54,7 @@ f_mcmc <- mcmc() } \seealso{ \itemize{ -\item \link[=mcmc_class]{mcmc} for the definition of the \code{mcmc} class +\item \linkS4class{mcmc} for the definition of the \code{mcmc} class \item \code{\link[=mcmcstart]{mcmcstart()}} for setting up all objects for MCMC sampling \item \code{\link[=mixturemcmc]{mixturemcmc()}} for running MCMC sampling for finite mixture models } diff --git a/man/mcmc_binomial_cc.Rd b/man/mcmc_binomial_cc.Rd index eded624..71141fe 100644 --- a/man/mcmc_binomial_cc.Rd +++ b/man/mcmc_binomial_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_class.Rd b/man/mcmc_class.Rd deleted file mode 100644 index b9cf284..0000000 --- a/man/mcmc_class.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmc.R -\docType{class} -\name{mcmc_class} -\alias{mcmc_class} -\alias{.mcmc} -\title{Finmix \code{mcmc} class} -\description{ -This class defines hyper-parameters for the MCMC procedure. This is a main -class of the \code{finmix} package that must be defined for estimating a finite -mixture model. -} -\section{Slots}{ - -\describe{ -\item{\code{burnin}}{An integer defining the number of steps in the burn-in phase of -Gibbs-sampling.} - -\item{\code{M}}{An integer defining the number of steps in Gibbs-sampling to be -stored.} - -\item{\code{startpar}}{A logical indicating, if starting by sampling the -parameters. If \code{FALSE} sampling starts by sampling the indicators \code{S}.} - -\item{\code{storeS}}{An integer specifying how many of the last sampled indicators -should be stored in the output.} - -\item{\code{storepost}}{A logical indicating if the posterior probabilities should -be stored. This becomes for example important for specific relabeling -algorithms, but also for analysis.} - -\item{\code{ranperm}}{A logical indicating, if random permutation should be used. If -\code{TRUE} the parameters are permutated randomly between the number of -components after each sampling step in MCMC.} - -\item{\code{storeinv}}{A logical indicating if the inverse variance-covariance -matrices for multivariate normal or Student-t mixtures should be stored.} -}} - -\seealso{ -\itemize{ -\item \code{\link[=mcmc]{mcmc()}} for the class constructor -\item \code{\link[=mcmcstart]{mcmcstart()}} for completion of slots -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for further information about the MCMC sampling -} -} diff --git a/man/mcmc_condpoisson_cc.Rd b/man/mcmc_condpoisson_cc.Rd index f00ce49..d6e232e 100644 --- a/man/mcmc_condpoisson_cc.Rd +++ b/man/mcmc_condpoisson_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_exponential_cc.Rd b/man/mcmc_exponential_cc.Rd index e6dd759..eeeba79 100644 --- a/man/mcmc_exponential_cc.Rd +++ b/man/mcmc_exponential_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_normal_cc.Rd b/man/mcmc_normal_cc.Rd index 7449d81..51f80aa 100644 --- a/man/mcmc_normal_cc.Rd +++ b/man/mcmc_normal_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_normult_cc.Rd b/man/mcmc_normult_cc.Rd index ec3df62..3f5ddb1 100644 --- a/man/mcmc_normult_cc.Rd +++ b/man/mcmc_normult_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_poisson_cc.Rd b/man/mcmc_poisson_cc.Rd index a5f12a9..0c3def3 100644 --- a/man/mcmc_poisson_cc.Rd +++ b/man/mcmc_poisson_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_student_cc.Rd b/man/mcmc_student_cc.Rd index 92e40b1..8df74b7 100644 --- a/man/mcmc_student_cc.Rd +++ b/man/mcmc_student_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmc_studmult_cc.Rd b/man/mcmc_studmult_cc.Rd index 47b0b52..074be51 100644 --- a/man/mcmc_studmult_cc.Rd +++ b/man/mcmc_studmult_cc.Rd @@ -48,9 +48,9 @@ Berlin, Heidelberg. \seealso{ \itemize{ \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior_class]{prior} for the \code{prior} class definition -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition } } diff --git a/man/mcmcest_class.Rd b/man/mcmcest_class.Rd deleted file mode 100644 index f5b49ed..0000000 --- a/man/mcmcest_class.Rd +++ /dev/null @@ -1,88 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcestfix.R, R/mcmcestind.R -\docType{class} -\name{mcmcest_class} -\alias{mcmcest_class} -\alias{.mcmcestfix} -\alias{mcmcestind-class} -\alias{.mcmcestind} -\title{Finmix \code{mcmcestfix} class} -\description{ -This class stores the point estimators for component parameters and weights -as well as corresponding information from MCMC sampling. Three point -estimators are calculated: the maximum a posterior (MAP), the Bayesian -maximum likelihood (BML) and the Identified ergodic average (IEAVG). See -Fr\"uhwirth-Schnatter (2006) for detailed information about how these -estimators are defined. - -This class stores the point estimators for component parameters and weights -as well as corresponding information from MCMC sampling. Three point -estimators are calculated: the maximum a posterior (MAP), the Bayesian -maximum likelihood (BML) and the Identified ergodic average (IEAVG). See -Fr\"uhwirth-Schnatter (2006) for detailed information about how these -estimators are defined. - -Note that this class inherits almost all of its slots from the \code{mcmcestfix} -class, the corresponding class for fixed indicators. -} -\section{Functions}{ -\itemize{ -\item \code{mcmcestind-class}: Finmix \code{mcmcestind} class -}} - -\section{Slots}{ - -\describe{ -\item{\code{dist}}{A character specifying the distribution family of the mixture -model used in MCMC sampling.} - -\item{\code{K}}{An integer specifying the number of components in the mixture model.} - -\item{\code{indicmod}}{A character specifying the indicator model. At this moment -only a multinomial model can be chosen.} - -\item{\code{burnin}}{An integer specifying the number of iterations in the burn-in -phase of MCMC sampling.} - -\item{\code{M}}{An integer specifying the number of iterations to store in MCMC -sampling.} - -\item{\code{ranperm}}{A logical specifying, if random permutation has been used -during MCMC sampling.} - -\item{\code{relabel}}{A character specifying the re-labeling algorithm used during -parameter estimation for the identified ergodic average.} - -\item{\code{map}}{A named list containing the parameter estimates of the MAP. The -element \code{par} is a named list and contains the component parameters and -the element \code{weight} contains the weights.} - -\item{\code{bml}}{A named list containing the parameter estimates of the BML. The -element \code{par} is a named list and contains the component parameters and -the element \code{weight} contains the weights.} - -\item{\code{A}}{named list containing the parameter estimates of the IEAVG. The -element \code{par} is a named list and contains the component parameters and -the element \code{weight} contains the weights.} - -\item{\code{sdpost}}{A named list containing the standard deviations of the -parameter estimates from the posterior distributions.} - -\item{\code{eavg}}{A named list containing the estimates of the ergodic average. The -element \code{par} is a list and contains the component parameter estimates and -\code{weight} contains the weight estimates. The difference between the EAVG -and the IEAVG is that the IEAVG is based on re-labeled samples.} -}} - -\seealso{ -\itemize{ -\item \link[=mcmcest_class]{mcmcestind} for the equivalent class for models with -unknown indicators -\item \code{\link[=mcmcestimate]{mcmcestimate()}} to calculate point estimates -} - -\itemize{ -\item \link[=mcmcest_class]{mcmcestfix} for the parent class with fixed indicators -\item \code{\link[=mcmcestimate]{mcmcestimate()}} to calculate point estimates -} -} diff --git a/man/mcmcestimate.Rd b/man/mcmcestimate.Rd index 96de3aa..4de3b11 100644 --- a/man/mcmcestimate.Rd +++ b/man/mcmcestimate.Rd @@ -63,7 +63,7 @@ estimation, see Fr\"uhwirth-Schnatter (2006). case of fixed indicators \item \link[=mcmcest_class]{mcmcestfix} for object storing the parameter estimates in case of unknown indicators -\item \link[=mcmcoutputperm_class]{mcmcoutputperm} for classes storing re-labeled +\item \linkS4class{mcmcoutputperm} for classes storing re-labeled MCMC samples } } diff --git a/man/mcmcoutput-class.Rd b/man/mcmcoutput-class.Rd index 719c1cb..ea4f0e6 100644 --- a/man/mcmcoutput-class.Rd +++ b/man/mcmcoutput-class.Rd @@ -1,10 +1,103 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputhierpost.R +% Please edit documentation in R/mcmcoutputfix.R, R/mcmcoutputhierpost.R \docType{class} -\name{mcmcoutput-class} +\name{mcmcoutputfix-class} +\alias{mcmcoutputfix-class} +\alias{.mcmcoutputfix} \alias{mcmcoutput-class} -\title{Finmix \code{mcmcoutput} class union} +\title{Finmix \code{mcmcoutput} base class for fixed indicators} \description{ -This class union is set to dispatch methods for \code{mcmcoutput} objects from -MCMC sampling. +This class defines the basic slots for the MCMC sampling output for a +fixed indicator model. + +The \code{mcmcoutput} class stores all MCMC samples and corresponding information. } +\section{Slots}{ + +\describe{ +\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} + +\item{\code{burnin}}{An integer defining the number of iterations in the burn-in +phase of MCMC sampling. These number of sampling steps are not stored +in the output.} + +\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed +with random permutations of components.} + +\item{\code{par}}{A named list containing the sampled component parameters.} + +\item{\code{log}}{A named list containing the values of the mixture log-likelihood, +mixture prior log-likelihood, and the complete data posterior +log-likelihood.} + +\item{\code{model}}{The \code{model} object that specifies the finite mixture model for +whcih MCMC sampling has been performed.} + +\item{\code{prior}}{The \code{prior} object defining the prior distributions for the +component parameters that has been used in MCMC sampling.} + +\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} + +\item{\code{burnin}}{An integer defining the number of iterations in the burn-in +phase of MCMC sampling. These number of sampling steps are not stored +in the output.} + +\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed +with random permutations of components.} + +\item{\code{par}}{A named list containing the sampled component parameters.} + +\item{\code{weight}}{An \code{array} of dimension \verb{M x K} containing the sampled +weights.} + +\item{\code{log}}{A named list containing the values of the mixture log-likelihood, +mixture prior log-likelihood, and the complete data posterior +log-likelihood.} + +\item{\code{hyper}}{A list storing the sampled parameters from the hierarchical +prior.} + +\item{\code{post}}{A named list containing a list \code{par} that contains the posterior +parameters as named arrays.} + +\item{\code{entropy}}{An \code{array} of dimension \verb{M x 1} containing the entropy +for each MCMC draw.} + +\item{\code{ST}}{An \code{array} of dimension \verb{M x 1} containing all MCMC states, +for the last observation in slot \code{y} of the \code{fdata} object passed in to +\code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the +last indicator of this observation.} + +\item{\code{S}}{An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} indicators sampled. \code{storeS} is defined in the slot \verb{@storeS} of +the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} + +\item{\code{NK}}{An \code{array} of dimension \verb{M x K} containing the number of +observations assigned to each component for each MCMC draw.} + +\item{\code{clust}}{An \code{array} of dimension \verb{N x 1} containing the recent +indicators defining the last "clustering" of observations into the +mixture components.} + +\item{\code{model}}{The \code{model} object that specifies the finite mixture model for +whcih MCMC sampling has been performed.} + +\item{\code{prior}}{The \code{prior} object defining the prior distributions for the +component parameters that has been used in MCMC sampling.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputperm} for the corresponding class defined for relabeled +MCMC samples +\item \linkS4class{mcmcoutputfix} for the \code{mcmcoutput} sub-class for models with +fixed indicators +\item \linkS4class{mcmcoutputbase} for the \code{mcmcoutput} sub-class for models with +unknown indicators +\item \linkS4class{mcmcoutputhier} for the \code{mcmcoutput} sub-class for MCMC samples +with hierarchical priors +\item \linkS4class{mcmcoutputpost} for the \code{mcmcoutput} sub-class for MCMC samples +with stored posterior density parameters +} +} +\keyword{internal} diff --git a/man/mcmcoutput_class.Rd b/man/mcmcoutput_class.Rd deleted file mode 100644 index 736782d..0000000 --- a/man/mcmcoutput_class.Rd +++ /dev/null @@ -1,1007 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/mcmcoutputfix.R, -% R/mcmcoutputfixhier.R, R/mcmcoutputfixpost.R, R/mcmcoutputfixhierpost.R, -% R/mcmcoutputhier.R, R/mcmcoutputpost.R, R/mcmcoutputhierpost.R -\docType{class} -\name{subseq} -\alias{subseq} -\alias{mcmcoutput_class} -\alias{.mcmcoutputfix} -\alias{plotTraces,mcmcoutputfix-method} -\alias{plotHist,mcmcoutputfix-method} -\alias{plotDens,mcmcoutputfix-method} -\alias{plotPointProc,mcmcoutputfix-method} -\alias{plotSampRep,mcmcoutputfix-method} -\alias{plotPostDens,mcmcoutputfix-method} -\alias{mcmcoutputfixhier-class} -\alias{.mcmcoutputfixhier} -\alias{plotTraces,mcmcoutputfixhier-method} -\alias{plotHist,mcmcoutputfixhier-method} -\alias{plotDens,mcmcoutputfixhier-method} -\alias{plotPointProc,mcmcoutputfixhier-method} -\alias{plotSampRep,mcmcoutputfixhier-method} -\alias{plotPostDens,mcmcoutputfixhier-method} -\alias{mcmcoutputfixpost-class} -\alias{.mcmcoutputfixpost} -\alias{plotTraces,mcmcoutputfixpost-method} -\alias{plotHist,mcmcoutputfixpost-method} -\alias{plotDens,mcmcoutputfixpost-method} -\alias{plotPointProc,mcmcoutputfixpost-method} -\alias{plotSampRep,mcmcoutputfixpost-method} -\alias{plotPostDens,mcmcoutputfixpost-method} -\alias{mcmcoutputfixhierpost-class} -\alias{.mcmcoutputfixhierpost} -\alias{plotHist,mcmcoutputfixhierpost-method} -\alias{plotPostDens,mcmcoutputhier-method} -\alias{show,mcmcoutputpost-method} -\alias{plotPostDens,mcmcoutputpost-method} -\alias{plotTraces,mcmcoutputhierpost-method} -\alias{plotHist,mcmcoutputhierpost-method} -\alias{plotDens,mcmcoutputhierpost-method} -\alias{plotPostDens,mcmcoutputhierpost-method} -\title{Finmix \code{mcmcoutput} base class for fixed indicators} -\usage{ -subseq(object, index) - -\S4method{plotTraces}{mcmcoutputfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputfix}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputfix}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputfix}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputfix}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputfix}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputfixhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputfixhier}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputfixhier}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputfixhier}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputfixhier}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputfixhier}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputfixpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputfixpost}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputfixpost}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputfixpost}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputfixpost}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputfixpost}(x, dev = TRUE, ...) - -\S4method{plotHist}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputhier}(x, dev = TRUE, ...) - -\S4method{show}{mcmcoutputpost}(object) - -\S4method{plotPostDens}{mcmcoutputpost}(x, dev = TRUE, ...) - -\S4method{plotTraces}{mcmcoutputhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputhierpost}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) -} -\arguments{ -\item{object}{An \code{ mcmcoutputpost} object.} - -\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{lik}{An integer indicating, if the log-likelihood traces should be -plotted (default). If set to \code{0} the traces for the parameters -and weights are plotted instead.} - -\item{col}{A logical indicating, if the plot should be colored.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point process of the MCMC samples. - -Sampling representation of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point process of the MCMC samples. - -Sampling representation of the MCMC samples. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point process of the MCMC samples. - -Sampling representation of the MCMC samples. - -Posterior densities of the MCMC samples. - -Histograms of the MCMC samples. - -Posterior densities of the MCMC samples. - -A console output listing the slots and summary information about -each of them. - -Posterior densities of the MCMC samples. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Posterior densities of the MCMC samples. -} -\description{ -This class defines the basic slots for the MCMC sampling output for a -fixed indicator model. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}.s - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -This class stores in addition to the information from its parent class -\code{mcmcoutputfix} also the sampled parameters from the hierarchical prior. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{0}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -The \code{mcmcoutputfixpost} class inherits from the \code{mcmcoutputfix} class and -adds a slot to store the parameters of the posterior distribution from which -the component parameters are drawn. The storage of posterior parameters is -controlled by the slot \code{storepost} in the \link[=mcmc_class]{mcmc} class. If set -to \code{TRUE} posterior parameters are stored in the output of the MCMC sampling. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. If \code{lik} is set to \code{0} the parameters of the components and the -posterior parameters are plotted together with \code{K-1} weights. - -Note that this method calls the equivalent method from the parent class -\code{mcmcoutputfix}. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Note that this method calls the equivalent method from the parent class -\code{mcmcoutputfix}. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Note that this methid calls the equivalent method from the parent class -\code{mcmcoutputfix}. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this methid calls the equivalent method from the parent class -\code{mcmcoutputfix}. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method calls the equivalent method of the parent class -\code{mcmcoutputfix}. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this methid calls the equivalent method of the parent class -\code{mcmcoutputfix}. - -This class inherits from the \code{mcmcoutputfixhier} class and adds posterior -density parameters to the MCMC sampling output. The storage of posterior -parameters is controlled by the slot \code{storepost} in the \link[=mcmc_class]{mcmc} -class. If set to \code{TRUE} posterior parameters are stored in the output of the -MCMC sampling. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Note that this method calls the equivalent method from the parent class -\code{mcmcoutputfixhier}. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Calling \code{\link[=show]{show()}} on an \code{ mcmcoutputpost} object gives an overview -of the \code{ mcmcoutputpost} object. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}.s If \code{lik} is set to \code{0} the parameters of the components and the -posterior parameters are plotted together with \code{K-1} weights. - -Note that this method calls the equivalent method from the parent class. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Note, this method calls the equivalent method of the parent class. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Note that this method calls the equivalent method of the parent class. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method calls the equivalent method of the parent class. -} -\section{Functions}{ -\itemize{ -\item \code{subseq}: - -\item \code{plotTraces,mcmcoutputfix-method}: - -\item \code{plotHist,mcmcoutputfix-method}: - -\item \code{plotDens,mcmcoutputfix-method}: - -\item \code{plotPointProc,mcmcoutputfix-method}: - -\item \code{plotSampRep,mcmcoutputfix-method}: - -\item \code{plotPostDens,mcmcoutputfix-method}: - -\item \code{mcmcoutputfixhier-class}: - -\item \code{plotTraces,mcmcoutputfixhier-method}: - -\item \code{plotHist,mcmcoutputfixhier-method}: - -\item \code{plotDens,mcmcoutputfixhier-method}: - -\item \code{plotPointProc,mcmcoutputfixhier-method}: - -\item \code{plotSampRep,mcmcoutputfixhier-method}: - -\item \code{plotPostDens,mcmcoutputfixhier-method}: - -\item \code{mcmcoutputfixpost-class}: - -\item \code{plotTraces,mcmcoutputfixpost-method}: - -\item \code{plotHist,mcmcoutputfixpost-method}: - -\item \code{plotDens,mcmcoutputfixpost-method}: - -\item \code{plotPointProc,mcmcoutputfixpost-method}: - -\item \code{plotSampRep,mcmcoutputfixpost-method}: - -\item \code{plotPostDens,mcmcoutputfixpost-method}: - -\item \code{mcmcoutputfixhierpost-class}: - -\item \code{plotHist,mcmcoutputfixhierpost-method}: - -\item \code{plotPostDens,mcmcoutputhier-method}: - -\item \code{show,mcmcoutputpost-method}: Shows a short summary of the object's slots - -\item \code{plotPostDens,mcmcoutputpost-method}: - -\item \code{plotTraces,mcmcoutputhierpost-method}: - -\item \code{plotHist,mcmcoutputhierpost-method}: - -\item \code{plotDens,mcmcoutputhierpost-method}: - -\item \code{plotPostDens,mcmcoutputhierpost-method}: -}} - -\section{Slots}{ - -\describe{ -\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} - -\item{\code{burnin}}{An integer defining the number of iterations in the burn-in -phase of MCMC sampling. These number of sampling steps are not stored -in the output.} - -\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed -with random permutations of components.} - -\item{\code{par}}{A named list containing the sampled component parameters.} - -\item{\code{log}}{A named list containing the values of the mixture log-likelihood, -mixture prior log-likelihood, and the complete data posterior -log-likelihood.} - -\item{\code{model}}{The \code{model} object that specifies the finite mixture model for -whcih MCMC sampling has been performed.} - -\item{\code{prior}}{The \code{prior} object defining the prior distributions for the -component parameters that has been used in MCMC sampling.} - -\item{\code{hyper}}{A list storing the sampled parameters from the hierarchical -prior.} - -\item{\code{post}}{A named list containing a list \code{par} that contains the posterior -parameters as named arrays.} - -\item{\code{post}}{A named list containing a named list \code{par} with arrays for the -posterior density parameters.} -}} - -\examples{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPointProc(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotSampRep(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPointProc(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotSampRep(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPointProc(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotSampRep(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) -} - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputfix} for the parent class`` -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputfix} for the parent class -\item \link[=mcmcoutput_class]{mcmcoutputpost} for the corresponding class for unknown -indicators. -\item \link[=mcmc_class]{mcmc} for the class defining the MCMC hyper-parameters -\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \link[=mcmc_class]{mcmc} class -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \link[=mcmcoutput_class]{mcmcoutputfixhier} for the parent class -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=mcmc_class]{mcmc} for the class defining the MCMC hyper-parameters -\item \code{\link[=mcmc]{mcmc()}} for the \code{mcmc} class constructor -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} -} diff --git a/man/mcmcoutputbase-class.Rd b/man/mcmcoutputbase-class.Rd index 408fed3..8db008a 100644 --- a/man/mcmcoutputbase-class.Rd +++ b/man/mcmcoutputbase-class.Rd @@ -119,12 +119,12 @@ weights.} for each MCMC draw.} \item{\code{ST}}{An \code{array} of dimension \verb{M x 1} containing all MCMC states, -for the last observation in slot \verb{@y} of the \code{fdata} object passed in to +for the last observation in slot \code{y} of the \code{fdata} object passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the last indicator of this observation.} \item{\code{S}}{An \code{array} of dimension \verb{N x storeS} containing the last -\code{storeS} indicators sampled. \code{storeS} is defined in the slot \verb{@storeS} of +\code{storeS} indicators sampled. \code{storeS} is defined in the slot \code{storeS} of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} \item{\code{NK}}{An \code{array} of dimension \verb{M x K} containing the number of diff --git a/man/mcmcoutputhierpost-class.Rd b/man/mcmcoutputhierpost-class.Rd index 5090a13..7cf7e3d 100644 --- a/man/mcmcoutputhierpost-class.Rd +++ b/man/mcmcoutputhierpost-class.Rd @@ -4,18 +4,7 @@ \name{mcmcoutputhierpost-class} \alias{mcmcoutputhierpost-class} \alias{.mcmcoutputhierpost} -\alias{show,mcmcoutputhierpost-method} \title{Finmix \code{mcmcoutputhierpost} class} -\usage{ -\S4method{show}{mcmcoutputhierpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputhierpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ This class stores samples from bayesian estimation with hierarchical prior and unknown indicators. It inherits from \code{mcmcoutputhier} and adds to it a @@ -26,16 +15,7 @@ hierarchical prior is activated by setting the slot \verb{@hier} in the \code{pr object to \code{TRUE} (default). Finally, to store parameters for the posterior density the hyper-parameter \code{storepost} in the \code{mcmc} object must be set to \code{TRUE} (default). - -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputhierpost} object gives an overview -of the \code{mcmcoutputhierpost} object. } -\section{Functions}{ -\itemize{ -\item \code{show,mcmcoutputhierpost-method}: SHows a short summary of the object's -slots -}} - \section{Slots}{ \describe{ diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd index 50a410e..eedc74c 100644 --- a/man/mcmcoutputperm-class.Rd +++ b/man/mcmcoutputperm-class.Rd @@ -5,11 +5,123 @@ \alias{mcmcoutputperm-class} \title{Finmix \code{mcmcoutputperm} class} \description{ -The mcmcoutputperm class stores MCMC samples after relabeling (permuting). +The \code{mcmcoutputperm} class stores MCMC samples after relabeling (permuting). } \details{ Calling \code{\link[=mcmcpermute]{mcmcpermute()}} on an \code{mcmcoutput} class permutes the labels of the -components -This class union includes all classes that define objects for permuted -MCMC samples and is used to dispatch methods for \code{mcmcoutputperm} objects. +components and generates an object of class \code{mcmcoutputperm}. Note, the +number of samples of the \code{mcmcoutputperm} object could be less than the +original number of MCMC samples due to some samples where both components +get assigned to the same label and henceforth get eliminated from further +analysis. + +The class \code{mcmcoutputperm} is a class union and includes all classes that +define objects for permuted MCMC samples and is used to dispatch methods for +\code{mcmcoutputperm} objects. For the user this detail is not important, +especially as this class has no exported constructor. Objects are solely +constructed internally within the function \code{\link[=mcmcpermute]{mcmcpermute()}}. + +An object of class \code{mcmcoutputperm} inherits all slots from its parent class +\link[=mcmcoutput-class]{mcmcoutput}. In addition it contains slots that store +data from permutation. These slots are listed below +\subsection{Class methods}{ + +Similar to the parent class \link[=mcmcoutput-class]{mcmcoutput} this class comes +along with a couple of methods that should give the user some comfort in +handling the permuted sampling results. There are no setters for this class +as the slots are only set internally. +\subsection{Show}{ +\itemize{ +\item \code{show()} shows a short summary of the object's slots. } +} + +\subsection{Getters}{ +\itemize{ +\item \code{getMperm()} returns the \code{Mperm} slot. +\item \code{getParperm()} returns the \code{parperm} slot. +\item \code{getLogperm()} returns the \code{parperm} slot. +\item \code{getHyperperm()} returns the \code{hyperparm} slot. +\item \code{getPostperm()} returns the \code{postperm} slot. +\item \code{getEntropyperm()} returns the \code{entropyperm} slot. +\item \code{getSTperm()} returns the \code{STperm} slot. +\item \code{getSperm()} returns the \code{Sperm} slot. +\item \code{getNKperm()} returns the \code{NKperm} slot. +} +} + +\subsection{Plotting}{ + +Plotting functionality for the \code{mcmcoutputperm} class is so far only +implemented for mixtures of Binomial or Poisson distributions. +\itemize{ +\item \code{plotTraces()} plots traces of relabeled MCMC sampling. See \code{\link[=plotTraces]{plotTraces()}} +for further information. +\item \code{plotHist()} plots histograms of relabeled parameters and weights. See +\code{\link[=plotHist]{plotHist()}} for further information. +\item \code{plotDens()} plots densities of relabeled parameters and weights. See +\code{\link[=plotDens]{plotDens()}} for further information. +\item \code{plotPointProc()} plots the point process of relabeled component +parameters. See \link{plotPointProc} for further information. +\item \code{plotSampRep()} plots the sampling representation of relabeled component +parameters. See \code{\link[=plotSampRep]{plotSampRep()}} for further information. +\item \code{plotPostDens()} plots the posterior density of component parameters. Note +that this function can only be applied for mixtures of two components. See +\code{\link[=plotPostDens]{plotPostDens()}} for further information. +} +} + +} + +\subsection{Slots}{ +} +} +\section{Slots}{ + +\describe{ +\item{\code{Mperm}}{An integer defining the number of permuted MCMC samples.} + +\item{\code{parperm}}{A named list containing the permuted component parameter +samples from MCMC sampling.} + +\item{\code{relabel}}{A character specifying the relabeling algorithm used for +permuting the MCMC samples.} + +\item{\code{weightperm}}{An array of dimension \code{MpermxK} containing the +relabeled weight parameters. This slot is not available for models with +fixed indicators as weights do not get sampled for such models.} + +\item{\code{logperm}}{A named list containing the mixture log-likelihood, the +prior log-likelihood, and for models with unknown indicators the complete +data posterior log-likelihood for the permuted MCMC samples.} + +\item{\code{hyperperm}}{A named list containing the (permuted) parameters of the +hierarchical prior. This slot is only available, if a hierarchical prior +had been used for sampling, i.e. the slot \code{hier} of the +\link[=prior-class]{prior} had been set to \code{TRUE}.} + +\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density. This slot is only available if +the hyperparameter \code{storepost} in the \link[=mcmc-class]{mcmc} object had been +set to \code{TRUE}.} + +\item{\code{entropyperm}}{An \code{array} of dimension \code{Mpermx1} containing the +entropy for each MCMC permuted draw. This slot is only available for +models with unknown indicators.} + +\item{\code{STperm}}{An \code{array} of dimension \code{Mpermx1} containing all permuted +MCMC states, for the last observation in slot \code{y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation. This slot is only +available for models with unknown indicators.} + +\item{\code{Sperm}}{An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}. This slot is only +available for models with unknown indicators.} + +\item{\code{NKperm}}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +of observations assigned to each component. This slot is only available for +models with unknown indicators.} +}} + diff --git a/man/mcmcoutputperm_class.Rd b/man/mcmcoutputperm_class.Rd deleted file mode 100644 index 8cca6c9..0000000 --- a/man/mcmcoutputperm_class.Rd +++ /dev/null @@ -1,132 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfixhier.R, R/mcmcoutputpermhier.R -\name{plotPostDens,mcmcoutputpermfixhier-method} -\alias{plotPostDens,mcmcoutputpermfixhier-method} -\alias{plotPointProc,mcmcoutputpermhier-method} -\alias{plotSampRep,mcmcoutputpermhier-method} -\title{Plot posterior densities of the component parameters} -\usage{ -\S4method{plotPostDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermhier}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermhier}(x, dev = TRUE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -Posterior densities of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. -} -\description{ -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson and Binomial -mixture distributions. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. -} -\section{Functions}{ -\itemize{ -\item \code{plotPostDens,mcmcoutputpermfixhier-method}: - -\item \code{plotPointProc,mcmcoutputpermhier-method}: - -\item \code{plotSampRep,mcmcoutputpermhier-method}: -}} - -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) -} - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} -} diff --git a/man/mcmcoutputpermfix-class.Rd b/man/mcmcoutputpermfix-class.Rd index c13c63b..d5340e6 100644 --- a/man/mcmcoutputpermfix-class.Rd +++ b/man/mcmcoutputpermfix-class.Rd @@ -120,6 +120,24 @@ f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) f_outputperm <- mcmcpermute(f_output) plotTraces(f_outputperm, lik = 0) +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + \dontrun{ # Define a Poisson mixture model with two components. f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, diff --git a/man/mcmcoutputpermfixhierpost-class.Rd b/man/mcmcoutputpermfixhierpost-class.Rd index 1052ac3..5338fa0 100644 --- a/man/mcmcoutputpermfixhierpost-class.Rd +++ b/man/mcmcoutputpermfixhierpost-class.Rd @@ -4,18 +4,7 @@ \name{mcmcoutputpermfixhierpost-class} \alias{mcmcoutputpermfixhierpost-class} \alias{.mcmcoutputpermfixhierpost} -\alias{show,mcmcoutputpermfixhierpost-method} \title{Finmix \code{mcmcoutputpermfixhierpost} class} -\usage{ -\S4method{show}{mcmcoutputpermfixhierpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfixhierpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -29,16 +18,7 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note this class inherits all slots from its parent classes. - -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhierpost} object gives an overview -of the \code{mcmcoutputpermfixhierpost} object. } -\section{Functions}{ -\itemize{ -\item \code{show,mcmcoutputpermfixhierpost-method}: Shows a short summary of the -object's slots -}} - \seealso{ \itemize{ \item \linkS4class{mcmcoutputfixhierpost} for the parent class diff --git a/man/mcmcoutputpermfixpost-class.Rd b/man/mcmcoutputpermfixpost-class.Rd index b711797..defb5fe 100644 --- a/man/mcmcoutputpermfixpost-class.Rd +++ b/man/mcmcoutputpermfixpost-class.Rd @@ -4,31 +4,16 @@ \name{mcmcoutputpermfixpost-class} \alias{mcmcoutputpermfixpost-class} \alias{.mcmcoutputpermfixpost} -\alias{show,mcmcoutputpermfixpost-method} \title{Finmix \code{mcmcoutput} class for fixed indicators and posterior parameters} -\usage{ -\S4method{show}{mcmcoutputpermfixpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfixpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ This class defines the storage of parameters of the posterior distribution. It inherits from the - -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixpost} object gives an overview -of the \code{mcmcoutputpermfixpost} object. } -\section{Functions}{ -\itemize{ -\item \code{show,mcmcoutputpermfixpost-method}: Shows a short summary of the -object's slots -}} - \seealso{ - +\itemize{ +\item \linkS4class{mcmcoutputfixpost} for the parent class +\item \link{mcmcpermfixpost} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +} } +\keyword{internal} diff --git a/man/mcmcoutputpost-class.Rd b/man/mcmcoutputpost-class.Rd index 3064772..f4b8532 100644 --- a/man/mcmcoutputpost-class.Rd +++ b/man/mcmcoutputpost-class.Rd @@ -8,7 +8,7 @@ \description{ This class inherits from the \code{mcmcoutputbase} class and adds posterior density parameters to the MCMC sampling output. The storage of posterior -parameters is controlled by the slot \code{storepost} in the \link[=mcmc_class]{mcmc} +parameters is controlled by the slot \code{storepost} in the \linkS4class{mcmc} class. If set to \code{TRUE} posterior parameters are stored in the output of the MCMC sampling. } diff --git a/man/mcmcpermfix-class.Rd b/man/mcmcpermfix-class.Rd index 37702d6..94dc9be 100644 --- a/man/mcmcpermfix-class.Rd +++ b/man/mcmcpermfix-class.Rd @@ -32,8 +32,8 @@ log-likelihood, and the complete data posterior log-likelihood.} \seealso{ \itemize{ -\item \code{\link{mcmcpermute}} for the calling function -\item \code{\link{mcmcpermind}} for the corresponding class for models with +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \linkS4class{mcmcpermind} for the corresponding class for models with unknown indicators } } diff --git a/man/mcmcpermfixhier-methods.Rd b/man/mcmcpermfixhier-methods.Rd deleted file mode 100644 index 619e63c..0000000 --- a/man/mcmcpermfixhier-methods.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcpermfixhier.R -\docType{methods} -\name{getHyperperm,mcmcpermfixpost-method} -\alias{getHyperperm,mcmcpermfixpost-method} -\alias{mcmcpermfixhierpost_class,} -\alias{mcmcoutputpermfixhier_class,} -\alias{mcmcpermoutputpermfixhierpost_class} -\title{Getter method of \code{mcmcpermfixhier} class.} -\usage{ -\S4method{getHyperperm}{mcmcpermfixpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcpermfixhier} object.} -} -\value{ -The \code{hyperperm} slot of the \code{object}. -} -\description{ -Returns the \code{hyperperm} slot. -} -\examples{ -\dontrun{getHyperpem(mcmcperm)} - -} -\seealso{ -\itemize{ -\item \code{\link{mcmcoutputpermfix-class}} for the inheriting class -\item \code{\link{mcmcpermute}} for function permuting MCMC samples -} -} diff --git a/man/mcmcpermute.Rd b/man/mcmcpermute.Rd index d6ce700..197c3e5 100644 --- a/man/mcmcpermute.Rd +++ b/man/mcmcpermute.Rd @@ -12,5 +12,50 @@ mcmcpermute( ) } \description{ -This function +Calling \code{mcmcpermute()} on an \code{mcmcoutput} object relabels the MCMC samples +by using a relabeling algorithm. \code{"kmeans"} is the standard relabeling +algorithm used. For mixtures of Poisson and Binomial distributions there are +also the relabeling algorithms \code{"Stephens1997a"} of Stephens (1997a) and +\code{"Stephens1997b"} of Stephens (1997b) available. For Exponential mixture +models only the alternative \code{"Stephens1997b"} is available. Note that the +argument \code{opt_ctrl} is a relict from older versions and deprecated. In +future versions this argument will be removed from the R function. +} +\details{ +Relabeling of the MCMC samples is performed to assign each MCMC draw to its +"right" component as in MCMC sampling the components are from time to time +permuted or, if random permutation sampling was used, samples were +intentionally permuted. This results ususally in multimodal posterior +distributions. To reassign each draw to its potentially correct +component, a relabeling algorithm is used (see Frühwirth-Schnatter (2006) +as well as Stephens (1997a) and Stephens (1997b)). + +Relabeling is performed on the point process of the component parameters +and parameter pairs which are both assigned to the same component get +removed from the resulting MCMC sample. Note that this results usually in +a reduced number of MCMC samples. the returned object is of class +\code{mcmcoutputperm} and carries the samples and statistics (like +log-likelihood values) of the permuted samples. +} +\examples{ +# Define a mixture model. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Relabel the MCMC samples. +f_outputperm <- mcmcpermute(f_output) +f_outputperm + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputperm} for the class definition of the output objects +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for a function that uses relabeling +} } diff --git a/man/mcmcstart.Rd b/man/mcmcstart.Rd index fdf1096..84cff6d 100644 --- a/man/mcmcstart.Rd +++ b/man/mcmcstart.Rd @@ -42,9 +42,9 @@ f_data <- simulate(f_model) } \seealso{ \itemize{ -\item \link[=fdata_class]{fdata} for the definition of the \code{fdata} class +\item \linkS4class{fdata} for the definition of the \code{fdata} class \item \link[=model_class]{model} for the definition of the \code{model} class -\item \link[=mcmc_class]{mcmc} for the definition of the \code{mcmc} class +\item \linkS4class{mcmc} for the definition of the \code{mcmc} class \item \code{\link[=mixturemcmc]{mixturemcmc()}} for the starting MCMC sampling } } diff --git a/man/mixturemcmc.Rd b/man/mixturemcmc.Rd index 0da0682..2164063 100644 --- a/man/mixturemcmc.Rd +++ b/man/mixturemcmc.Rd @@ -25,7 +25,7 @@ If slot \verb{@startpar} is \code{TRUE} sampling starts by sampling the paramete Henceforth, it needs starting indicators.} } \value{ -An object of class \link[=mcmcoutput_class]{mcmcoutput} storing the MCMC +An object of class \linkS4class{mcmcoutput} storing the MCMC sampling results. } \description{ @@ -103,12 +103,12 @@ Models", Springer } \seealso{ \itemize{ -\item \link[=fdata_class]{fdata} for the \code{fdata} class definition +\item \linkS4class{fdata} for the \code{fdata} class definition \item \link[=model_class]{model} for the \code{model} class definition \item \link[=prior-class]{prior} for the \code{prior} class definition \item \code{\link[=prior]{prior()}} for the \code{prior} class constructor \item \code{\link[=priordefine]{priordefine()}} for the advanced class constructor of the \code{prior} class -\item \link[=mcmc_class]{mcmc} for the \code{mcmc} class definition +\item \linkS4class{mcmc} for the \code{mcmc} class definition \item \code{\link[=mcmc]{mcmc()}} for the \code{mcmc} class constructor \item \code{\link[=mcmcstart]{mcmcstart()}} for defining starting parameters and/or indicators } diff --git a/man/model_class.Rd b/man/model_class.Rd index fc65105..29a5aec 100644 --- a/man/model_class.Rd +++ b/man/model_class.Rd @@ -1,77 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/model.R -\name{simulate} -\alias{simulate} -\alias{plotPointProc} -\alias{hasWeight} -\alias{hasT} -\alias{hasPar} -\alias{mixturemar} -\alias{getDist} -\alias{getR} -\alias{getK} -\alias{getWeight} -\alias{getPar} -\alias{getIndicmod} -\alias{getIndicfix} -\alias{getT} -\alias{setDist<-} -\alias{setR<-} -\alias{setK<-} -\alias{setWeight<-} -\alias{setPar<-} -\alias{setIndicmod<-} -\alias{setIndicfix<-} -\alias{setT<-} +% Please edit documentation in R/model.R +\name{hasWeight,model-method} \alias{hasWeight,model-method} \alias{simulate,model-method} \alias{model_class} \title{Getter for weights} \usage{ -simulate(model, N = 100, varargin, seed = 0) - -plotPointProc(x, dev = TRUE, ...) - -hasWeight(object, verbose = FALSE) - -hasT(object, verbose = FALSE) - -hasPar(object, verbose = FALSE) - -mixturemar(object, J) - -getDist(object) - -getR(object) - -getK(object) - -getWeight(object) - -getPar(object) - -getIndicmod(object) - -getIndicfix(object) - -getT(object) - -setDist(object) <- value - -setR(object) <- value - -setK(object) <- value - -setWeight(object) <- value - -setPar(object) <- value - -setIndicmod(object) <- value - -setIndicfix(object) <- value - -setT(object) <- value - \S4method{hasWeight}{model}(object, verbose = FALSE) \S4method{simulate}{model}(model, N = 100, varargin, seed = 0) @@ -109,6 +43,8 @@ setT(object) <- value \S4method{setT}{model}(object) <- value } \arguments{ +\item{verbose}{A logical indicating, if the function should give a print out.} + \item{model}{An S4 model object with specified parameters and weights.} \item{N}{An integer specifying the number of values to be simulated.} @@ -117,8 +53,6 @@ setT(object) <- value \item{seed}{An integer specifying the seed for the RNG. \code{r} and repetitions \code{T}.} - -\item{verbose}{A logical indicating, if the function should give a print out.} } \value{ Matrix of weights. @@ -133,50 +67,6 @@ S4 \code{model} object. } \section{Functions}{ \itemize{ -\item \code{simulate}: Simulates data from mixture model - -\item \code{plotPointProc}: Plots point process of mixture model - -\item \code{hasWeight}: Checker for slot \code{weight} of model class - -\item \code{hasT}: Checker for slot \code{T} of model class - -\item \code{hasPar}: Checker for slot \code{par} of model class - -\item \code{mixturemar}: Extract marginal distribution - -\item \code{getDist}: Getter for slot \code{dist} of model class - -\item \code{getR}: Getter for slot \code{r} of model class - -\item \code{getK}: Getter for slot \code{K} of model class - -\item \code{getWeight}: Getter for slot \code{weight} of model class - -\item \code{getPar}: Getter for slot \code{par} of model class - -\item \code{getIndicmod}: Getter for slot \code{indicmod} of model class - -\item \code{getIndicfix}: Getter for slot \code{indicfix} of model class - -\item \code{getT}: Getter for slot \code{T} of model class - -\item \code{setDist<-}: Setter for slot \code{dist} of model class - -\item \code{setR<-}: Setter for slot \code{r} of model class - -\item \code{setK<-}: Setter for slot \code{K} of model class - -\item \code{setWeight<-}: Setter for slot \code{weight} of model class - -\item \code{setPar<-}: Setter for slot \code{par} of model class - -\item \code{setIndicmod<-}: Setter for slot \code{indicmod} of model class - -\item \code{setIndicfix<-}: Setter for slot \code{indicfix} of model class - -\item \code{setT<-}: Setter for slot \code{T} of model class - \item \code{simulate,model-method}: Simulates data from a finite mixture model }} diff --git a/man/modelmoments-class.Rd b/man/modelmoments-class.Rd index 98823bd..1daa0b5 100644 --- a/man/modelmoments-class.Rd +++ b/man/modelmoments-class.Rd @@ -1,35 +1,26 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/exponentialmodelmoments.R -\name{getB,exponentialmodelmoments-method} -\alias{getB,exponentialmodelmoments-method} -\title{Getter method of \code{exponentialmodelmoments} class.} -\usage{ -\S4method{getB}{exponentialmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{exponentialmodelmoments} object.} -} -\value{ -The \code{B} slot of the \code{object}. -} +% Please edit documentation in R/modelmoments.R +\docType{class} +\name{modelmoments-class} +\alias{modelmoments-class} +\title{Finmix \code{modelmoments} class} \description{ -Returns the \code{B} slot. +Defines a container to hold the moments of a finite mixture model. The +finmix \code{model} object should contains parameters and weights. } -\section{Methods (by generic)}{ -\itemize{ -\item \code{getB}: Getter method for slot \code{B} -}} +\section{Slots}{ -\examples{ -f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), - weight=matrix(c(0.3, 0.7), nrow=1)) -f_moments <- modelmoments(f_model) -getB(f_moments) +\describe{ +\item{\code{mean}}{A vector of component means.} + +\item{\code{var}}{An array of components variances or in case of multivariate +distributions covariance matrices.} + +\item{\code{model}}{The corresponding \code{model} object.} +}} -} \seealso{ \itemize{ -\item \link{modelmoments} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class } } diff --git a/man/modelmoments.Rd b/man/modelmoments.Rd index 56d906d..549c424 100644 --- a/man/modelmoments.Rd +++ b/man/modelmoments.Rd @@ -27,6 +27,6 @@ modelmoments(f_model) } \seealso{ \itemize{ -\item \link{modelmoments_class} for all slots of the \code{modelmoments} class +\item \linkS4class{modelmoments} for all slots of the \code{modelmoments} class } } diff --git a/man/modelmoments_class.Rd b/man/modelmoments_class.Rd deleted file mode 100644 index 47f0ca9..0000000 --- a/man/modelmoments_class.Rd +++ /dev/null @@ -1,84 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/modelmoments.R -\docType{class} -\name{modelmoments_class} -\alias{modelmoments_class} -\alias{getMean,modelmoments-method} -\alias{getVar,modelmoments-method} -\alias{getModel,modelmoments-method} -\title{Finmix \code{modelmoments} class} -\usage{ -\S4method{getMean}{modelmoments}(object) - -\S4method{getVar}{modelmoments}(object) - -\S4method{getModel}{modelmoments}(object) -} -\arguments{ -\item{object}{A \code{modelmoments} object.} -} -\value{ -The \code{mean} slot of the \code{object}. - -The \code{var} slot of the \code{object}. - -The \code{model} slot of the \code{object}. -} -\description{ -Defines a container to hold the moments of a finite mixture model. The -finmix \code{model} object should contains parameters and weights. - -Returns the \code{mean} slot of a \code{modelmoments} object. - -Returns the \code{var} slot of a \code{modelmoments} object. - -Returns the \code{model} slot of a \code{modelmoments} object. -} -\section{Functions}{ -\itemize{ -\item \code{getMean,modelmoments-method}: - -\item \code{getVar,modelmoments-method}: - -\item \code{getModel,modelmoments-method}: -}} - -\section{Slots}{ - -\describe{ -\item{\code{mean}}{A vector of component means.} - -\item{\code{var}}{An array of components variances or in case of multivariate -distributions covariance matrices.} - -\item{\code{model}}{The corresponding \code{model} object.} -}} - -\examples{ -f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), - weight=matrix(c(0.3, 0.7), nrow=1)) -f_moments <- modelmoments(f_model) -getMean(f_moments) - -f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), - weight=matrix(c(0.3, 0.7), nrow=1)) -f_moments <- modelmoments(f_model) -getVar(f_moments) - -f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), - weight=matrix(c(0.3, 0.7), nrow=1)) -f_moments <- modelmoments(f_model) -getModel(f_moments) - -} -\seealso{ -\itemize{ -\item \code{\link[=modelmoments]{modelmoments()}} the constructor of the \code{modelmoments} class -} - -\link{modelmoments_class} for all slots of the \code{modelmoments} class - -\link{modelmoments_class} for all slots of the \code{modelmoments} class - -\link{modelmoments_class} for all slots of the \code{modelmoments} class -} diff --git a/man/moments-mcmcoutputfix-method.Rd b/man/moments-mcmcoutputfix-method.Rd deleted file mode 100644 index b711bfe..0000000 --- a/man/moments-mcmcoutputfix-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfix.R -\name{moments,mcmcoutputfix-method} -\alias{moments,mcmcoutputfix-method} -\title{Computes multivariate Normal sample moments} -\usage{ -\S4method{moments}{mcmcoutputfix}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputfix} object containing all data from MCMC -sampling.} -} -\value{ -The moments on the samples of a multivariate Normal mixture. -} -\description{ -Calling \code{\link[=moments]{moments()}} calculates the sample moments for the samples of a -multivariate Normal mixture model. -} diff --git a/man/moments_cc.Rd b/man/moments_cc.Rd index a77a263..9ced84f 100644 --- a/man/moments_cc.Rd +++ b/man/moments_cc.Rd @@ -21,8 +21,8 @@ used when plotting the traces of an MCMC sample output. } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{mcmcoutput} for the \code{mcmcoutput} class definition +\item \linkS4class{mcmcoutput} for the \code{mcmcoutput} class definition \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \link[=mcmcoutput_class]{plotTraces} for the calling function +\item \code{\link[=plotTraces]{plotTraces()}} for the calling function } } diff --git a/man/normalmodelmoments.Rd b/man/normalmodelmoments.Rd index 066cf85..152aa1b 100644 --- a/man/normalmodelmoments.Rd +++ b/man/normalmodelmoments.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/normalmodelmoments.R \docType{class} -\name{normalmodelmoments} -\alias{normalmodelmoments} +\name{normalmodelmoments-class} +\alias{normalmodelmoments-class} \alias{.normalmodelmoments} \title{Finmix \code{normalmodelmoments} class} \description{ @@ -22,7 +22,8 @@ indirectly when calling the \code{modelmoments} constructor \code{\link[=modelmo \seealso{ \itemize{ -\item \link{modelmoments_class} for the base class for model moments +\item \linkS4class{modelmoments} for the base class for model moments \item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes } } +\keyword{internal} diff --git a/man/normultmodelmoments.Rd b/man/normultmodelmoments.Rd index 1134a7f..7b2f6d9 100644 --- a/man/normultmodelmoments.Rd +++ b/man/normultmodelmoments.Rd @@ -22,7 +22,7 @@ when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{mode \seealso{ \itemize{ -\item \link{modelmoments_class} for the base class for model moments +\item \linkS4class{modelmoments} for the base class for model moments \item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes } } diff --git a/man/permmoments_cc.Rd b/man/permmoments_cc.Rd index 7fca092..584b759 100644 --- a/man/permmoments_cc.Rd +++ b/man/permmoments_cc.Rd @@ -22,9 +22,9 @@ moments are used when plotting the traces of an MCMC sample output. } \seealso{ \itemize{ -\item \link[=mcmcoutputperm_class]{mcmcoutputperm} for the \code{mcmcoutput} class definition +\item \linkS4class{mcmcoutputperm} for the \code{mcmcoutput} class definition \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling \item \code{\link[=mcmcpermute]{mcmcpermute()}} for re-labeling MCMC samples -\item \link[=mcmcoutputperm_class]{plotTraces} for the calling function +\item \code{\link[=plotTraces]{plotTraces()}} for the calling function } } diff --git a/man/poissonmodelmoments.Rd b/man/poissonmodelmoments.Rd deleted file mode 100644 index 6527d51..0000000 --- a/man/poissonmodelmoments.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/poissonmodelmoments.R -\docType{class} -\name{poissonmodelmoments} -\alias{poissonmodelmoments} -\alias{.poissonmodelmoments} -\title{Finmix \code{poissonmodelmoments} class} -\description{ -Defines a class that holds modelmoments for a finite mixture of poisson -distributions. Note that this class is not directly used, but indirectly -when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. -} -\section{Slots}{ - -\describe{ -\item{\code{B}}{A numeric defining the between-group heterogeneity.} - -\item{\code{W}}{A numeric defining the within-group heterogeneity.} - -\item{\code{R}}{A numeric defining the coefficient of determination.} -}} - -\seealso{ -\itemize{ -\item \link{modelmoments_class} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes -} -} diff --git a/man/prior-class.Rd b/man/prior-class.Rd index 4aa5023..4a8d50f 100644 --- a/man/prior-class.Rd +++ b/man/prior-class.Rd @@ -83,8 +83,8 @@ hasPriorWeight(f_prior, f_model) } \seealso{ \itemize{ -\item \code{\link{prior}} for the general constructor of this class -\item \code{\link{priordefine}} for the advanced constructor of this class +\item \code{\link[=prior]{prior()}} for the general constructor of this class +\item \code{\link[=priordefine]{priordefine()}} for the advanced constructor of this class } \itemize{ diff --git a/man/sdatamoments.Rd b/man/sdatamoments.Rd index 28022af..697dfe1 100644 --- a/man/sdatamoments.Rd +++ b/man/sdatamoments.Rd @@ -7,7 +7,7 @@ sdatamoments(value = fdata()) } \arguments{ -\item{value}{An \link[=fdata_class]{fdata} object containing the indicators for +\item{value}{An \linkS4class{fdata} object containing the indicators for which moments should be calculated.} } \value{ @@ -32,10 +32,10 @@ sdatamoments(f_data) } \seealso{ \itemize{ -\item \link[=sdatamoments_class]{sdatamoments} for the class of indicator +\item \linkS4class{sdatamoments} for the class of indicator moments for discrete data -\item \link[=csdatamoments_class]{csdatamoments} for the class of indicator moments +\item \linkS4class{csdatamoments} for the class of indicator moments for continuous -\item \link[=groupmoments_class]{groupmoments} for the parent class## Copyright (C) 2013 Lars Simon Zehnder +\item \linkS4class{groupmoments} for the parent class## Copyright (C) 2013 Lars Simon Zehnder } } diff --git a/man/sdatamoments_class.Rd b/man/sdatamoments_class.Rd index def9d12..8379847 100644 --- a/man/sdatamoments_class.Rd +++ b/man/sdatamoments_class.Rd @@ -1,11 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sdatamoments.R -\docType{class} -\name{sdatamoments_class} -\alias{sdatamoments_class} -\alias{.sdatamoments} +\name{show,sdatamoments-method} \alias{show,sdatamoments-method} -\title{Finmix \code{sdatamoments} class} +\title{Shows a summary of an \code{sdatamoments} object.} \usage{ \S4method{show}{sdatamoments}(object) } @@ -17,8 +14,6 @@ A console output listing the slots and summary information about each of them. } \description{ -Stores moments for indicators of discrete data. - Calling \code{\link[=show]{show()}} on an \code{sdatamoments} object gives an overview of the moments of a finite mixture with discrete data. } @@ -27,23 +22,3 @@ of the moments of a finite mixture with discrete data. \item \code{show,sdatamoments-method}: Shows a summary of an object }} -\section{Slots}{ - -\describe{ -\item{\code{gmoments}}{A \link[=groupmoments_class]{groupmoments} object storing the -moments for each mixture component.} - -\item{\code{fdata}}{An \link[=fdata_class]{fdata} object with data from a discrete valued -mixture distribution.} -}} - -\seealso{ -\itemize{ -\item \link[=datamoments_class]{datamoments} for the base class for data moments -\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} -class family -\item \link[=groupmoments_class]{groupmoments} for the parent class -\item \link[=csdatamoments_class]{csdatamoments} for the corresponding class defining -moments for data from a continuous-valued finite mixture -} -} diff --git a/man/show-cdatamoments-method.Rd b/man/show-cdatamoments-method.Rd deleted file mode 100644 index 125f4de..0000000 --- a/man/show-cdatamoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cdatamoments.R -\name{show,cdatamoments-method} -\alias{show,cdatamoments-method} -\title{Shows a summary of a \code{cdatamoments} object.} -\usage{ -\S4method{show}{cdatamoments}(object) -} -\arguments{ -\item{object}{A \code{cdatamoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on a \code{cdatamoments} object gives an overview -of the moments of a finit mixture with continuous data. -} diff --git a/man/show-dataclass-method.Rd b/man/show-dataclass-method.Rd deleted file mode 100644 index 78b123a..0000000 --- a/man/show-dataclass-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dataclass.R -\name{show,dataclass-method} -\alias{show,dataclass-method} -\title{Shows a summary of a \code{dataclass} object.} -\usage{ -\S4method{show}{dataclass}(object) -} -\arguments{ -\item{object}{A \code{dataclass} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on a \code{dataclass} object gives an overview -of the slots of this class. -} diff --git a/man/show-ddatamoments-method.Rd b/man/show-ddatamoments-method.Rd deleted file mode 100644 index 5fa0bb7..0000000 --- a/man/show-ddatamoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ddatamoments.R -\name{show,ddatamoments-method} -\alias{show,ddatamoments-method} -\title{Shows a summary of a \code{ddatamoments} object.} -\usage{ -\S4method{show}{ddatamoments}(object) -} -\arguments{ -\item{object}{A \code{ddatamoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on a \code{ddatamoments} object gives an overview -of the moments of a finit mixture with continuous data. -} diff --git a/man/show-exponentialmodelmoments-method.Rd b/man/show-exponentialmodelmoments-method.Rd deleted file mode 100644 index e2f336e..0000000 --- a/man/show-exponentialmodelmoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/exponentialmodelmoments.R -\name{show,exponentialmodelmoments-method} -\alias{show,exponentialmodelmoments-method} -\title{Shows a summary of an \code{exponentialmodelmoments} object.} -\usage{ -\S4method{show}{exponentialmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{exponentialmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{exponentialmodelmoments} object gives an overview -of the moments of an exponential finite mixture. -} diff --git a/man/show-mcmc-method.Rd b/man/show-mcmc-method.Rd deleted file mode 100644 index cb3015f..0000000 --- a/man/show-mcmc-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmc.R -\name{show,mcmc-method} -\alias{show,mcmc-method} -\title{Shows a summary of an \code{mcmc} object.} -\usage{ -\S4method{show}{mcmc}(object) -} -\arguments{ -\item{object}{A \code{mcmc} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmc} object gives an overview -of the \code{mcmc} object. -} diff --git a/man/show-mcmcestind-method.Rd b/man/show-mcmcestind-method.Rd deleted file mode 100644 index 879b374..0000000 --- a/man/show-mcmcestind-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcestind.R -\name{show,mcmcestind-method} -\alias{show,mcmcestind-method} -\title{Shows a summary of an \code{mcmcestind} object.} -\usage{ -\S4method{show}{mcmcestind}(object) -} -\arguments{ -\item{object}{An \code{mcmcestind} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcestind} object gives an overview -of the \code{mcmcestind} object. -} diff --git a/man/show-mcmcoutputfix-method.Rd b/man/show-mcmcoutputfix-method.Rd deleted file mode 100644 index 08b00a3..0000000 --- a/man/show-mcmcoutputfix-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfix.R -\name{show,mcmcoutputfix-method} -\alias{show,mcmcoutputfix-method} -\title{Shows a summary of an \code{mcmcoutputfix} object.} -\usage{ -\S4method{show}{mcmcoutputfix}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputfix} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfix} object gives an overview -of the \code{mcmcoutputfix} object. -} diff --git a/man/show-mcmcoutputfixhier-method.Rd b/man/show-mcmcoutputfixhier-method.Rd deleted file mode 100644 index 72ce4cf..0000000 --- a/man/show-mcmcoutputfixhier-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhier.R -\name{show,mcmcoutputfixhier-method} -\alias{show,mcmcoutputfixhier-method} -\title{Shows a summary of an \code{mcmcoutputfixhier} object.} -\usage{ -\S4method{show}{mcmcoutputfixhier}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputfixhier} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixhier} object gives an overview -of the \code{mcmcoutputfixhier} object. -} diff --git a/man/show-mcmcoutputfixhierpost-method.Rd b/man/show-mcmcoutputfixhierpost-method.Rd deleted file mode 100644 index 1f7eb0a..0000000 --- a/man/show-mcmcoutputfixhierpost-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhierpost.R -\name{show,mcmcoutputfixhierpost-method} -\alias{show,mcmcoutputfixhierpost-method} -\title{Shows a summary of an \code{mcmcoutputfixhierpost} object.} -\usage{ -\S4method{show}{mcmcoutputfixhierpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputfixhierpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixhierpost} object gives an overview -of the \code{mcmcoutputfixhierpost} object. -} diff --git a/man/show-mcmcoutputfixpost-method.Rd b/man/show-mcmcoutputfixpost-method.Rd deleted file mode 100644 index f5c2fb4..0000000 --- a/man/show-mcmcoutputfixpost-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixpost.R -\name{show,mcmcoutputfixpost-method} -\alias{show,mcmcoutputfixpost-method} -\title{Shows a summary of an \code{mcmcoutputfixpost} object.} -\usage{ -\S4method{show}{mcmcoutputfixpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputfixpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixpost} object gives an overview -of the \code{mcmcoutputfixpost} object. -} diff --git a/man/show-mcmcoutputhier-method.Rd b/man/show-mcmcoutputhier-method.Rd deleted file mode 100644 index b29008c..0000000 --- a/man/show-mcmcoutputhier-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputhier.R -\name{show,mcmcoutputhier-method} -\alias{show,mcmcoutputhier-method} -\title{Shows a summary of an \code{mcmcoutputhier} object.} -\usage{ -\S4method{show}{mcmcoutputhier}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputhier} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputhier} object gives an overview -of the \code{mcmcoutputhier} object. -} diff --git a/man/show-mcmcoutputpermfix-method.Rd b/man/show-mcmcoutputpermfix-method.Rd deleted file mode 100644 index 423648b..0000000 --- a/man/show-mcmcoutputpermfix-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermfix.R -\name{show,mcmcoutputpermfix-method} -\alias{show,mcmcoutputpermfix-method} -\title{Shows a summary of an \code{mcmcoutputpermfix} object.} -\usage{ -\S4method{show}{mcmcoutputpermfix}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfix} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfix} object gives an overview -of the \code{mcmcoutputpermfix} object. -} diff --git a/man/show-normalmodelmoments-method.Rd b/man/show-normalmodelmoments-method.Rd deleted file mode 100644 index d1336cd..0000000 --- a/man/show-normalmodelmoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/normalmodelmoments.R -\name{show,normalmodelmoments-method} -\alias{show,normalmodelmoments-method} -\title{Shows a summary of an \code{normalmodelmoments} object.} -\usage{ -\S4method{show}{normalmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{normalmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{normalmodelmoments} object gives an overview -of the moments of an normal finite mixture. -} diff --git a/man/show-normultmodelmoments-method.Rd b/man/show-normultmodelmoments-method.Rd deleted file mode 100644 index 84c3d18..0000000 --- a/man/show-normultmodelmoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/normultmodelmoments.R -\name{show,normultmodelmoments-method} -\alias{show,normultmodelmoments-method} -\title{Shows a summary of an \code{normultmodelmoments} object.} -\usage{ -\S4method{show}{normultmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{normultmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{normultmodelmoments} object gives an overview -of the moments of an normult finite mixture. -} diff --git a/man/show-poissonmodelmoments-method.Rd b/man/show-poissonmodelmoments-method.Rd deleted file mode 100644 index 074702a..0000000 --- a/man/show-poissonmodelmoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/poissonmodelmoments.R -\name{show,poissonmodelmoments-method} -\alias{show,poissonmodelmoments-method} -\title{Shows a summary of an \code{poissonmodelmoments} object.} -\usage{ -\S4method{show}{poissonmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{poissonmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{poissonmodelmoments} object gives an overview -of the moments of an poisson finite mixture. -} diff --git a/man/show-prior-method.Rd b/man/show-prior-method.Rd deleted file mode 100644 index 1dbcbcd..0000000 --- a/man/show-prior-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/prior.R -\name{show,prior-method} -\alias{show,prior-method} -\title{Shows a summary of a \code{prior} object.} -\usage{ -\S4method{show}{prior}(object) -} -\arguments{ -\item{object}{A \code{prior} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on a \code{prior} object gives an overview -of the slots of a \code{prior} object. -} diff --git a/man/show-studentmodelmoments-method.Rd b/man/show-studentmodelmoments-method.Rd deleted file mode 100644 index f3901ad..0000000 --- a/man/show-studentmodelmoments-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/studentmodelmoments.R -\name{show,studentmodelmoments-method} -\alias{show,studentmodelmoments-method} -\title{Shows a summary of an \code{studentmodelmoments} object.} -\usage{ -\S4method{show}{studentmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{studentmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{studentmodelmoments} object gives an overview -of the moments of an student finite mixture. -} diff --git a/man/stephens1997b_poisson_cc.Rd b/man/stephens1997b_poisson_cc.Rd index 286e367..b5edd20 100644 --- a/man/stephens1997b_poisson_cc.Rd +++ b/man/stephens1997b_poisson_cc.Rd @@ -41,3 +41,4 @@ Stephens (1997a) for mixtures of Binomial distributions } } +\keyword{internal} diff --git a/man/studmultmodelmoments.Rd b/man/studmultmodelmoments.Rd index df40ad9..c3cddd1 100644 --- a/man/studmultmodelmoments.Rd +++ b/man/studmultmodelmoments.Rd @@ -22,7 +22,7 @@ when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{mode \seealso{ \itemize{ -\item \link{modelmoments_class} for the base class for model moments +\item \linkS4class{modelmoments} for the base class for model moments \item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes } } diff --git a/man/swapInd_cc.Rd b/man/swapInd_cc.Rd index 39fdeea..42a9c0a 100644 --- a/man/swapInd_cc.Rd +++ b/man/swapInd_cc.Rd @@ -25,7 +25,7 @@ you are doing. \seealso{ \itemize{ \item \code{\link[=mcmc]{mcmc()}} for the hyper-parameter \code{storeS} -\item \link[=mcmcoutput_class]{swapElements()} for the calling method +\item \code{\link[=swapElements]{swapElements()}} for the calling method \item \code{\link[=swapInteger_cc]{swapInteger_cc()}} for the equivalent function that swaps simple integer matrices \item \code{\link[=swap_3d_cc]{swap_3d_cc()}} for a function that swaps values in three-dimensional diff --git a/man/swapST_cc.Rd b/man/swapST_cc.Rd index 6d47113..cf466ba 100644 --- a/man/swapST_cc.Rd +++ b/man/swapST_cc.Rd @@ -24,6 +24,6 @@ only use this function, if you really know what you are doing. \itemize{ \item \code{\link[=swapInteger_cc]{swapInteger_cc()}} for the equivalent function not using R memory \item \code{\link[=swap_3d_cc]{swap_3d_cc()}} for an equivalent function for three-dimensional arrays -\item \link[=mcmcoutput_class]{swapElements()} for the calling method +\item \code{\link[=swapElements]{swapElements()}} for the calling method } } diff --git a/man/swap_3d_cc.Rd b/man/swap_3d_cc.Rd index c177d20..1a4e212 100644 --- a/man/swap_3d_cc.Rd +++ b/man/swap_3d_cc.Rd @@ -26,7 +26,7 @@ swap_3d_cc(values, index) } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{swapElements()} for the calling method +\item \code{\link[=swapElements]{swapElements()}} for the calling method \item \code{\link[=swap_cc]{swap_cc()}} for the equivalent function for 2-dimensional arrays } } diff --git a/man/swap_cc.Rd b/man/swap_cc.Rd index 7149337..afde55d 100644 --- a/man/swap_cc.Rd +++ b/man/swap_cc.Rd @@ -28,6 +28,6 @@ swap_cc(values, index) } \seealso{ \itemize{ -\item \link[=mcmcoutput_class]{swapElements()} for the calling function +\item \code{\link[=swapElements]{swapElements()}} for the calling function } } diff --git a/src/attributes.cpp b/src/attributes.cpp index dcca91b..f751cf6 100644 --- a/src/attributes.cpp +++ b/src/attributes.cpp @@ -47,7 +47,7 @@ //' swap_cc(values, index) //' //' @seealso -//' * [swapElements()][mcmcoutput_class] for the calling function +//' * [swapElements()] for the calling function // [[Rcpp::export]] Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix index) { @@ -95,7 +95,7 @@ Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix inde //' swap_3d_cc(values, index) //' //' @seealso -//' * [swapElements()][mcmcoutput_class] for the calling method +//' * [swapElements()] for the calling method //' * [swap_cc()] for the equivalent function for 2-dimensional arrays // [[Rcpp::export]] Rcpp::NumericVector swap_3d_cc(Rcpp::NumericVector values, Rcpp::IntegerMatrix index) @@ -211,7 +211,7 @@ Rcpp::IntegerMatrix swapInteger_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatr //' //' @seealso //' * [mcmc()] for the hyper-parameter `storeS` -//' * [swapElements()][mcmcoutput_class] for the calling method +//' * [swapElements()] for the calling method //' * [swapInteger_cc()] for the equivalent function that swaps simple integer //' matrices //' * [swap_3d_cc()] for a function that swaps values in three-dimensional @@ -260,7 +260,7 @@ Rcpp::IntegerMatrix swapInd_cc(Rcpp::IntegerMatrix values, Rcpp::IntegerMatrix i //' @seealso //' * [swapInteger_cc()] for the equivalent function not using R memory //' * [swap_3d_cc()] for an equivalent function for three-dimensional arrays -//' * [swapElements()][mcmcoutput_class] for the calling method +//' * [swapElements()] for the calling method // [[Rcpp::export]] Rcpp::IntegerVector swapST_cc(Rcpp::IntegerVector values, Rcpp::IntegerMatrix index) { @@ -448,9 +448,9 @@ arma::imat hungarian_cc(const arma::mat cost) //' iteration in the MCMC sample. //' @export //' @seealso -//' * [mcmcoutput][mcmcoutput_class] for the `mcmcoutput` class definition +//' * [mcmcoutput-class] for the `mcmcoutput` class definition //' * [mixturemcmc()] for performing MCMC sampling -//' * [plotTraces][mcmcoutput_class] for the calling function +//' * [plotTraces()] for the calling function // [[Rcpp::export]] Rcpp::List moments_cc(Rcpp::S4 classS4) { @@ -481,10 +481,10 @@ Rcpp::List moments_cc(Rcpp::S4 classS4) //' iteration in the re-labeled MCMC sample. //' @export //' @seealso -//' * [mcmcoutputperm][mcmcoutputperm_class] for the `mcmcoutput` class definition +//' * [mcmcoutputperm-class] for the `mcmcoutput` class definition //' * [mixturemcmc()] for performing MCMC sampling //' * [mcmcpermute()] for re-labeling MCMC samples -//' * [plotTraces][mcmcoutputperm_class] for the calling function +//' * [plotTraces()] for the calling function // [[Rcpp::export]] Rcpp::List permmoments_cc(Rcpp::S4 classS4) { diff --git a/src/mcmc_binomial.cpp b/src/mcmc_binomial.cpp index 18101a1..df64c36 100644 --- a/src/mcmc_binomial.cpp +++ b/src/mcmc_binomial.cpp @@ -65,10 +65,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_condpoisson.cpp b/src/mcmc_condpoisson.cpp index 844c63c..3408b1b 100644 --- a/src/mcmc_condpoisson.cpp +++ b/src/mcmc_condpoisson.cpp @@ -70,10 +70,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_exponential.cpp b/src/mcmc_exponential.cpp index b859c83..d8f7ba7 100644 --- a/src/mcmc_exponential.cpp +++ b/src/mcmc_exponential.cpp @@ -69,10 +69,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_normal.cpp b/src/mcmc_normal.cpp index 3ce6b99..d153049 100644 --- a/src/mcmc_normal.cpp +++ b/src/mcmc_normal.cpp @@ -49,10 +49,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_normult.cpp b/src/mcmc_normult.cpp index eeac1a2..bf6ddf5 100644 --- a/src/mcmc_normult.cpp +++ b/src/mcmc_normult.cpp @@ -49,10 +49,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_poisson.cpp b/src/mcmc_poisson.cpp index ebbee2b..0cf8b19 100644 --- a/src/mcmc_poisson.cpp +++ b/src/mcmc_poisson.cpp @@ -69,10 +69,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_student.cpp b/src/mcmc_student.cpp index 29fe647..85154d1 100644 --- a/src/mcmc_student.cpp +++ b/src/mcmc_student.cpp @@ -49,10 +49,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/mcmc_studmult.cpp b/src/mcmc_studmult.cpp index ec5aa68..0758eea 100644 --- a/src/mcmc_studmult.cpp +++ b/src/mcmc_studmult.cpp @@ -49,10 +49,10 @@ //' //' @seealso //' * [mixturemcmc()] for performing MCMC sampling -//' * [fdata][fdata_class] for the `fdata` class definition -//' * [model][model_class] for the `model` class definition -//' * [prior][prior_class] for the `prior` class definition -//' * [mcmc][mcmc_class] for the `mcmc` class definition +//' * [fdata-class] for the `fdata` class definition +//' * [model-class] for the `model` class definition +//' * [prior-class] for the `prior` class definition +//' * [mcmc-class] for the `mcmc` class definition //' //' @references //' * Smaragdakis, Y. and Butory, D. (1998), "Implementing layered designs with diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index 087ac72..4521dc4 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -268,7 +268,7 @@ arma::imat stephens1997a_binomial_cc(Rcpp::NumericMatrix& values1, //' @return An integer matrix of dimension `MxK` that holding the optimal //' labeling. //' @export -//' @kewords internal +//' @keywords internal //' @seealso //' * [mcmcpermute()] for the calling function //' * [stephens1997a_poisson_cc()] for the re-labeling algorithm from From cd6f14b9b29a293100fda3aadae566fb84b36dd1 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Sat, 16 Oct 2021 10:38:34 +0200 Subject: [PATCH 15/24] Modified manuals to avoid warnings in R CMD check --- NAMESPACE | 36 +++ R/cdatamoments.R | 2 +- R/cmodelmoments.R | 5 +- R/csdatamoments.R | 13 +- R/dataclass.R | 15 +- R/exponentialmodelmoments.R | 6 +- R/fdata.R | 29 +- R/groupmoments.R | 4 +- R/mcmcestfix.R | 41 ++- R/mcmcestimate.R | 8 +- R/mcmcestind.R | 28 +- R/mcmcextract.R | 1 + R/mcmcoutputbase.R | 21 +- R/mcmcoutputfix.R | 18 +- R/mcmcoutputfixhier.R | 3 + R/mcmcoutputfixhierpost.R | 8 + R/mcmcoutputfixpost.R | 3 + R/mcmcoutputhier.R | 3 + R/mcmcoutputhierpost.R | 8 +- R/mcmcoutputpermbase.R | 19 +- R/mcmcoutputpermfix.R | 12 +- R/mcmcoutputpermfixhier.R | 3 +- R/mcmcoutputpermfixpost.R | 2 +- R/mcmcoutputpermhierpost.R | 236 ++++++++++++++- R/mcmcoutputpost.R | 8 +- R/mcmcpermfix.R | 6 +- R/mcmcpermfixhier.R | 9 +- R/mcmcpermfixpost.R | 1 + R/mcmcpermind.R | 11 +- R/mcmcpermindhier.R | 10 +- R/mcmcpermindpost.R | 10 +- R/mcmcpermute.R | 1 - R/model.R | 57 +++- R/normultmodelmoments.R | 8 +- R/poissonmodelmoments.R | 5 +- R/prior.R | 7 +- R/sdatamoments.R | 2 +- R/studentmodelmoments.R | 10 +- R/studmultmodelmoments.R | 9 +- man/Summary-mcmcestfix-method.Rd | 23 -- man/Summary-mcmcestind-method.Rd | 2 +- man/cmodelmoments.Rd | 30 -- man/csdatamoments-class.Rd | 19 -- man/extract-mcmcoutputfix-numeric-method.Rd | 22 -- man/getMperm-mcmcpermfix-method.Rd | 31 -- man/groupmoments-class.Rd | 19 -- man/groupmoments.Rd | 2 +- man/hasS-fdata-method.Rd | 7 +- man/mcmcestimate.Rd | 8 +- man/mcmcoutput-class.Rd | 101 +++++-- man/mcmcoutputbase-class.Rd | 240 --------------- man/mcmcoutputperm-class.Rd | 3 - man/mcmcoutputpermbase-class.Rd | 276 ------------------ man/mcmcoutputpermfix-class.Rd | 252 ---------------- man/mcmcoutputpermfixhier-class.Rd | 20 -- man/mcmcoutputpermfixpost-class.Rd | 2 +- man/mcmcperm_class.Rd | 109 ------- man/mcmcpermfixhier-class.Rd | 6 +- man/model_class.Rd | 28 +- man/plotDens-mcmcoutputfixhierpost-method.Rd | 54 ---- ...tPointProc-mcmcoutputfixhierpost-method.Rd | 53 ---- ...otPostDens-mcmcoutputfixhierpost-method.Rd | 53 ---- ...lotSampRep-mcmcoutputfixhierpost-method.Rd | 53 ---- ...plotTraces-mcmcoutputfixhierpost-method.Rd | 62 ---- man/prior-class.Rd | 55 ---- man/sdatamoments_class.Rd | 24 -- man/show-mcmcestfix-method.Rd | 19 -- man/show-mcmcoutputpermhierpost-method.Rd | 20 -- man/studentmodelmoments.Rd | 4 +- man/studmultmodelmoments-class.Rd | 24 -- man/subseq-mcmcoutputfix-array-method.Rd | 23 -- man/subseq-mcmcoutputfixhier-array-method.Rd | 23 -- man/subseq-mcmcoutputpost-array-method.Rd | 26 -- 73 files changed, 619 insertions(+), 1752 deletions(-) delete mode 100644 man/Summary-mcmcestfix-method.Rd delete mode 100644 man/cmodelmoments.Rd delete mode 100644 man/extract-mcmcoutputfix-numeric-method.Rd delete mode 100644 man/getMperm-mcmcpermfix-method.Rd delete mode 100644 man/mcmcperm_class.Rd delete mode 100644 man/plotDens-mcmcoutputfixhierpost-method.Rd delete mode 100644 man/plotPointProc-mcmcoutputfixhierpost-method.Rd delete mode 100644 man/plotPostDens-mcmcoutputfixhierpost-method.Rd delete mode 100644 man/plotSampRep-mcmcoutputfixhierpost-method.Rd delete mode 100644 man/plotTraces-mcmcoutputfixhierpost-method.Rd delete mode 100644 man/sdatamoments_class.Rd delete mode 100644 man/show-mcmcestfix-method.Rd delete mode 100644 man/show-mcmcoutputpermhierpost-method.Rd delete mode 100644 man/studmultmodelmoments-class.Rd delete mode 100644 man/subseq-mcmcoutputfix-array-method.Rd delete mode 100644 man/subseq-mcmcoutputfixhier-array-method.Rd delete mode 100644 man/subseq-mcmcoutputpost-array-method.Rd diff --git a/NAMESPACE b/NAMESPACE index d55e87d..cf40de6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -117,35 +117,70 @@ exportMethods("setY<-") exportMethods(Summary) exportMethods(extract) exportMethods(getB) +exportMethods(getBml) exportMethods(getBurnin) exportMethods(getBycolumn) +exportMethods(getClust) exportMethods(getColExp) exportMethods(getColS) exportMethods(getColT) exportMethods(getColY) +exportMethods(getCorr) exportMethods(getDist) +exportMethods(getEavg) +exportMethods(getEntropy) +exportMethods(getEntropyperm) exportMethods(getExp) +exportMethods(getFdata) exportMethods(getGmoments) exportMethods(getHier) +exportMethods(getHigher) +exportMethods(getHyper) +exportMethods(getHyperperm) +exportMethods(getIeavg) exportMethods(getIndicfix) exportMethods(getIndicmod) exportMethods(getK) +exportMethods(getKurtosis) +exportMethods(getLog) +exportMethods(getLogperm) +exportMethods(getM) +exportMethods(getMap) exportMethods(getMean) exportMethods(getModel) +exportMethods(getMperm) exportMethods(getN) +exportMethods(getNK) +exportMethods(getNKperm) exportMethods(getName) exportMethods(getPar) +exportMethods(getParperm) +exportMethods(getPost) +exportMethods(getPostperm) +exportMethods(getPrior) exportMethods(getR) +exportMethods(getRanperm) +exportMethods(getRdet) +exportMethods(getRelabel) exportMethods(getRowExp) exportMethods(getRowS) exportMethods(getRowT) exportMethods(getRowY) +exportMethods(getRtr) exportMethods(getS) +exportMethods(getST) +exportMethods(getSTperm) +exportMethods(getSdpost) exportMethods(getSim) +exportMethods(getSkewness) +exportMethods(getSperm) exportMethods(getT) exportMethods(getType) exportMethods(getVar) +exportMethods(getW) +exportMethods(getWK) exportMethods(getWeight) +exportMethods(getWeightperm) exportMethods(getY) exportMethods(hasExp) exportMethods(hasPar) @@ -168,6 +203,7 @@ exportMethods(plotTraces) exportMethods(show) exportMethods(simulate) exportMethods(subseq) +exportMethods(swapElements) import(graphics) import(methods) import(nloptr) diff --git a/R/cdatamoments.R b/R/cdatamoments.R index ace2329..476bdab 100644 --- a/R/cdatamoments.R +++ b/R/cdatamoments.R @@ -159,7 +159,7 @@ setMethod( ) } cat( - " fdata : Object of class", + " fdata : Object of class", class(object@fdata), "\n" ) } diff --git a/R/cmodelmoments.R b/R/cmodelmoments.R index 82eea90..2e13569 100644 --- a/R/cmodelmoments.R +++ b/R/cmodelmoments.R @@ -28,7 +28,7 @@ #' @slot kurtosis A vector containing the kurtosis(es) of the finite mixture #' model. #' @exportClass cmodelmoments -#' @name cmodelmoments +#' @rdname cmodelmoments-class #' #' @seealso #' * [modelmoments] for the base class @@ -58,6 +58,7 @@ #' #' @param object An `cmodelmoments` object. #' @returns The `higher` slot of the `object`. +#' @exportMethod getHigher #' @noRd #' #' @examples @@ -79,6 +80,7 @@ setMethod("getHigher", "cmodelmoments", function(object) { #' #' @param object An `cmodelmoments` object. #' @returns The `skewness` slot of the `object`. +#' @exportMethod getSkewness #' @noRd #' #' @examples @@ -100,6 +102,7 @@ setMethod("getSkewness", "cmodelmoments", function(object) { #' #' @param object An `cmodelmoments` object. #' @returns The `kurtosis` slot of the `object`. +#' @exportMethod getKurtosis #' @noRd #' #' @examples diff --git a/R/csdatamoments.R b/R/csdatamoments.R index bc4568d..0360826 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -68,7 +68,7 @@ #' Defines a class union such that the object held by a child class can also #' be `NULL`. #' -#' @export +#' @exportClass csdatamomentsOrNULL #' @noRd setClassUnion("csdatamomentsOrNULL", members = c("csdatamoments", "NULL")) @@ -125,7 +125,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn csdatamoments-class Shows a short summary of the object's slots. +#' @noRd setMethod( "show", "csdatamoments", function(object) { @@ -164,6 +164,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `gmoments` slot of the `object`. +#' @exportMethod getGmoments #' @noRd #' #' @examples @@ -195,6 +196,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `WK` slot of the `object`. +#' @exportMethod getWK #' @noRd #' #' @examples @@ -226,6 +228,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `var` slot of the `object`. +#' @exportMethod getVar #' @noRd #' #' @examples @@ -288,6 +291,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `W` slot of the `object`. +#' @exportMethod getW #' @noRd #' #' @examples @@ -319,6 +323,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `T` slot of the `object`. +#' @exportMethod getT #' @noRd #' #' @examples @@ -350,6 +355,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `R` slot of the `object`. +#' @exportMethod getR #' @noRd #' #' @examples @@ -381,6 +387,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `Rtr` slot of the `object`. +#' @exportMethod getRtr #' @noRd #' #' @examples @@ -412,6 +419,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `Rdet` slot of the `object`. +#' @exportMethod getRdet #' @noRd #' #' @examples @@ -443,6 +451,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @returns The `fdata` slot of the `object`. +#' @exportMethod getFdata #' @noRd #' #' @examples diff --git a/R/dataclass.R b/R/dataclass.R index 8d2d261..7e8ac6e 100644 --- a/R/dataclass.R +++ b/R/dataclass.R @@ -345,25 +345,20 @@ setMethod( ### These functions are not exported. ### Checking -### Check fdata/model: 'fdata' must be an object of class -### 'fdata'. Further, this object must be valid and must -### contain data in @y. The 'fdata' object and the 'model' -### object must be consistent to each other, i.e. the 'model' -### object must have defined a distribution in @dist that -### conforms with the dimension @r of the #fdata' object. + #' Checking `fdata` object and `model` object for `dataclass` #' #' For internal usage only. This function checks an `fdata` object and a #' `model` object in regard to consistency. First of all the data dimensions -#' must fit between the two object, meaning that if `@@r>1` in the `fdata` -#' object the model object must possess a `@@dist` slot with an appropriate +#' must fit between the two object, meaning that if `r>1` in the `fdata` +#' object the model object must possess a `@dist` slot with an appropriate #' distribution for multivariate data. The `fdata` object must contain data in -#' its slot `@@y`. As a first safeguard this function checks if the first +#' its slot `y`. As a first safeguard this function checks if the first #' argument is indeed an `fdata` object. #' #' @param fdata.obj An `fdata` object. #' @param model.obj A `model` object containing a specified distribution, -#' parameters and weigths. +#' parameters and weights. #' @return None. If the checks do not run through, an error is thrown. #' @noRd #' diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index 7883768..19156c2 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -25,7 +25,7 @@ #' @slot W A numeric defining the within-group heterogeneity. #' @slot R A numeric defining the coefficient of determination. #' @exportClass exponentialmodelmoments -#' @name exponentialmodelmoments +#' @name exponentialmodelmoments-class #' #' @seealso #' * [modelmoments-class] for the base class for model moments @@ -98,6 +98,7 @@ setMethod( #' @param object An `exponentialmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. +#' @exportMethod show #' @noRd #' @seealso #' * [modelmoments-class] for the base class for model moments @@ -137,6 +138,7 @@ setMethod( #' #' @param object An `exponentialmodelmoments` object. #' @returns The `B` slot of the `object`. +#' @exportMethod getB #' @noRd #' #' @examples @@ -161,6 +163,7 @@ setMethod( #' #' @param object An `exponentialmodelmoments` object. #' @returns The `W` slot of the `object`. +#' @exportMethod getW #' @noRd #' #' @examples @@ -185,6 +188,7 @@ setMethod( #' #' @param object An `exponentialmodelmoments` object. #' @returns The `R` slot of the `object`. +#' @exportMethod getR #' @noRd #' #' @examples diff --git a/R/fdata.R b/R/fdata.R index a5286a4..25b81ba 100644 --- a/R/fdata.R +++ b/R/fdata.R @@ -132,7 +132,6 @@ #' argument `dev` should be put to `FALSE` if the output should be in a file. #' `...` allows the user to pass further arguments to the internal functions. #' -#' ## Slots #' @slot y A matrix containing the observations for finite mixture estimation. #' Can be by column or row depending on the slot `bycolumn`. #' @slot N An integer holding the number of observations. @@ -365,15 +364,10 @@ setMethod( } ) -### Has -### The 'hasSlot()' methods check, if the slot is not NA and returns -### TRUE if it is not NA and FALSE if it is NA. -### If argument 'verbose' is set to TRUE, an error is thrown, if -### the 'fdata' object has not the questioned slot filled. #' Checker method for `y` slot of an `fdata` object. #' #' @description -#' [hasY()] checks, if the object contains `y` data. +#' `hasY()` checks, if the object contains `y` data. #' #' @param object An `fdata` object. #' @param verbose A logical indicating, if the function should print out @@ -381,6 +375,7 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `y` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasY +#' @keywords internal #' #' @examples #' # Generate an fdata object with Poisson data @@ -409,7 +404,7 @@ setMethod( #' Checker method for `S` slot of an `fdata` object. #' #' @description -#' [hasS()] checks, if the object contains `S` data. +#' `hasS()` checks, if the object contains `S` data. #' #' @param object An `fdata` object. #' @param verbose A logical indicating, if the function should print out @@ -417,12 +412,15 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `S` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasS +#' @keywords internal +#' #' @examples #' # Generate an fdata object with Poisson data #' f_data <- fdata(y = rpois(100, 312), sim = TRUE) #' hasS(f_data) #' -#' @seealso [fdata] class for an overview of its slots +#' @seealso +#' * [fdata-class] for the class definition setMethod( "hasS", "fdata", function(object, verbose = FALSE) { @@ -444,7 +442,7 @@ setMethod( #' Checker method for `exp` slot of an `fdata` object. #' #' @description -#' [hasY()] checks, if the object contains `exp` data. +#' `hasExp()` checks, if the object contains `exp` data. #' #' @param object An `fdata` object. #' @param verbose A logical indicating, if the function should print out @@ -452,13 +450,15 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `exp` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasExp +#' @keywords internal #' #' @examples #' # Generate an fdata object with Poisson data #' f_data <- fdata(y = rpois(100, 312), sim = TRUE) #' hasExp(f_data) #' -#' @seealso [fdata] class for an overview of its slots +#' @seealso +#' * [fdata-class] for the class definition setMethod( "hasExp", "fdata", function(object, verbose = FALSE) { @@ -480,7 +480,7 @@ setMethod( #' Checker method for `T` slot of an `fdata` object. #' #' @description -#' [hasY()] checks, if the object contains `T` data. +#' `hasY()` checks, if the object contains `T` data. #' #' @param object An `fdata` object. #' @param verbose A logical indicating, if the function should print out @@ -488,13 +488,14 @@ setMethod( #' @returns Either `FALSE`/`TRUE`, if `verbose` is `FALSE` and the `T` slot is #' empty or filled or a message, if `verbose` is `TRUE`. #' @exportMethod hasT -#' +#' @keywords internal #' @examples #' # Generate an fdata object with Poisson data #' f_data <- fdata(y = rpois(100, 312), sim = TRUE) #' hasT(f_data) #' -#' @seealso [fdata] class for an overview of its slots +#' @seealso +#' * [fdata-class] for the class defintion setMethod( "hasT", "fdata", function(object, verbose = FALSE) { diff --git a/R/groupmoments.R b/R/groupmoments.R index ef4e6b7..1d099b7 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -85,7 +85,7 @@ #' #' @seealso #' * [fdata-class] for the `fdata` class definition -#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' * [groupmoments-class] for the definition of the `groupmoments` #' class #' * [datamoments-class] for the base class for data moments #' * [datamoments()] for the constructor of any object of the `datamoments` @@ -149,7 +149,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn groupmoments-class Shows a short summary of the object's slots +#' @noRd setMethod( "show", "groupmoments", function(object) { diff --git a/R/mcmcestfix.R b/R/mcmcestfix.R index 38633e1..40060c2 100644 --- a/R/mcmcestfix.R +++ b/R/mcmcestfix.R @@ -50,11 +50,11 @@ #' @slot sdpost A named list containing the standard deviations of the #' parameter estimates from the posterior distributions. #' @exportClass mcmcestfix -#' @rdname mcmcest-class +#' @rdname mcmcestfix-class #' @keywords internal #' #' @seealso -#' * [mcmcestind][mcmcest_class] for the equivalent class for models with +#' * [mcmcestind-class] for the equivalent class for models with #' unknown indicators #' * [mcmcestimate()] to calculate point estimates .mcmcestfix <- setClass("mcmcestfix", @@ -99,6 +99,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show +#' @noRd setMethod( "show", "mcmcestfix", function(object) { @@ -134,7 +135,7 @@ setMethod( #' Shows an advanced summary of an `mcmcestfix` object. #' -#' Calling [show()] on an `mcmcestfix` object gives an advanced overview +#' Calling [Summary()] on an `mcmcestfix` object gives an advanced overview #' of the `mcmcestfix` object. #' #' Note, this method is so far only implemented for mixtures of Poisson @@ -144,6 +145,7 @@ setMethod( #' @returns A console output listing the formatted slots and summary #' information about each of them. #' @exportMethod Summary +#' @noRd setMethod( "Summary", "mcmcestfix", function(x, ..., na.rm = FALSE) { @@ -205,6 +207,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `dist` slot of the `object`. +#' @exportMethod getDist #' @noRd #' #' @examples @@ -240,6 +243,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `K` slot of the `object`. +#' @exportMethod getK #' @noRd #' #' @examples @@ -275,6 +279,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `indicmod` slot of the `object`. +#' @exportMethod getIndicmod #' @noRd #' #' @examples @@ -310,6 +315,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `burnin` slot of the `object`. +#' @exportMethod getBurnin #' @noRd #' #' @examples @@ -345,6 +351,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `M` slot of the `object`. +#' @exportMethod getM #' @noRd #' #' @examples @@ -380,6 +387,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `ranperm` slot of the `object`. +#' @exportMethod getRanperm #' @noRd #' #' @examples @@ -415,6 +423,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `relabel` slot of the `object`. +#' @exportMethod getRelabel #' @noRd #' #' @examples @@ -450,6 +459,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `map` slot of the `object`. +#' @exportMethod getMap #' @noRd #' #' @examples @@ -485,6 +495,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `bml` slot of the `object`. +#' @exportMethod getBml #' @noRd #' #' @examples @@ -520,6 +531,7 @@ setMethod( #' #' @param object An `mcmcestfix` object. #' @returns The `ieavg` slot of the `object`. +#' @exportMethod getIeavg #' @noRd #' #' @examples @@ -551,10 +563,11 @@ setMethod( #' Getter method of `mcmcestfix` class. #' -#' Returns the `ieavg` slot. +#' Returns the `sdpost` slot. #' #' @param object An `mcmcestfix` object. -#' @returns The `ieavg` slot of the `object`. +#' @returns The `sdpost` slot of the `object`. +#' @exportMethod getSdpost #' @noRd #' #' @examples @@ -607,7 +620,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.map.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .pars.map.poisson.Mcmcestfix(obj) @@ -626,7 +639,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.map.poisson.Mcmcestfix" <- function(obj) { parout <- matrix(0, nrow = obj@K, ncol = 2) for (k in seq(1, obj@K)) { @@ -651,7 +664,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.bml.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .pars.bml.poisson.Mcmcestfix(obj) @@ -670,7 +683,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.bml.poisson.Mcmcestfix" <- function(obj) { parout <- matrix(0, nrow = obj@K, ncol = 2) for (k in seq(1, obj@K)) { @@ -695,7 +708,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.ieavg.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .pars.ieavg.poisson.Mcmcestfix(obj) @@ -714,7 +727,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.ieavg.poisson.Mcmcestfix" <- function(obj) { parout <- matrix(0, nrow = obj@K, ncol = 2) for (k in seq(1, obj@K)) { @@ -738,7 +751,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".rownames.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { .rownames.poisson.Mcmcestfix(obj) @@ -757,7 +770,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".rownames.poisson.Mcmcestfix" <- function(obj) { rnames <- rep("", obj@K) for (k in seq(1, obj@K)) { @@ -781,7 +794,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".parnames.Mcmcestfix" <- function(obj) { if (obj@dist == "poisson") { parnames <- c("lambda") diff --git a/R/mcmcestimate.R b/R/mcmcestimate.R index 509f924..d8ad955 100644 --- a/R/mcmcestimate.R +++ b/R/mcmcestimate.R @@ -56,10 +56,10 @@ #' @name mcmcestimate #' #' @seealso -#' * [mcmcestfix][mcmcest_class] for object storing the parameter estimates in -#' case of fixed indicators -#' * [mcmcestfix][mcmcest_class] for object storing the parameter estimates in -#' case of unknown indicators +#' * [mcmcestfix-class] for object storing the parameter estimates in case of +#' fixed indicators +#' * [mcmcestind-class] for object storing the parameter estimates in case of +#' unknown indicators #' * [mcmcoutputperm-class] for classes storing re-labeled #' MCMC samples "mcmcestimate" <- function(mcmcout, method = "kmeans", fdata = NULL, diff --git a/R/mcmcestind.R b/R/mcmcestind.R index 3f9e62c..3581beb 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -37,7 +37,7 @@ #' @keywords internal #' #' @seealso -#' * [mcmcestfix][mcmcest_class] for the parent class with fixed indicators +#' * [mcmcestfix-class] for the parent class with fixed indicators #' * [mcmcestimate()] to calculate point estimates .mcmcestind <- setClass("mcmcestind", representation(eavg = "list"), @@ -56,6 +56,7 @@ #' parameter estimates and is used to dispatch methods for `mcmcest` objects. #' #' @exportClass mcmcest +#' @name mcmcest-class #' @noRd setClassUnion( "mcmcest", @@ -115,7 +116,7 @@ setMethod( # TODO: The Std. Error is the same for both components. #' Shows an advanced summary of an `mcmcestind` object. #' -#' Calling [show()] on an `mcmcestind` object gives an advanced overview +#' Calling [Summary()] on an `mcmcestind` object gives an advanced overview #' of the `mcmcestind` object. #' #' Note, this method is so far only implemented for mixtures of Poisson @@ -202,6 +203,7 @@ setMethod( #' #' @param object An `mcmcestind` object. #' @returns The `eavg` slot of the `object`. +#' @exportMethod getEavg #' @noRd #' #' @examples @@ -251,7 +253,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.map.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.map.poisson.Mcmcestind(obj) @@ -270,7 +272,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.map.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -300,7 +302,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.bml.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.bml.poisson.Mcmcestind(obj) @@ -319,7 +321,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.bml.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -349,7 +351,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.ieavg.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.ieavg.poisson.Mcmcestind(obj) @@ -368,7 +370,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.ieavg.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -399,7 +401,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.eavg.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .pars.eavg.poisson.Mcmcestind(obj) @@ -418,7 +420,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".pars.eavg.poisson.Mcmcestind" <- function(obj) { K <- obj@K parout <- matrix(0, nrow = 2 * K, ncol = 2) @@ -434,7 +436,7 @@ setMethod( return(parout) } -#' Create summary row names +#' Create row names for summary #' #' @description #' For internal usage only. This function generates row names for the explicit @@ -448,7 +450,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".rownames.Mcmcestind" <- function(obj) { if (obj@dist == "poisson") { .rownames.poisson.Mcmcestind(obj) @@ -467,7 +469,7 @@ setMethod( #' @noRd #' #' @seealso -#' * [summary][mcmcest_class] for the calling function +#' * [Summary()] for the calling function ".rownames.poisson.Mcmcestind" <- function(obj) { rnames <- rep("", 2 * obj@K) for (k in seq(1, obj@K)) { diff --git a/R/mcmcextract.R b/R/mcmcextract.R index 3aa02f2..7430ba7 100644 --- a/R/mcmcextract.R +++ b/R/mcmcextract.R @@ -14,6 +14,7 @@ #' sampling. #' #' @exportClass mcmcextract +#' @name mcmcextract-class #' @noRd .mcmcextract <- setClass("mcmcextract", representation( diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index aba868d..2035cf4 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -75,7 +75,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputbase-class Shows a short summary of the object's slots +#' @noRd setMethod( "show", "mcmcoutputbase", function(object) { @@ -146,7 +146,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -220,7 +220,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -272,7 +272,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -323,7 +323,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point processes of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -370,7 +370,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representations of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -417,7 +417,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -486,7 +486,7 @@ setMethod( #' @param object An `mcmcoutput` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputbase", @@ -509,6 +509,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `weight` slot of the `object`. +#' @exportMethod getWeight #' @noRd #' #' @examples @@ -543,6 +544,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `entropy` slot of the `object`. +#' @exportMethod getEntropy #' @noRd #' #' @examples @@ -577,6 +579,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `ST` slot of the `object`. +#' @exportMethod getST #' @noRd #' #' @examples @@ -645,6 +648,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `NK` slot of the `object`. +#' @exportMethod getNK #' @noRd #' #' @examples @@ -679,6 +683,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `clust` slot of the `object`. +#' @exportMethod getClust #' @noRd #' #' @examples diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index da60976..4568671 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -15,9 +15,9 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -# TODO: Change to non-hierarchical prior in examples -#' Finmix `mcmcoutput` base class for fixed indicators + +#' Finmix `mcmcoutputfix` class #' #' @description #' This class defines the basic slots for the MCMC sampling output for a @@ -38,7 +38,7 @@ #' @slot prior The `prior` object defining the prior distributions for the #' component parameters that has been used in MCMC sampling. #' @exportClass mcmcoutputfix -#' @rdname mcmcoutput-class +#' @rdname mcmcoutputfix-class #' @keywords internal .mcmcoutputfix <- setClass("mcmcoutputfix", representation( @@ -472,6 +472,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod subseq +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputfix", @@ -510,6 +511,7 @@ setMethod( #' @param object An `mcmcoutput` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( @@ -552,7 +554,8 @@ setMethod( #' mixture should be extracted. #' @return An object class `mcmcextract` containing all samples of an extracted #' dimension. -#' @export +#' @noRd +#' @exportMethod extract setMethod( "extract", signature( object = "mcmcoutputfix", @@ -596,6 +599,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `M` slot of the `object`. +#' @exportMethod getM #' @noRd #' #' @examples @@ -629,6 +633,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `burnin` slot of the `object`. +#' @exportMethod getBurnin #' @noRd #' #' @examples @@ -662,6 +667,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `ranperm` slot of the `object`. +#' @exportMethod getRanperm #' @noRd #' #' @examples @@ -695,6 +701,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `par` slot of the `object`. +#' @exportMethod getPar #' @noRd #' #' @examples @@ -728,6 +735,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `log` slot of the `object`. +#' @exportMethod getLog #' @noRd #' #' @examples @@ -761,6 +769,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `model` slot of the `object`. +#' @exportMethod getModel #' @noRd #' #' @examples @@ -795,6 +804,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `prior` slot of the `object`. +#' @exportMethod getPrior #' @noRd #' #' @examples diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index a60523d..4f67db4 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -435,6 +435,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod subseq +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputfixhier", @@ -463,6 +464,7 @@ setMethod( #' @param object An `mcmcoutput` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( @@ -487,6 +489,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `hyper` slot of the `object`. +#' @exportMethod getHyper #' @noRd #' #' @examples diff --git a/R/mcmcoutputfixhierpost.R b/R/mcmcoutputfixhierpost.R index e50d925..6fc23b3 100644 --- a/R/mcmcoutputfixhierpost.R +++ b/R/mcmcoutputfixhierpost.R @@ -112,6 +112,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces +#' @noRd #' #' @examples #' \dontrun{ @@ -217,6 +218,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens +#' @noRd #' #' @examples #' \dontrun{ @@ -267,6 +269,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @noRd #' #' @examples #' \dontrun{ @@ -317,6 +320,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep +#' @noRd #' #' @examples #' \dontrun{ @@ -367,6 +371,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens +#' @noRd #' #' @examples #' \dontrun{ @@ -417,7 +422,9 @@ setMethod( #' @param object An `mcmcoutput` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @exportMethod subseq #' @noRd +#' #' @export subseq setMethod( "subseq", signature( @@ -450,6 +457,7 @@ setMethod( #' @param object An `mcmcoutput` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( diff --git a/R/mcmcoutputfixpost.R b/R/mcmcoutputfixpost.R index 846e8d0..d44b65b 100644 --- a/R/mcmcoutputfixpost.R +++ b/R/mcmcoutputfixpost.R @@ -409,6 +409,7 @@ setMethod( #' @param object An `mcmcoutput` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @exportMethod subseq #' @noRd setMethod( "subseq", signature( @@ -440,6 +441,7 @@ setMethod( #' @param object An `mcmcoutput` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( @@ -472,6 +474,7 @@ setMethod( #' #' @param object An `mcmcoutputfixpost` object. #' @returns The `post` slot of the `object`. +#' @exportMethod getPost #' @noRd #' #' @examples diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index ebfe9f4..f53ce25 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -443,6 +443,7 @@ setMethod( #' @param object An `mcmcoutput` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. +#' @exportMethod swapElements #' @noRd setMethod( "subseq", signature( @@ -471,6 +472,7 @@ setMethod( #' @param object An `mcmcoutput` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( @@ -490,6 +492,7 @@ setMethod( #' #' @param object An `mcmcoutputhier` object. #' @returns The `hyper` slot of the `object`. +#' @exportMethod getHyper #' @noRd #' #' @examples diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index dda1be1..b3de46a 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -57,7 +57,7 @@ #' @description #' The `mcmcoutput` class stores all MCMC samples and corresponding information. #' -#' @detail +#' @details #' Calling [mixturemcmc()] on appropriate input arguments performs MCMC #' sampling and returns an `mcmcoutput` object that stores all samples and #' corresponding information like hyper-parameters, the finite mixture model @@ -120,7 +120,6 @@ #' that this function can only be applied for mixtures of two components. See #' [plotPostDens()] for further information. #' -#' ## Slots #' @slot M An integer defining the number of iterations in MCMC sampling. #' @slot burnin An integer defining the number of iterations in the burn-in #' phase of MCMC sampling. These number of sampling steps are not stored @@ -572,7 +571,9 @@ setMethod( #' #' @param object An `mcmcoutputhierpost` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. -#' @return An `mcmcoutputhierpost` object containing the values from the sub-chain. +#' @return An `mcmcoutputhierpost` object containing the values from the +#' sub-chain. +#' @exportMethod subseq #' @noRd setMethod( "subseq", signature( @@ -604,6 +605,7 @@ setMethod( #' @param object An `mcmcoutputhierpost` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutputhierpost` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( diff --git a/R/mcmcoutputpermbase.R b/R/mcmcoutputpermbase.R index f725dea..bf53c1a 100644 --- a/R/mcmcoutputpermbase.R +++ b/R/mcmcoutputpermbase.R @@ -126,8 +126,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermbase-class Shows a short summary of the object's -#' slots +#' @noRd setMethod( "show", "mcmcoutputpermbase", function(object) { @@ -226,7 +225,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputpermbase-class +#' @noRd #' #' @examples #' \dontrun{ @@ -306,8 +305,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputpermbase-class Plot histograms of the parameters and -#' weights +#' @noRd #' #' @examples #' \dontrun{ @@ -362,7 +360,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputpermbase-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -418,8 +416,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputpermbase-class Plots point process for the component -#' parameters +#' @noRd #' #' @examples #' \dontrun{ @@ -477,8 +474,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputpermbase-class Plots sampling representations of the -#' component parameters +#' @noRd #' #' @examples #' \dontrun{ @@ -536,8 +532,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputpermbase-class Plots the posterior density of the -#' component parameters +#' @noRd #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfix.R b/R/mcmcoutputpermfix.R index 22287b7..55f9514 100644 --- a/R/mcmcoutputpermfix.R +++ b/R/mcmcoutputpermfix.R @@ -153,7 +153,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @describeIn mcmcoutputpermfix-class +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -225,7 +225,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @describeIn mcmcoutputpermfix-class +#' @noRd #' #' @examples #' \dontrun{ @@ -281,7 +281,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @describeIn mcmcoutputpermfix-class +#' @noRd #' #' @examples #' \dontrun{ @@ -337,7 +337,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @describeIn mcmcoutputpermfix-class +#' @noRd #' #' @examples #' \dontrun{ @@ -393,7 +393,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling represetnation of the MCMC samples. #' @exportMethod plotSampRep -#' @describeIn mcmcoutputpermfix-class +#' @noRd #' #' @examples #' \dontrun{ @@ -449,7 +449,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @describeIn mcmcoutputpermfix-class +#' @noRd #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index 902642e..03125c9 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -99,8 +99,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn mcmcoutputpermfixhier-class Shows a short summary of the -#' object's slots +#' @noRd setMethod( "show", "mcmcoutputpermfixhier", function(object) { diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index 739a945..420f1d3 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -26,7 +26,7 @@ #' @keywords internal #' @seealso #' * [mcmcoutputfixpost-class] for the parent class -#' * [mcmcpermfixpost] for the parent class +#' * [mcmcpermfixpost-class] for the parent class #' * [mcmcpermute()] for permuting MCMC samples .mcmcoutputpermfixpost <- setClass("mcmcoutputpermfixpost", contains = c( diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index f13ef6e..8f6eb37 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -139,7 +139,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @keywords internal +#' @noRd setMethod( "show", "mcmcoutputpermhierpost", function(object) { @@ -259,7 +259,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @keywords internal +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -339,7 +339,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @keywords internal +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -394,7 +394,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @keywords internal +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -448,7 +448,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @keywords internal +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -502,7 +502,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotSampRep -#' @keywords internal +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -556,7 +556,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @keywords internal +#' @noRd #' #' @examples #' # Define a Poisson mixture model with two components. @@ -656,7 +656,6 @@ setMethod( #' that this function can only be applied for mixtures of two components. See #' [plotPostDens()] for further information. #' -#' ## Slots #' @slot Mperm An integer defining the number of permuted MCMC samples. #' @slot parperm A named list containing the permuted component parameter #' samples from MCMC sampling. @@ -778,7 +777,7 @@ NULL #' Plot histograms of the parameters and weights #' #' @description -#' #' `plotHist()` is a class method for [mcmcoutput][mcmcoutput-class] and +#' `plotHist()` is a class method for [mcmcoutput][mcmcoutput-class] and #' [mcmcoutputperm][mcmcoutputperm-class] objects. For the former class it #' plots histograms of MCMC samples and for the latter of the corresponding #' permuted samples coming from relabeling. @@ -834,7 +833,7 @@ NULL #' @title Plot densities of the parameters and weights #' #' @description -#' #' `plotDens()` is a class method for [mcmcoutput][mcmcoutput-class] and +#' `plotDens()` is a class method for [mcmcoutput][mcmcoutput-class] and #' [mcmcoutputperm][mcmcoutputperm-class] objects. For the former class it #' plots densities of MCMC samples and for the latter of the corresponding #' permuted samples coming from relabeling. @@ -944,4 +943,221 @@ NULL #' * [plotDens()] for plotting densities of sampled values #' * [plotSampRep()] for plotting sampling representations of sampled values #' * [plotPostDens()] for plotting posterior densities for sampled values +NULL + +#' Plot the sampling representation of component parameters +#' +#' @description +#' Calling [plotSampRep()] on an object of class `mcmcoutput` or +#' `mcmcoutputperm` plots the sampling representation of the sampled component +#' parameters from MCMC sampling, either the original parameters or the +#' relabeled ones (`mcmcoutputperm`). +#' +#' @details +#' To visualize the posterior density of the component parameters the MCMC +#' draws are used as a sampling representation. Each combination of component +#' parameters is plotted in a scatter to visualize the contours of the +#' posterior density. For bivariate component parameters this could also be +#' done by estimating and plotting the density directly, but for +#' higher-dimensional parameter vectors this is not anymore possible and so +#' sampling representations define a proper solution for visualization and +#' allow us to study how a specific dimension of the parameter vector differs +#' among the various components of the mixture distribution. If this element +#' is significantly different among components we will observe `K(K-1)` modes +#' in the sampling representation. On the other side, if this element is +#' mainly the same among the components of the mixture, we will rather observe +#' a single cluster. +#' +#' As Frühwirth-Schnatter (2006) writes, "One informal method for diagnosing +#' mixtures is mode hunting in the mixture posterior density +#' (Frühwirth-Schnatter, 2001b). It is based on the observation that with an +#' increasing number of observations, the mixture likelihood function has `K!` +#' dominant modes if the data actually arise from a finite mixture distribution +#' with `K` components, and that less than `K!` dominant modes are present if +#' the finite mixture model is overfitting the number of components." The +#' sampling representation helps to perform this mode hunting in practice. +#' +#' Note that this method for `mcmcoutputperm` objects is only implemented for +#' mixtures of Poisson and Binomial distributions. +#' +#' @param x An `mcmcoutput` or `mcmcoutputperm` object containing all sampled +#' values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return The sampling representation of the MCMC samples. +#' @rdname plotSampRep-method +#' @name plotSampRep +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotSampRep(f_output) +#' +#' @references +#' * Frühwirth-Schnatter (2006), "Finite Mixture and Markov Switching Models" +#' * Frühwirth-Schnatter, S. (2001b), "Markov chain Monte Carlo estimation of +#' classical and dynamic switching and mixture models." Journal of the +#' American Statistical Association 96, 194–209. +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting the point process of sampled values +#' * [plotPostDens()] for plotting posterior densities for sampled values +NULL + +#' Plot the posterior density of component parameters +#' +#' @description +#' Calling [plotPostDens()] on an object of class `mcmcoutput` or +#' `mcmcoutputperm` plots the posterior density of the sampled component +#' parameters from MCMC sampling, either the original parameters or the +#' relabeled ones (`mcmcoutputperm`). +#' +#' @details +#' Next to sampling representations and the point process of MCMC samples the +#' posterior density of component parameters can also be plotted directly for +#' finite mixture distributions with ` K=2` components and a single parameter. +#' The posterior density will always be bimodal due to to label-switching in +#' the MCMC sampling. This could change when considering a relabeld MCMC sample +#' (`mcmcoutputperm` object). +#' +#' Note that this method for `mcmcoutputperm` objects is only implemented for +#' mixtures of Poisson and Binomial distributions. +#' +#' @param x An `mcmcoutput` or `mcmcoutputperm` object containing all sampled +#' values. +#' @param dev A logical indicating, if the plots should be shown by a graphical +#' device. If plots should be stored to a file set `dev` to `FALSE`. +#' @param ... Further arguments to be passed to the plotting function. +#' @return The posterior density of the MCMC samples. +#' @rdname plotPostDens-method +#' @name plotPostDens +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' plotPostDens(f_output) +#' +#' @seealso +#' * [mixturemcmc()] for performing MCMC sampling +#' * [mcmcpermute()] for permuting MCMC samples +#' * [plotTraces()] for plotting the traces of sampled values +#' * [plotHist()] for plotting histograms of sampled values +#' * [plotDens()] for plotting densities of sampled values +#' * [plotPointProc()] for plotting the point process of sampled values +#' * [plotSampRep()] for plotting the sampling representation for sampled values +NULL + +#' Extract sub-chains from MCMC samples +#' +#' @description +#' Calling [subseq()] on an `mcmcoutput` or `mcmcoutputperm` object creates a +#' sub-chain defined by the argument `index`. Sub-chains can be used to further +#' investigate convergence of MCMC sampling. +#' +#' @details +#' Running MCMC sampling should by time result in a roughly stationary sequence +#' of random draws. If trace plots do not show this stationary pattern MCMC +#' sampling should be run with a longer burn-in period until the sampling +#' distribution has converged. Another possibility is to remove the first draws. +#' Removing the first draws can be achieved by calling `subseq()` on the object +#' holding the MCMC samples. +#' In case of autocorrelations in the traces it is also possible to extract +#' every `t`-th value by setting the `index` argument accordingly. +#' +#' @param object An `mcmcoutput` or `mcmcoutputperm` object containing samples +#' from MCMC samples. +#' @param index A logical `array` of dimension `Mx1` defining the schema for +#' the sub-chain. +#' @return An `mcmcoutput` or `mcmcoutputperm` object containing the +#' sub-chained MCMC samples. +#' @rdname subseq-method +#' @name subseq +#' +#' @examples +#' # Define a mixture of Poisson distributions. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Define a sub-chain randomly. +#' index <- array(sample(c(FALSE, TRUE), size = getM(f_output), replace = TRUE)) +#' # Extract the sub-chain. +#' subseq(f_output, index) +#' +#' @seealso +#' * [mcmcoutput-class] for the class storing MCMC samples +#' * [mcmcoutputperm-class] for the corresponding class for re-labeled MCMC +#' samples +#' * [plotTraces()] for plotting traces to be used for a convergence analysis +#' * [swapElements()] for swapping elements in MCMC samples +NULL + +#' Swap elements of MCMC samples +#' +#' @description +#' Calling `swapElements()` on an `mcmcoutput` object +#' swaps all labels by the schema given in the `index` argument. +#' +#' @details +#' This function is merely a utility function that simplifies relabeling for +#' users and developers. For relabeling the labels have to be permuted and +#' depending on the MCMC sampling chosen there could be a lot of different +#' slots that need to be permuted. `swapElements()` swaps the elements in any +#' slot that needs to be relabeled. +#' +#' @param object An `mcmcoutput` object containing the +#' sampled values. +#' @param index An array specifying the extraction of the values. +#' @return An `mcmcoutput` object with swapped elements. +#' @rdname swapElements-method +#' @name swapElements +#' +#' @examples +#' \dontrun{ +#' # Generate a model of Poisson distributions. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' index <- matrix(c(1, 2), nrow = getM(f_output) + 1, +#' ncol = 2)[1:getM(f_output),] +#' swapElements(f_output, index) +#' } +#' +#' @seealso +#' * [mcmcoutput-class] for the class definition +#' * [subseq()] for generating sub-chains from MCMC samples +#' * [mcmcpermute()] for a calling function NULL \ No newline at end of file diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index 6bb1b36..4424385 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -419,6 +419,8 @@ setMethod( #' @param object An `mcmcoutputpost` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutputpost` object containing the values from the sub-chain. +#' @exportMethod subseq +#' @noRd setMethod( "subseq", signature( object = "mcmcoutputpost", @@ -449,6 +451,7 @@ setMethod( #' @param object An `mcmcoutputpost` object containing the sampled values. #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutputpost` object with swapped elements. +#' @exportMethod swapElements #' @noRd setMethod( "swapElements", signature( @@ -477,10 +480,11 @@ setMethod( #' Getter method of `mcmcoutputhier` class. #' -#' Returns the `hyper` slot. +#' Returns the `post` slot. #' #' @param object An `mcmcoutputhier` object. -#' @returns The `hyper` slot of the `object`. +#' @returns The `post` slot of the `object`. +#' @exportMethod getPost #' @noRd #' #' @examples diff --git a/R/mcmcpermfix.R b/R/mcmcpermfix.R index b21a722..a5f50d9 100644 --- a/R/mcmcpermfix.R +++ b/R/mcmcpermfix.R @@ -68,8 +68,8 @@ #' #' @param object An `mcmcpermfix` object. #' @returns The `Mperm` slot of the `object`. -#' @aliases mcmcpermfix_class, mcmcpermfixhier_class, mcmcpermfixpost_class, -#' mcmcpermfixhierpost +#' @exportMethod getMperm +#' @noRd #' #' @examples #' \dontrun{getMperm(mcmcperm)} @@ -90,6 +90,7 @@ setMethod( #' #' @param object An `mcmcpermfix` object. #' @returns The `parperm` slot of the `object`. +#' @exportMethod getParperm #' @noRd #' #' @examples @@ -111,6 +112,7 @@ setMethod( #' #' @param object An `mcmcpermfix` object. #' @returns The `logperm` slot of the `object`. +#' @exportMethod getLogperm #' @noRd #' #' @examples diff --git a/R/mcmcpermfixhier.R b/R/mcmcpermfixhier.R index 011eb91..7e19e7c 100644 --- a/R/mcmcpermfixhier.R +++ b/R/mcmcpermfixhier.R @@ -36,11 +36,9 @@ #' @rdname mcmcpermfixhier-class #' #' @seealso -#' * \code{\link{mcmcpermute()}} for the calling function -#' -#' * \code{\link{mcmcpermfix-class}} for the parent class definition -#' -#' * \code{\link{mcmcpermindhier-class}} for the corresponding class for models +#' * [mcmcpermute()] for the calling function +#' * [mcmcpermfix-class] for the parent class definition +#' * [mcmcpermindhier-class] for the corresponding class for models #' with unknown indicators .mcmcpermfixhier <- setClass("mcmcpermfixhier", representation(hyperperm = "list"), @@ -60,6 +58,7 @@ #' #' @param object An `mcmcpermfixhier` object. #' @returns The `hyperperm` slot of the `object`. +#' @exportMethod getHyperperm #' @noRd #' #' @examples diff --git a/R/mcmcpermfixpost.R b/R/mcmcpermfixpost.R index 2bd4f3e..d838fe1 100644 --- a/R/mcmcpermfixpost.R +++ b/R/mcmcpermfixpost.R @@ -59,6 +59,7 @@ #' #' @param object An `mcmcpermfixpost` object. #' @returns The `postperm` slot of the `object`. +#' @exportMethod getPostperm #' @noRd #' #' @examples diff --git a/R/mcmcpermind.R b/R/mcmcpermind.R index a807fa1..3192787 100644 --- a/R/mcmcpermind.R +++ b/R/mcmcpermind.R @@ -47,11 +47,12 @@ #' @slot NKperm An `array` of dimension `Mperm x K` containing the numbers #' of observations assigned to each component. #' @exportClass mcmcpermind -#' @describeIn mcmcperm_class +#' @rdname mcmcpermind-class +#' @keywords internal #' #' @seealso #' * [mcmcpermute()] for the calling function -#' * [mcmcperfix][mcmcperm_class] for the corresponding class for models with +#' * [mcmcpermfix-class] for the corresponding class for models with #' fixed indicators .mcmcpermind <- setClass("mcmcpermind", representation( @@ -85,6 +86,7 @@ #' #' @param object An `mcmcpermind` object. #' @returns The `relabel` slot of the `object`. +#' @exportMethod getRelabel #' @noRd #' #' @examples @@ -106,6 +108,7 @@ setMethod( #' #' @param object An `mcmcpermind` object. #' @returns The `weightperm` slot of the `object`. +#' @exportMethod getWeightperm #' @noRd #' #' @examples @@ -127,6 +130,7 @@ setMethod( #' #' @param object An `mcmcpermind` object. #' @returns The `entropyperm` slot of the `object`. +#' @exportMethod getEntropyperm #' @noRd #' #' @examples @@ -148,6 +152,7 @@ setMethod( #' #' @param object An `mcmcpermind` object. #' @returns The `STperm` slot of the `object`. +#' @exportMethod getSTperm #' @noRd #' #' @examples @@ -169,6 +174,7 @@ setMethod( #' #' @param object An `mcmcpermind` object. #' @returns The `Sperm` slot of the `object`. +#' @exportMethod getSperm #' @noRd #' #' @examples @@ -190,6 +196,7 @@ setMethod( #' #' @param object An `mcmcpermind` object. #' @returns The `NKperm` slot of the `object`. +#' @exportMethod getNKperm #' @noRd #' #' @examples diff --git a/R/mcmcpermindhier.R b/R/mcmcpermindhier.R index 2d8bfbc..c6bbffe 100644 --- a/R/mcmcpermindhier.R +++ b/R/mcmcpermindhier.R @@ -33,12 +33,13 @@ #' @slot hyperperm A named list containing the (permuted) parameters of the #' hierarchical prior. #' @exportClass mcmcpermindhier -#' @describeIn mcmcperm_class +#' @rdname mcmcpermindhier-class +#' @keywords internal #' #' @seealso -#' * \code{\link{mcmcpermute()}} for the calling function -#' * \code{\link{mcmcpermind}} for the parent class definition -#' * \code{\link{mcmcpermfixhier}} for the corresponding class for models with +#' * [mcmcpermute()] for the calling function +#' * [mcmcpermind-class] for the parent class definition +#' * [mcmcpermfixhier-class] for the corresponding class for models with #' fixed indicators .mcmcpermindhier <- setClass("mcmcpermindhier", representation(hyperperm = "list"), @@ -58,6 +59,7 @@ #' #' @param object An `mcmcpermindhier` object. #' @returns The `hyperperm` slot of the `object`. +#' @exportMethod getHyperperm #' @noRd #' #' @examples diff --git a/R/mcmcpermindpost.R b/R/mcmcpermindpost.R index 00b9dc9..37f5cdc 100644 --- a/R/mcmcpermindpost.R +++ b/R/mcmcpermindpost.R @@ -31,12 +31,13 @@ #' @slot postperm A named list containing a named list `par` with array(s) of #' parameters from the posterior density. #' @exportClass mcmcpermindpost -#' @describeIn mcmcperm_class +#' @rdname mcmcpermindpost-class +#' @keywords internal #' #' @seealso #' * [mcmcpermute()] for the calling function -#' * [mcmcpermind][mcmcperm_class] for the parent class definition -#' * [mcmcpermfixpost][mcmcperm_class] for the corresponding class for models +#' * [mcmcpermind-class] for the parent class definition +#' * [mcmcpermfixpost-class] for the corresponding class for models #' with fixed indicators .mcmcpermindpost <- setClass("mcmcpermindpost", representation(postperm = "list"), @@ -56,10 +57,11 @@ #' #' @param object An `mcmcpermindpost` object. #' @returns The `postperm` slot of the `object`. +#' @exportMethod getPostperm #' @noRd #' #' @examples -#' \dontrun{getMperm(mcmcperm)} +#' \dontrun{getPostperm(mcmcperm)} #' #' @seealso #' * [mcmcoutputpermpost-class] for the inheriting class diff --git a/R/mcmcpermute.R b/R/mcmcpermute.R index 309c7ab..2407a53 100644 --- a/R/mcmcpermute.R +++ b/R/mcmcpermute.R @@ -46,7 +46,6 @@ #' log-likelihood values) of the permuted samples. #' #' @export mcmcpermute -#' @rdname mcmcpermute #' @import nloptr #' #' @examples diff --git a/R/model.R b/R/model.R index 54a4e88..5c1ea27 100644 --- a/R/model.R +++ b/R/model.R @@ -15,11 +15,47 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -#' An S4 class to represent a finite mixture model +#' Finmix `model` class #' #' @description #' This class specifies a finite mixture model. Entities are created from it by -#' calling its constructor [model()]. +#' calling its constructor [model()]. +#' +#' @details +#' A finite mixture model in the ` finmix` package is defined by its number of +#' components `K`, the component distributions `dist`, the data dimension `r` +#' and an indicator defining, if the model has fixed or unknown indicators. +#' Finite mixture models for the following distributions can be constructed: +#' +#' * Poisson, +#' * Conditional Poisson, +#' * Exponential, +#' * Binomial, +#' * Normal, +#' * Multivariate Normal, +#' * Student-t, +#' * Multivariate Student-t. +#' +#' Using the constructor [model()] a finite mixture model can be created, the +#' default being a mixture model of Poisson distributions. +#' +#' ## Fully defined finite mixture models +#' A fully defined finite mixture model contains next to the distribution and +#' the components also weights and parameters. The weights are defined in slot +#' `weight` and must be of class ` matrix` with as many weights as there are +#' components in the mixture model (dimension `Kx1`). Parameters are defined in +#' a ` list` named `par`. The elements of this list depend on the chosen +#' distribution in slot `dist`: +#' +#' * Poisson: A `matrix` named `lambda` of dimension `Kx1` holding the rate +#' parameters. +#' * Exponential: A `matrix` named `lambda` of dimension `Kx1` holding the rate +#' parameters. +#' * Binomial: A `matrix` of dimension `Kx1` named `p` storing the +#' probabilities. +#' +#' +#' #' #' @slot dist A character, defining the distribution family. Possible choices #' are binomial, exponential, normal, normult, poisson, student, and studmult. @@ -262,28 +298,31 @@ setMethod( #' Simulates data from a model. #' -#' \code{simulate} simulates values for a specified mixture model in an -#' S4 \code{model} object. +#' `simulate()` simulates values for a specified mixture model in an +#' S4 `model` object. #' #' @param model An S4 model object with specified parameters and weights. #' @param N An integer specifying the number of values to be simulated. -#' @param varargin An S4 fdata object with specified variable dimensions. +#' @param varargin An S4 fdata object with specified variable dimensions, `r` +#' and repetitions `T`. #' @param seed An integer specifying the seed for the RNG. -#' \code{r} and repetitions \code{T}. #' @return An S4 fdata object holding the simulated values. #' @exportMethod simulate -#' @describeIn model_class Simulates data from a finite mixture model +#' @keywords internal #' -#' @seealso \code{model}, \code{fdata} #' @examples #' \dontrun{ #' f_data <- simulate(model, 100) #' } +#' +#' @seealso +#' * [model-class] for the class definition +#' * [fdata-class] for the class defining `finmix` data objects setMethod( "simulate", "model", function(model, N = 100, varargin, seed = 0) { ## TODO: Check model for parameters. Check varargin for dimension. Check - ## model anf varargin for consistency. + ## model and varargin for consistency. if (!missing(seed)) { set.seed(seed) } ## Implemented maybe finmixOptions with a state variable seed diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index e71ef7c..af96571 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -25,7 +25,7 @@ #' @slot W A numeric defining the within-group heterogeneity. #' @slot R A numeric defining the coefficient of determination. #' @exportClass normultmodelmoments -#' @name normultmodelmoments +#' @name normultmodelmoments-class #' #' @seealso #' * [modelmoments-class] for the base class for model moments @@ -102,6 +102,7 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. +#' @exportMethod show #' @noRd #' @seealso #' * [modelmoments-class] for the base class for model moments @@ -161,6 +162,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @returns The `B` slot of the `object`. +#' @exportMethod getB #' @noRd #' #' @examples @@ -188,6 +190,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @returns The `W` slot of the `object`. +#' @exportMethod getW #' @noRd #' #' @examples @@ -215,6 +218,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @returns The `Rdet` slot of the `object`. +#' @exportMethod getRdet #' @noRd #' #' @examples @@ -242,6 +246,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @returns The `Rtr` slot of the `object`. +#' @exportMethod getRtr #' @noRd #' #' @examples @@ -268,6 +273,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @returns The `Corr` slot of the `object`. +#' @exportMethod getCorr #' @noRd #' #' @examples diff --git a/R/poissonmodelmoments.R b/R/poissonmodelmoments.R index 8060791..20a8fe4 100644 --- a/R/poissonmodelmoments.R +++ b/R/poissonmodelmoments.R @@ -21,14 +21,12 @@ #' distributions. Note that this class is not directly used, but indirectly #' when calling the `modelmoments` constructor [modelmoments()]. #' -#' @slot B A numeric defining the between-group heterogeneity. -#' @slot W A numeric defining the within-group heterogeneity. -#' @slot R A numeric defining the coefficient of determination. #' @exportClass poissonmodelmoments #' @rdname poissonmodelmoments-class #' @keywords internal #' #' @seealso +#' * [dmodelmoments-class] for the parent class #' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes .poissonmodelmoments <- setClass("poissonmodelmoments", @@ -89,6 +87,7 @@ setMethod( #' @param object An `poissonmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. +#' @exportMethod show #' @noRd #' @seealso #' * [modelmoments-class] for the base class for model moments diff --git a/R/prior.R b/R/prior.R index 960698e..4652ef5 100644 --- a/R/prior.R +++ b/R/prior.R @@ -176,7 +176,7 @@ #' @param model A `model` object containing the specifications for the model. #' @param verbose A logical indicating, if the output should be verbose. #' @exportMethod hasPriorPar -#' @describeIn prior-class Checks for parameters in `prior` object +#' @noRd #' #' @examples #' # Define a Poisson mixture model. @@ -204,14 +204,15 @@ setMethod( #' Checks for parameters in a `prior` object #' #' @description -#' Calling [hasPriorWeight()] checks if `model`-appropriate weight parameters +#' Calling `hasPriorWeight()` checks if `model`-appropriate weight parameters #' are stored in the `prior` object. #' #' @param object A `prior` object containing the specifications for the prior. #' @param model A `model` object containing the specifications for the model. #' @param verbose A logical indicating, if the output should be verbose. #' @exportMethod hasPriorWeight -#' @describeIn prior-class Checks for prior weights in `prior` object +#' @rdname hasPriorWeight +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model. diff --git a/R/sdatamoments.R b/R/sdatamoments.R index 34f3b1e..4a503b8 100644 --- a/R/sdatamoments.R +++ b/R/sdatamoments.R @@ -129,7 +129,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn sdatamoments_class Shows a summary of an object +#' @noRd setMethod( "show", "sdatamoments", function(object) { diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index ba5725e..6d26921 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -26,11 +26,11 @@ #' @slot W A numeric defining the within-group heterogeneity. #' @slot R A numeric defining the coefficient of determination. #' @exportClass studentmodelmoments -#' @name studentmodelmoments +#' @name studentmodelmoments-class #' #' @seealso -#' * \code{\link{modelmoments_class}} for the base class for model moments -#' * \code{\link{modelmoments}} for the constructor of `modelmoments` classes +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of `modelmoments` classes .studentmodelmoments <- setClass("studentmodelmoments", representation( B = "numeric", @@ -99,6 +99,7 @@ setMethod( #' @param object An `studentmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. +#' @exportMethod show #' @noRd #' @seealso #' * [modelmoments-class] for the base class for model moments @@ -144,6 +145,7 @@ setMethod( #' #' @param object An `studentmodelmoments` object. #' @returns The `B` slot of the `object`. +#' @exportMethod getB #' @noRd #' #' @examples @@ -170,6 +172,7 @@ setMethod( #' #' @param object An `studentmodelmoments` object. #' @returns The `W` slot of the `object`. +#' @exportMethod getW #' @noRd #' #' @examples @@ -196,6 +199,7 @@ setMethod( #' #' @param object An `studentmodelmoments` object. #' @returns The `R` slot of the `object`. +#' @exportMethod getR #' @noRd #' #' @examples diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index 86dfac0..5b17c1d 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -25,7 +25,7 @@ #' @slot W A numeric defining the within-group heterogeneity. #' @slot R A numeric defining the coefficient of determination. #' @exportClass studmultmodelmoments -#' @name studmultmodelmoments +#' @name studmultmodelmoments-class #' #' @seealso #' * [modelmoments-class] for the base class for model moments @@ -103,7 +103,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @describeIn studmultmodelmoments Shows a summary of an object +#' @noRd setMethod( "show", "studmultmodelmoments", function(object) { @@ -158,6 +158,7 @@ setMethod( #' @returns The `B` slot of the `object`. #' @noRd #' @exportMethod getB +#' #' @examples #' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) #' means <- matrix(c(-2, -2, 2, 2),nrow = 2) @@ -183,6 +184,7 @@ setMethod( #' #' @param object An `studmultmodelmoments` object. #' @returns The `W` slot of the `object`. +#' @exportMethod getW #' @noRd #' #' @examples @@ -210,6 +212,7 @@ setMethod( #' #' @param object An `studmultmodelmoments` object. #' @returns The `Rdet` slot of the `object`. +#' @exportMethod getRdet #' @noRd #' #' @examples @@ -237,6 +240,7 @@ setMethod( #' #' @param object An `studmultmodelmoments` object. #' @returns The `Rtr` slot of the `object`. +#' @exportMethod getRtr #' @noRd #' #' @examples @@ -264,6 +268,7 @@ setMethod( #' #' @param object An `studmultmodelmoments` object. #' @returns The `Corr` slot of the `object`. +#' @exportMethod getCorr #' @noRd #' #' @examples diff --git a/man/Summary-mcmcestfix-method.Rd b/man/Summary-mcmcestfix-method.Rd deleted file mode 100644 index fa4b9d6..0000000 --- a/man/Summary-mcmcestfix-method.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcestfix.R -\name{Summary,mcmcestfix-method} -\alias{Summary,mcmcestfix-method} -\title{Shows an advanced summary of an \code{mcmcestfix} object.} -\usage{ -\S4method{Summary}{mcmcestfix}(x, ..., na.rm = FALSE) -} -\arguments{ -\item{object}{An \code{mcmcestfix} object.} -} -\value{ -A console output listing the formatted slots and summary -information about each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcestfix} object gives an advanced overview -of the \code{mcmcestfix} object. -} -\details{ -Note, this method is so far only implemented for mixtures of Poisson -distributions. -} diff --git a/man/Summary-mcmcestind-method.Rd b/man/Summary-mcmcestind-method.Rd index f8c3008..828e960 100644 --- a/man/Summary-mcmcestind-method.Rd +++ b/man/Summary-mcmcestind-method.Rd @@ -14,7 +14,7 @@ A console output listing the formatted slots and summary information about each of them. } \description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcestind} object gives an advanced overview +Calling \code{\link[=Summary]{Summary()}} on an \code{mcmcestind} object gives an advanced overview of the \code{mcmcestind} object. } \details{ diff --git a/man/cmodelmoments.Rd b/man/cmodelmoments.Rd deleted file mode 100644 index a1647fb..0000000 --- a/man/cmodelmoments.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cmodelmoments.R -\docType{class} -\name{cmodelmoments} -\alias{cmodelmoments} -\alias{.cmodelmoments} -\title{Finmix \code{cmodelmoments} class} -\description{ -This class defines the general theoretical moments of a finite mixture model -with continuous data. -} -\section{Slots}{ - -\describe{ -\item{\code{higher}}{An array containing the four higher centralized moments of the -(in case of multivariate data marginal) finite mixture.} - -\item{\code{skewness}}{A vector containing the skewness(es) of the finite mixture -model.} - -\item{\code{kurtosis}}{A vector containing the kurtosis(es) of the finite mixture -model.} -}} - -\seealso{ -\itemize{ -\item \link{modelmoments} for the base class -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of any \code{modelmoments} inherited class -} -} diff --git a/man/csdatamoments-class.Rd b/man/csdatamoments-class.Rd index bbed271..ae15df0 100644 --- a/man/csdatamoments-class.Rd +++ b/man/csdatamoments-class.Rd @@ -4,30 +4,11 @@ \name{csdatamoments-class} \alias{csdatamoments-class} \alias{.csdatamoments} -\alias{show,csdatamoments-method} \title{Finmix \code{csdatamoments} class} -\usage{ -\S4method{show}{csdatamoments}(object) -} -\arguments{ -\item{object}{An \code{csdatamoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ Stores moments for indicators of continuous data. Inherited directly from the \linkS4class{sdatamoments} class. - -Calling \code{\link[=show]{show()}} on an \code{csdatamoments} object gives an overview -of the moments of a finite mixture with continuous data. } -\section{Functions}{ -\itemize{ -\item \code{show,csdatamoments-method}: Shows a short summary of the object's slots. -}} - \section{Slots}{ \describe{ diff --git a/man/extract-mcmcoutputfix-numeric-method.Rd b/man/extract-mcmcoutputfix-numeric-method.Rd deleted file mode 100644 index 8e73b46..0000000 --- a/man/extract-mcmcoutputfix-numeric-method.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfix.R -\name{extract,mcmcoutputfix,numeric-method} -\alias{extract,mcmcoutputfix,numeric-method} -\title{Extracts samples from \code{mcmcoutput} object of a multivariate Normal mixture} -\usage{ -\S4method{extract}{mcmcoutputfix,numeric}(object, index) -} -\arguments{ -\item{object}{An \code{mcmcoutput} object from MCMC sampling of a multivariate -Normal mixture model.} - -\item{index}{An numeric indicating which dimension of the multivariate -mixture should be extracted.} -} -\value{ -An object class \code{mcmcextract} containing all samples of an extracted -dimension. -} -\description{ -This function extracts samples from a multivariate Normal mixture output. -} diff --git a/man/getMperm-mcmcpermfix-method.Rd b/man/getMperm-mcmcpermfix-method.Rd deleted file mode 100644 index bea434a..0000000 --- a/man/getMperm-mcmcpermfix-method.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcpermfix.R -\name{getMperm,mcmcpermfix-method} -\alias{getMperm,mcmcpermfix-method} -\alias{mcmcpermfix_class,} -\alias{mcmcpermfixhier_class,} -\alias{mcmcpermfixpost_class,} -\alias{mcmcpermfixhierpost} -\title{Getter method of \code{mcmcpermfix} class.} -\usage{ -\S4method{getMperm}{mcmcpermfix}(object) -} -\arguments{ -\item{object}{An \code{mcmcpermfix} object.} -} -\value{ -The \code{Mperm} slot of the \code{object}. -} -\description{ -Returns the \code{Mperm} slot. -} -\examples{ -\dontrun{getMperm(mcmcperm)} - -} -\seealso{ -\itemize{ -\item \linkS4class{mcmcoutputpermfix} for the inheriting class -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples -} -} diff --git a/man/groupmoments-class.Rd b/man/groupmoments-class.Rd index 48a500c..f936a85 100644 --- a/man/groupmoments-class.Rd +++ b/man/groupmoments-class.Rd @@ -4,32 +4,13 @@ \name{groupmoments-class} \alias{groupmoments-class} \alias{.groupmoments} -\alias{show,groupmoments-method} \title{Finmix \code{groupmoments} class} -\usage{ -\S4method{show}{groupmoments}(object) -} -\arguments{ -\item{object}{A \code{groupmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ Stores moments for finite mixture component distributions. These are only available, if the data contains in addition to observations also indicators defining to which component a certain observation belongs. These indicators are stored in an \linkS4class{fdata} object in the slot \code{S}. - -Calling \code{\link[=show]{show()}} on a \code{groupmoments} object gives an overview -of the moments of a finit mixture with continuous data. } -\section{Functions}{ -\itemize{ -\item \code{show,groupmoments-method}: Shows a short summary of the object's slots -}} - \section{Slots}{ \describe{ diff --git a/man/groupmoments.Rd b/man/groupmoments.Rd index 335fbc5..518d2f9 100644 --- a/man/groupmoments.Rd +++ b/man/groupmoments.Rd @@ -32,7 +32,7 @@ groupmoments(f_data) \seealso{ \itemize{ \item \linkS4class{fdata} for the \code{fdata} class definition -\item \link[=groupmments_class]{groupmoments} for the definition of the \code{groupmoments} +\item \linkS4class{groupmoments} for the definition of the \code{groupmoments} class \item \linkS4class{datamoments} for the base class for data moments \item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} diff --git a/man/hasS-fdata-method.Rd b/man/hasS-fdata-method.Rd index 4d4bd47..b2bf105 100644 --- a/man/hasS-fdata-method.Rd +++ b/man/hasS-fdata-method.Rd @@ -17,7 +17,7 @@ Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code empty or filled or a message, if \code{verbose} is \code{TRUE}. } \description{ -\code{\link[=hasS]{hasS()}} checks, if the object contains \code{S} data. +\code{hasS()} checks, if the object contains \code{S} data. } \examples{ # Generate an fdata object with Poisson data @@ -26,5 +26,8 @@ hasS(f_data) } \seealso{ -\link{fdata} class for an overview of its slots +\itemize{ +\item \linkS4class{fdata} for the class definition } +} +\keyword{internal} diff --git a/man/mcmcestimate.Rd b/man/mcmcestimate.Rd index 4de3b11..d724f42 100644 --- a/man/mcmcestimate.Rd +++ b/man/mcmcestimate.Rd @@ -59,10 +59,10 @@ estimation, see Fr\"uhwirth-Schnatter (2006). } \seealso{ \itemize{ -\item \link[=mcmcest_class]{mcmcestfix} for object storing the parameter estimates in -case of fixed indicators -\item \link[=mcmcest_class]{mcmcestfix} for object storing the parameter estimates in -case of unknown indicators +\item \linkS4class{mcmcestfix} for object storing the parameter estimates in case of +fixed indicators +\item \linkS4class{mcmcestind} for object storing the parameter estimates in case of +unknown indicators \item \linkS4class{mcmcoutputperm} for classes storing re-labeled MCMC samples } diff --git a/man/mcmcoutput-class.Rd b/man/mcmcoutput-class.Rd index ea4f0e6..2b1263c 100644 --- a/man/mcmcoutput-class.Rd +++ b/man/mcmcoutput-class.Rd @@ -1,41 +1,87 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfix.R, R/mcmcoutputhierpost.R +% Please edit documentation in R/mcmcoutputhierpost.R \docType{class} -\name{mcmcoutputfix-class} -\alias{mcmcoutputfix-class} -\alias{.mcmcoutputfix} +\name{mcmcoutput-class} \alias{mcmcoutput-class} -\title{Finmix \code{mcmcoutput} base class for fixed indicators} +\title{Finmix \code{mcmcoutput} class} \description{ -This class defines the basic slots for the MCMC sampling output for a -fixed indicator model. - The \code{mcmcoutput} class stores all MCMC samples and corresponding information. } -\section{Slots}{ - -\describe{ -\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} - -\item{\code{burnin}}{An integer defining the number of iterations in the burn-in -phase of MCMC sampling. These number of sampling steps are not stored -in the output.} - -\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed -with random permutations of components.} +\details{ +Calling \code{\link[=mixturemcmc]{mixturemcmc()}} on appropriate input arguments performs MCMC +sampling and returns an \code{mcmcoutput} object that stores all samples and +corresponding information like hyper-parameters, the finite mixture model +specified in a \code{model} object and the \code{prior} that specifies the prior +distribution. All slots are listed below. Note that not all slots must be +available in a object of class \code{mcmcoutput}. Some slots get only occupied, +if a hierarchical prior had been used in MCMC sampling, or if posterior +samples should be stored. Furthermore, the slots also look different, if +MCMC sampling had been performed for a model with fixed indicators (see for +subclasses for example \linkS4class{mcmcoutputfix}, \linkS4class{mcmcoutputbase}, +\linkS4class{mcmcoutputhier} or \linkS4class{mcmcoutputpost}). + +The class \code{mcmcoutput} is a class union and includes all classes that +define objects to store MCMC samples and is used to dispatch methods for +\code{mcmcoutput} objects. For the user this detail is not important, +especially as this class has no exported constructor. Objects are solely +constructed internally within the function \code{\link[=mixturemcmc]{mixturemcmc()}}. +\subsection{Class methods}{ + +This class comes along with a couple of methods that should give the user +some comfort in handling the MCMC sampling results. There are no setters for +this class as the slots are only set internally. +\subsection{Show}{ +\itemize{ +\item \code{show()} shows a short summary of the object's slots. +} +} -\item{\code{par}}{A named list containing the sampled component parameters.} +\subsection{Getters}{ +\itemize{ +\item \code{getM()} returns the \code{M} slot. +\item \code{getBurnin()} returns the \code{burnin} slot. +\item \code{getRanperm()} returns the \code{ranperm} slot. +\item \code{getPar()} returns the \code{par} slot. +\item \code{gteWeight()} returns the \code{weight} slot, if available. +\item \code{getLog()} returns the \code{log} slot. +\item \code{getEntropy()} returns the \code{entropy} slot, if available. +\item \code{getHyper()} returns the \code{hyper} slot, if available. +\item \code{getPost()} returns the \code{post} slot, if available. +\item \code{getST()} returns the \code{ST} slot, if available. +\item \code{getS()} returns the \code{S} slot, if available. +\item \code{getNK()} returns the \code{NK} slot, if available. +\item \code{getClust()} returns the \code{clust} slot, if available. +\item \code{getModel()} returns the \code{model} slot. +\item \code{getPrior()} returns the \code{prior} slot. +} +} -\item{\code{log}}{A named list containing the values of the mixture log-likelihood, -mixture prior log-likelihood, and the complete data posterior -log-likelihood.} +\subsection{Plotting}{ -\item{\code{model}}{The \code{model} object that specifies the finite mixture model for -whcih MCMC sampling has been performed.} +Plotting functionality for the \code{mcmcoutput} helps the user to inspect MCMC +results. +\itemize{ +\item \code{plotTraces()} plots traces of MCMC samples. See \code{\link[=plotTraces]{plotTraces()}} for +further information. +\item \code{plotHist()} plots histograms of parameters and weights. See \code{\link[=plotHist]{plotHist()}} +for further information. +\item \code{plotDens()} plots densities of parameters and weights. See \code{\link[=plotDens]{plotDens()}} +for further information. +\item \code{plotPointProc()} plots the point process of component parameters. See +\link{plotPointProc} for further information. +\item \code{plotSampRep()} plots the sampling representation of component parameters. +See \code{\link[=plotSampRep]{plotSampRep()}} for further information. +\item \code{plotPostDens()} plots the posterior density of component parameters. Note +that this function can only be applied for mixtures of two components. See +\code{\link[=plotPostDens]{plotPostDens()}} for further information. +} +} -\item{\code{prior}}{The \code{prior} object defining the prior distributions for the -component parameters that has been used in MCMC sampling.} +} +} +\section{Slots}{ +\describe{ \item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} \item{\code{burnin}}{An integer defining the number of iterations in the burn-in @@ -100,4 +146,3 @@ with hierarchical priors with stored posterior density parameters } } -\keyword{internal} diff --git a/man/mcmcoutputbase-class.Rd b/man/mcmcoutputbase-class.Rd index 8db008a..9b4e126 100644 --- a/man/mcmcoutputbase-class.Rd +++ b/man/mcmcoutputbase-class.Rd @@ -4,111 +4,12 @@ \name{mcmcoutputbase-class} \alias{mcmcoutputbase-class} \alias{.mcmcoutputbase} -\alias{show,mcmcoutputbase-method} -\alias{plotTraces,mcmcoutputbase-method} -\alias{plotHist,mcmcoutputbase-method} -\alias{plotDens,mcmcoutputbase-method} -\alias{plotPointProc,mcmcoutputbase-method} -\alias{plotSampRep,mcmcoutputbase-method} -\alias{plotPostDens,mcmcoutputbase-method} \title{Finmix \code{mcmcoutput} base class for unknown indicators} -\usage{ -\S4method{show}{mcmcoutputbase}(object) - -\S4method{plotTraces}{mcmcoutputbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputbase}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputbase}(x, dev = TRUE, ...) -} -\arguments{ -\item{object}{An \code{mcmcoutputbase} object.} - -\item{x}{An \code{mcmcoutput} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{lik}{An integer indicating, if the log-likelihood traces should be -plotted (default). If set to \code{0} the traces for the parameters -and weights are plotted instead.} - -\item{col}{A logical indicating, if the plot should be colored.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -A console output listing the slots and summary information about -each of them. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point processes of the MCMC samples. - -Sampling representations of the MCMC samples. - -Posterior densities of the MCMC samples. -} \description{ This class defines the basic slots for the MCMC sampling output when indicators are not known. It inherits from the \linkS4class{mcmcoutputfix}. - -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputbase} object gives an overview -of the \code{mcmcoutputbase} object. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{0}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the histogram plots. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. } -\section{Functions}{ -\itemize{ -\item \code{show,mcmcoutputbase-method}: Shows a short summary of the object's slots - -\item \code{plotTraces,mcmcoutputbase-method}: - -\item \code{plotHist,mcmcoutputbase-method}: - -\item \code{plotDens,mcmcoutputbase-method}: - -\item \code{plotPointProc,mcmcoutputbase-method}: - -\item \code{plotSampRep,mcmcoutputbase-method}: - -\item \code{plotPostDens,mcmcoutputbase-method}: -}} - \section{Slots}{ \describe{ @@ -135,144 +36,3 @@ indicators defining the last "clustering" of observations into the mixture components.} }} -\examples{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotHist(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPointProc(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotSampRep(f_output) - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Complete object slots for consistency. -(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} -} diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd index eedc74c..26d2522 100644 --- a/man/mcmcoutputperm-class.Rd +++ b/man/mcmcoutputperm-class.Rd @@ -71,9 +71,6 @@ that this function can only be applied for mixtures of two components. See } } -} - -\subsection{Slots}{ } } \section{Slots}{ diff --git a/man/mcmcoutputpermbase-class.Rd b/man/mcmcoutputpermbase-class.Rd index 2ee6730..a2db516 100644 --- a/man/mcmcoutputpermbase-class.Rd +++ b/man/mcmcoutputpermbase-class.Rd @@ -4,61 +4,7 @@ \name{mcmcoutputpermbase-class} \alias{mcmcoutputpermbase-class} \alias{.mcmcoutputpermbase} -\alias{show,mcmcoutputpermbase-method} -\alias{plotTraces,mcmcoutputpermbase-method} -\alias{plotHist,mcmcoutputpermbase-method} -\alias{plotDens,mcmcoutputpermbase-method} -\alias{plotPointProc,mcmcoutputpermbase-method} -\alias{plotSampRep,mcmcoutputpermbase-method} -\alias{plotPostDens,mcmcoutputpermbase-method} \title{Finmix \code{mcmcoutputpermbase} class} -\usage{ -\S4method{show}{mcmcoutputpermbase}(object) - -\S4method{plotTraces}{mcmcoutputpermbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermbase}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermbase} object.} - -\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{lik}{An integer indicating, if the log-likelihood traces should be -plotted (default). If set to \code{0} the traces for the parameters -and weights are plotted instead.} - -\item{col}{A logical indicating, if the plot should be colored.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -A console output listing the slots and summary information about -each of them. - -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Point process of the MCMC samples. - -Sampling representation of the MCMC samples. - -Posterior densities of the MCMC samples. -} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -72,168 +18,6 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note that this class inherits all of its slots from the parent classes. - -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermbase} object gives an overview -of the \code{mcmcoutputpermbase} object. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights -from MCMC sampling. - -Note, this method is so far only implemented for mictures of Poisson and -Binomial distributions. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method is only implemented for mixtures of Poisson and Binomial -distributions. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method is so far only implemented for Poisson or Binomial -mixture distributions. -} -\section{Functions}{ -\itemize{ -\item \code{show,mcmcoutputpermbase-method}: Shows a short summary of the object's -slots - -\item \code{plotTraces,mcmcoutputpermbase-method}: - -\item \code{plotHist,mcmcoutputpermbase-method}: Plot histograms of the parameters and -weights - -\item \code{plotDens,mcmcoutputpermbase-method}: - -\item \code{plotPointProc,mcmcoutputpermbase-method}: Plots point process for the component -parameters - -\item \code{plotSampRep,mcmcoutputpermbase-method}: Plots sampling representations of the -component parameters - -\item \code{plotPostDens,mcmcoutputpermbase-method}: Plots the posterior density of the -component parameters -}} - -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) -} - -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) -} - } \seealso{ \itemize{ @@ -241,64 +25,4 @@ plotPostDens(f_outputperm) \item \linkS4class{mcmcpermind} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} } diff --git a/man/mcmcoutputpermfix-class.Rd b/man/mcmcoutputpermfix-class.Rd index d5340e6..34e6562 100644 --- a/man/mcmcoutputpermfix-class.Rd +++ b/man/mcmcoutputpermfix-class.Rd @@ -4,53 +4,7 @@ \name{mcmcoutputpermfix-class} \alias{mcmcoutputpermfix-class} \alias{.mcmcoutputpermfix} -\alias{plotTraces,mcmcoutputpermfix-method} -\alias{plotHist,mcmcoutputpermfix-method} -\alias{plotDens,mcmcoutputpermfix-method} -\alias{plotPointProc,mcmcoutputpermfix-method} -\alias{plotSampRep,mcmcoutputpermfix-method} -\alias{plotPostDens,mcmcoutputpermfix-method} \title{Finmix \code{mcmcoutputpermfix} class} -\usage{ -\S4method{plotTraces}{mcmcoutputpermfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) - -\S4method{plotHist}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotPointProc}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotSampRep}{mcmcoutputpermfix}(x, dev = TRUE, ...) - -\S4method{plotPostDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{lik}{An integer indicating, if the log-likelihood traces should be -plotted (default). If set to \code{0} the traces for the parameters -and weights are plotted instead.} - -\item{col}{A logical indicating, if the plot should be colored.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -A plot of the traces of the MCMC samples. - -Histograms of the MCMC samples. - -Densities of the MCMC samples. - -Densities of the MCMC samples. - -Sampling represetnation of the MCMC samples. - -Posterior densities of the MCMC samples. -} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -64,152 +18,6 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note that this class inherits all of its slots from the parent classes. - -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}.s - -If \code{lik} is set to \code{0} the parameters of the components and the posterior -parameters are plotted together with \code{K-1} weights. - -Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled component parameters -from MCMC sampling. - -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled component parameters -from MCMC sampling. - -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. -} -\section{Functions}{ -\itemize{ -\item \code{plotTraces,mcmcoutputpermfix-method}: - -\item \code{plotHist,mcmcoutputpermfix-method}: - -\item \code{plotDens,mcmcoutputpermfix-method}: - -\item \code{plotPointProc,mcmcoutputpermfix-method}: - -\item \code{plotSampRep,mcmcoutputpermfix-method}: - -\item \code{plotPostDens,mcmcoutputpermfix-method}: -}} - -\examples{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotTraces(f_outputperm, lik = 0) - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotHist(f_outputperm) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotDens(f_outputperm) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPointProc(f_outputperm) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotSampRep(f_outputperm) -} - -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc(storepost = FALSE) -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Do not use a hierarchical prior. -setHier(f_prior) <- FALSE -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -f_outputperm <- mcmcpermute(f_output) -plotPostDens(f_outputperm) -} - } \seealso{ \itemize{ @@ -217,64 +25,4 @@ plotPostDens(f_outputperm) \item \linkS4class{mcmcpermfix} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples } - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} - -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} } diff --git a/man/mcmcoutputpermfixhier-class.Rd b/man/mcmcoutputpermfixhier-class.Rd index 6d5d968..a9eea75 100644 --- a/man/mcmcoutputpermfixhier-class.Rd +++ b/man/mcmcoutputpermfixhier-class.Rd @@ -4,18 +4,7 @@ \name{mcmcoutputpermfixhier-class} \alias{mcmcoutputpermfixhier-class} \alias{.mcmcoutputpermfixhier} -\alias{show,mcmcoutputpermfixhier-method} \title{Finmix \code{mcmcoutputpermfixhier} class} -\usage{ -\S4method{show}{mcmcoutputpermfixhier}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermfixhier} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} \description{ This class defines objects to store the outputs from permuting the MCMC samples. Due to label switching the sampled component parameters are usually @@ -29,16 +18,7 @@ size and the mixture log-likelihood, the prior log-likelihood, and the complete data posterior log-likelihood. Note this class inherits all slots from its parent classes. - -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhier} object gives an overview -of the \code{mcmcoutputpermfixhier} object. } -\section{Functions}{ -\itemize{ -\item \code{show,mcmcoutputpermfixhier-method}: Shows a short summary of the -object's slots -}} - \seealso{ \itemize{ \item \linkS4class{mcmcoutputpermfix} for the parent class diff --git a/man/mcmcoutputpermfixpost-class.Rd b/man/mcmcoutputpermfixpost-class.Rd index defb5fe..6afb53a 100644 --- a/man/mcmcoutputpermfixpost-class.Rd +++ b/man/mcmcoutputpermfixpost-class.Rd @@ -12,7 +12,7 @@ It inherits from the \seealso{ \itemize{ \item \linkS4class{mcmcoutputfixpost} for the parent class -\item \link{mcmcpermfixpost} for the parent class +\item \linkS4class{mcmcpermfixpost} for the parent class \item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples } } diff --git a/man/mcmcperm_class.Rd b/man/mcmcperm_class.Rd deleted file mode 100644 index 24db7eb..0000000 --- a/man/mcmcperm_class.Rd +++ /dev/null @@ -1,109 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcpermind.R, R/mcmcpermindhier.R, -% R/mcmcpermindpost.R -\docType{class} -\name{mcmcpermind-class} -\alias{mcmcpermind-class} -\alias{.mcmcpermind} -\alias{mcmcpermindhier-class} -\alias{.mcmcpermindhier} -\alias{mcmcpermindpost-class} -\alias{.mcmcpermindpost} -\title{Finmix \code{mcmcpermind} class} -\description{ -This class defines objects to store the outputs from permuting the MCMC -samples. Due to label switching the sampled component parameters are usually -not assigned to the same component in each iteration. To overcome this issue -the samples are permuted by using a relabeling algorithm (usually K-means) -to reassign parameters. Note that due to assignment of parameters from the -same iteration to the same component, the sample size could shrink. - -This class stores the permuted parameters together with the new MCMC sample -size and the mixture log-likelihood, the prior log-likelihood, and the -complete data posterior log-likelihood. All this slots are inherited from -the parent class \code{mcmcpermfix}. In addition to these slots this class adds -permuted weights, permuted indicators as well as the entropies and number -of assigned observations per component. - -This class defines objects to store the outputs from permuting the MCMC -samples. Due to label switching the sampled component parameters are usually -not assigned to the same component in each iteration. To overcome this issue -the samples are permuted by using a relabeling algorithm (usually K-means) -to reassign parameters. Note that due to assignment of parameters from the -same iteration to the same component, the sample size could shrink. - -This class is supplementing the parent class by adding a slot to store the -permuted parameter samples of the hierarchical prior. - -Note that for models with fixed indicators \code{weight}s do not get permuted. - -This class defines objects to store the outputs from permuting the MCMC -samples. Due to label switching the sampled component parameters are usually -not assigned to the same component in each iteration. To overcome this issue -the samples are permuted by using a relabeling algorithm (usually K-means) -to reassign parameters. Note that due to assignment of parameters from the -same iteration to the same component, the sample size could shrink. - -This class is supplementing the parent class by adding a slot to store the -permuted parameter samples of the posterior densities. -} -\section{Functions}{ -\itemize{ -\item \code{mcmcpermind-class}: - -\item \code{mcmcpermindhier-class}: - -\item \code{mcmcpermindpost-class}: -}} - -\section{Slots}{ - -\describe{ -\item{\code{relabel}}{A character defining the used algorithm for relabeling.} - -\item{\code{weightperm}}{An array of dimension \verb{Mperm x K} containing the -relabeled weight parameters.} - -\item{\code{entropyperm}}{An \code{array} of dimension \verb{Mperm x 1} containing the -entropy for each MCMC permuted draw.} - -\item{\code{STperm}}{An \code{array} of dimension \verb{Mperm x 1} containing all permuted -MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object -passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov -models as the last indicator of this observation.} - -\item{\code{Sperm}}{An \code{array} of dimension \verb{N x storeS} containing the last -\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} -of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} - -\item{\code{NKperm}}{An \code{array} of dimension \verb{Mperm x K} containing the numbers -of observations assigned to each component.} - -\item{\code{hyperperm}}{A named list containing the (permuted) parameters of the -hierarchical prior.} - -\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of -parameters from the posterior density.} -}} - -\seealso{ -\itemize{ -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function -\item \link[=mcmcperm_class]{mcmcperfix} for the corresponding class for models with -fixed indicators -} - -\itemize{ -\item \code{\link{mcmcpermute()}} for the calling function -\item \code{\link{mcmcpermind}} for the parent class definition -\item \code{\link{mcmcpermfixhier}} for the corresponding class for models with -fixed indicators -} - -\itemize{ -\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function -\item \link[=mcmcperm_class]{mcmcpermind} for the parent class definition -\item \link[=mcmcperm_class]{mcmcpermfixpost} for the corresponding class for models -with fixed indicators -} -} diff --git a/man/mcmcpermfixhier-class.Rd b/man/mcmcpermfixhier-class.Rd index 5b38a57..c681efd 100644 --- a/man/mcmcpermfixhier-class.Rd +++ b/man/mcmcpermfixhier-class.Rd @@ -27,9 +27,9 @@ hierarchical prior.} \seealso{ \itemize{ -\item \code{\link{mcmcpermute()}} for the calling function -\item \code{\link{mcmcpermfix-class}} for the parent class definition -\item \code{\link{mcmcpermindhier-class}} for the corresponding class for models +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \linkS4class{mcmcpermfix} for the parent class definition +\item \linkS4class{mcmcpermindhier} for the corresponding class for models with unknown indicators } } diff --git a/man/model_class.Rd b/man/model_class.Rd index 29a5aec..eb84843 100644 --- a/man/model_class.Rd +++ b/man/model_class.Rd @@ -2,14 +2,11 @@ % Please edit documentation in R/model.R \name{hasWeight,model-method} \alias{hasWeight,model-method} -\alias{simulate,model-method} \alias{model_class} \title{Getter for weights} \usage{ \S4method{hasWeight}{model}(object, verbose = FALSE) -\S4method{simulate}{model}(model, N = 100, varargin, seed = 0) - \S4method{getDist}{model}(object) \S4method{getR}{model}(object) @@ -45,39 +42,16 @@ \arguments{ \item{verbose}{A logical indicating, if the function should give a print out.} -\item{model}{An S4 model object with specified parameters and weights.} - -\item{N}{An integer specifying the number of values to be simulated.} - -\item{varargin}{An S4 fdata object with specified variable dimensions.} - -\item{seed}{An integer specifying the seed for the RNG. -\code{r} and repetitions \code{T}.} +\item{model}{An S4 model object.} } \value{ Matrix of weights. - -An S4 fdata object holding the simulated values. } \description{ \code{hasWeight} returns the weight matrix. - -\code{simulate} simulates values for a specified mixture model in an -S4 \code{model} object. } -\section{Functions}{ -\itemize{ -\item \code{simulate,model-method}: Simulates data from a finite mixture model -}} - \examples{ \dontrun{ weight <- hasWeight(model) } -\dontrun{ -f_data <- simulate(model, 100) -} -} -\seealso{ -\code{model}, \code{fdata} } diff --git a/man/plotDens-mcmcoutputfixhierpost-method.Rd b/man/plotDens-mcmcoutputfixhierpost-method.Rd deleted file mode 100644 index 4124676..0000000 --- a/man/plotDens-mcmcoutputfixhierpost-method.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhierpost.R -\name{plotDens,mcmcoutputfixhierpost-method} -\alias{plotDens,mcmcoutputfixhierpost-method} -\title{Plot densities of the parameters and weights} -\usage{ -\S4method{plotDens}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -Densities of the MCMC samples. -} -\description{ -Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights -from MCMC sampling.More specifically, all component parameters, \code{K-1} of the -weights and the posterior parameters are considered in the density plots. - -Note that this method calls the equivalent method from the parent class -\code{mcmcoutputfixhier}. -} -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotDens(f_output) -} - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} -} diff --git a/man/plotPointProc-mcmcoutputfixhierpost-method.Rd b/man/plotPointProc-mcmcoutputfixhierpost-method.Rd deleted file mode 100644 index a9c5ca8..0000000 --- a/man/plotPointProc-mcmcoutputfixhierpost-method.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhierpost.R -\name{plotPointProc,mcmcoutputfixhierpost-method} -\alias{plotPointProc,mcmcoutputfixhierpost-method} -\title{Plot point processes of the component parameters} -\usage{ -\S4method{plotPointProc}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -Point process of the MCMC samples. -} -\description{ -Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component -parameters from MCMC sampling. - -Note, this methid calls the equivalent method from the parent class -\code{mcmcoutputfixhier}. -} -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPointProc(f_output) -} - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} -} diff --git a/man/plotPostDens-mcmcoutputfixhierpost-method.Rd b/man/plotPostDens-mcmcoutputfixhierpost-method.Rd deleted file mode 100644 index 125114e..0000000 --- a/man/plotPostDens-mcmcoutputfixhierpost-method.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhierpost.R -\name{plotPostDens,mcmcoutputfixhierpost-method} -\alias{plotPostDens,mcmcoutputfixhierpost-method} -\title{Plot posterior densities of the component parameters} -\usage{ -\S4method{plotPostDens}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -Posterior densities of the MCMC samples. -} -\description{ -Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component -parameters from MCMC sampling, if the number of components is two. - -Note, this method calls the equivalent method of the parent class -\code{mcmcoutputfixhier}. -} -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotPostDens(f_output) -} - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -} -} diff --git a/man/plotSampRep-mcmcoutputfixhierpost-method.Rd b/man/plotSampRep-mcmcoutputfixhierpost-method.Rd deleted file mode 100644 index 2695693..0000000 --- a/man/plotSampRep-mcmcoutputfixhierpost-method.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhierpost.R -\name{plotSampRep,mcmcoutputfixhierpost-method} -\alias{plotSampRep,mcmcoutputfixhierpost-method} -\title{Plot sampling representations for the component parameters.} -\usage{ -\S4method{plotSampRep}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -Sampling representation of the MCMC samples. -} -\description{ -Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled -component parameters from MCMC sampling. - -Note, this method calls the equivalent method of the parent class -\code{mcmcoutputfixhier}. -} -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotSampRep(f_output) -} - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values -} -} diff --git a/man/plotTraces-mcmcoutputfixhierpost-method.Rd b/man/plotTraces-mcmcoutputfixhierpost-method.Rd deleted file mode 100644 index 9502e72..0000000 --- a/man/plotTraces-mcmcoutputfixhierpost-method.Rd +++ /dev/null @@ -1,62 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhierpost.R -\name{plotTraces,mcmcoutputfixhierpost-method} -\alias{plotTraces,mcmcoutputfixhierpost-method} -\title{Plot traces of MCMC sampling} -\usage{ -\S4method{plotTraces}{mcmcoutputfixhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) -} -\arguments{ -\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} - -\item{dev}{A logical indicating, if the plots should be shown by a graphical -device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} - -\item{lik}{An integer indicating, if the log-likelihood traces should be -plotted (default). If set to \code{0} the traces for the parameters -and weights are plotted instead.} - -\item{col}{A logical indicating, if the plot should be colored.} - -\item{...}{Further arguments to be passed to the plotting function.} -} -\value{ -A plot of the traces of the MCMC samples. -} -\description{ -Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood -, the mixture log-likelihood of the prior distribution, the log-likelihood -of the complete data posterior, or the weights and parameters if \code{lik} is -set to \code{1}. If \code{lik} is set to \code{0} the parameters of the components and the -posterior parameters are plotted together with \code{K-1} weights. - -Note that this method calls the equivalent method from the parent class -\code{mcmcoutputfixhier}. -} -\examples{ -\dontrun{ -# Define a Poisson mixture model with two components. -f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, - indicfix = TRUE) -# Simulate data from the mixture model. -f_data <- simulate(f_model) -# Define the hyper-parameters for MCMC sampling. -f_mcmc <- mcmc() -# Define the prior distribution by relying on the data. -f_prior <- priordefine(f_data, f_model) -# Start MCMC sampling. -f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) -plotTraces(f_output, lik = 0) -} - -} -\seealso{ -\itemize{ -\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling -\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values -\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values -\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values -\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values -\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters -} -} diff --git a/man/prior-class.Rd b/man/prior-class.Rd index 4a8d50f..5b2d469 100644 --- a/man/prior-class.Rd +++ b/man/prior-class.Rd @@ -4,41 +4,14 @@ \name{prior-class} \alias{prior-class} \alias{.prior} -\alias{hasPriorPar,prior,model-method} -\alias{hasPriorWeight,prior,model-method} \title{Finmix \code{prior} class} -\usage{ -\S4method{hasPriorPar}{prior,model}(object, model, verbose = FALSE) - -\S4method{hasPriorWeight}{prior,model}(object, model, verbose = FALSE) -} -\arguments{ -\item{object}{A \code{prior} object containing the specifications for the prior.} - -\item{model}{A \code{model} object containing the specifications for the model.} - -\item{verbose}{A logical indicating, if the output should be verbose.} -} \description{ The \code{prior} class stores the specifications for the prior distribution used for Bayesian estimation of the finite mixture parameters and weights. There exists next to the general constructor also an advanced constructor that specifies a data dependent prior. See \code{\link[=priordefine]{priordefine()}} for this advanced constructor. - -Calling \code{\link[=hasPriorPar]{hasPriorPar()}} checks if \code{model}-appropriate parameters are stored -in the \code{prior} object. - -Calling \code{\link[=hasPriorWeight]{hasPriorWeight()}} checks if \code{model}-appropriate weight parameters -are stored in the \code{prior} object. } -\section{Functions}{ -\itemize{ -\item \code{hasPriorPar,prior,model-method}: Checks for parameters in \code{prior} object - -\item \code{hasPriorWeight,prior,model-method}: Checks for prior weights in \code{prior} object -}} - \section{Slots}{ \describe{ @@ -58,24 +31,6 @@ Hierarchical prior are often more robust, but need an additional layer in sampling, so computing costs increase.} }} -\examples{ -# Define a Poisson mixture model. -f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) -# Call the default constructor. -f_prior <- prior() -# Check if the prior has appropriate parameters defined. -hasPriorPar(f_prior, f_model) -\dontrun{hasPriorPar(f_prior, f_model, TRUE)} - -# Define a Poisson mixture model. -f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) -# Call the default constructor. -f_prior <- prior() -# Check if the prior has appropriate parameters defined. -hasPriorWeight(f_prior, f_model) -\dontrun{hasPriorWeight(f_prior, f_model, TRUE)} - -} \references{ \itemize{ \item Frühwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" @@ -86,14 +41,4 @@ hasPriorWeight(f_prior, f_model) \item \code{\link[=prior]{prior()}} for the general constructor of this class \item \code{\link[=priordefine]{priordefine()}} for the advanced constructor of this class } - -\itemize{ -\item \linkS4class{prior} for the definition of the \code{prior} class -\item \linkS4class{model} for the definition of the \code{model} class -} - -\itemize{ -\item \link[=prior-class]{prior} for the definition of the \code{prior} class -\item \link[=model_class]{model} for the definition of the \code{model} class -} } diff --git a/man/sdatamoments_class.Rd b/man/sdatamoments_class.Rd deleted file mode 100644 index 8379847..0000000 --- a/man/sdatamoments_class.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sdatamoments.R -\name{show,sdatamoments-method} -\alias{show,sdatamoments-method} -\title{Shows a summary of an \code{sdatamoments} object.} -\usage{ -\S4method{show}{sdatamoments}(object) -} -\arguments{ -\item{object}{An \code{sdatamoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{sdatamoments} object gives an overview -of the moments of a finite mixture with discrete data. -} -\section{Functions}{ -\itemize{ -\item \code{show,sdatamoments-method}: Shows a summary of an object -}} - diff --git a/man/show-mcmcestfix-method.Rd b/man/show-mcmcestfix-method.Rd deleted file mode 100644 index 5d443ac..0000000 --- a/man/show-mcmcestfix-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcestfix.R -\name{show,mcmcestfix-method} -\alias{show,mcmcestfix-method} -\title{Shows a summary of an \code{mcmcestfix} object.} -\usage{ -\S4method{show}{mcmcestfix}(object) -} -\arguments{ -\item{object}{An \code{mcmcestfix} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcestfix} object gives an overview -of the \code{mcmcestfix} object. -} diff --git a/man/show-mcmcoutputpermhierpost-method.Rd b/man/show-mcmcoutputpermhierpost-method.Rd deleted file mode 100644 index adc779b..0000000 --- a/man/show-mcmcoutputpermhierpost-method.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpermhierpost.R -\name{show,mcmcoutputpermhierpost-method} -\alias{show,mcmcoutputpermhierpost-method} -\title{Shows a summary of an \code{mcmcoutputpermhierpost} object.} -\usage{ -\S4method{show}{mcmcoutputpermhierpost}(object) -} -\arguments{ -\item{object}{An \code{mcmcoutputpermhierpost} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermhierpost} object gives an overview -of the \code{mcmcoutputpermhierpost} object. -} -\keyword{internal} diff --git a/man/studentmodelmoments.Rd b/man/studentmodelmoments.Rd index 130bd81..582c0c1 100644 --- a/man/studentmodelmoments.Rd +++ b/man/studentmodelmoments.Rd @@ -22,7 +22,7 @@ indirectly when calling the \code{modelmoments} constructor \code{\link[=modelmo \seealso{ \itemize{ -\item \code{\link{modelmoments_class}} for the base class for model moments -\item \code{\link{modelmoments}} for the constructor of \code{modelmoments} classes +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes } } diff --git a/man/studmultmodelmoments-class.Rd b/man/studmultmodelmoments-class.Rd deleted file mode 100644 index de873ae..0000000 --- a/man/studmultmodelmoments-class.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/studmultmodelmoments.R -\name{show,studmultmodelmoments-method} -\alias{show,studmultmodelmoments-method} -\title{Shows a summary of an \code{studmultmodelmoments} object.} -\usage{ -\S4method{show}{studmultmodelmoments}(object) -} -\arguments{ -\item{object}{An \code{studmultmodelmoments} object.} -} -\value{ -A console output listing the slots and summary information about -each of them. -} -\description{ -Calling \code{\link[=show]{show()}} on an \code{studmultmodelmoments} object gives an overview -of the moments of an studmult finite mixture. -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show}: Shows a summary of an object -}} - diff --git a/man/subseq-mcmcoutputfix-array-method.Rd b/man/subseq-mcmcoutputfix-array-method.Rd deleted file mode 100644 index eefdf2b..0000000 --- a/man/subseq-mcmcoutputfix-array-method.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfix.R -\name{subseq,mcmcoutputfix,array-method} -\alias{subseq,mcmcoutputfix,array-method} -\title{Constructs a sub-chain of MCMC samples} -\usage{ -\S4method{subseq}{mcmcoutputfix,array}(object, index) -} -\arguments{ -\item{object}{An \code{mcmcoutput} object containing all sampled values.} - -\item{index}{An array specifying the extraction of the sub-chain.} -} -\value{ -An \code{mcmcoutput} object containing the values from the sub-chain. -} -\description{ -Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the -passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This -can be advantageous, if chains are non-stationary. For successful MCMC -sampling the chain must be converged to the target distribution, the true -distribution of parameters, weights and indicators. -} diff --git a/man/subseq-mcmcoutputfixhier-array-method.Rd b/man/subseq-mcmcoutputfixhier-array-method.Rd deleted file mode 100644 index 1eca51b..0000000 --- a/man/subseq-mcmcoutputfixhier-array-method.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputfixhier.R -\name{subseq,mcmcoutputfixhier,array-method} -\alias{subseq,mcmcoutputfixhier,array-method} -\title{Constructs a sub-chain of MCMC samples} -\usage{ -\S4method{subseq}{mcmcoutputfixhier,array}(object, index) -} -\arguments{ -\item{object}{An \code{mcmcoutput} object containing all sampled values.} - -\item{index}{An array specifying the extraction of the sub-chain.} -} -\value{ -An \code{mcmcoutput} object containing the values from the sub-chain. -} -\description{ -Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the -passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This -can be advantageous, if chains are non-stationary. For successful MCMC -sampling the chain must be converged to the target distribution, the true -distribution of parameters, weights and indicators. -} diff --git a/man/subseq-mcmcoutputpost-array-method.Rd b/man/subseq-mcmcoutputpost-array-method.Rd deleted file mode 100644 index fced7cf..0000000 --- a/man/subseq-mcmcoutputpost-array-method.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mcmcoutputpost.R -\name{subseq,mcmcoutputpost,array-method} -\alias{subseq,mcmcoutputpost,array-method} -\title{Constructs a sub-chain of MCMC samples} -\usage{ -\S4method{subseq}{mcmcoutputpost,array}(object, index) -} -\arguments{ -\item{object}{An \code{mcmcoutputpost} object containing all sampled values.} - -\item{index}{An array specifying the extraction of the sub-chain.} -} -\value{ -An \code{mcmcoutputpost} object containing the values from the sub-chain. -} -\description{ -Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples -in the passed-in \code{mcmcoutputpost} object specfied by the index \code{array} in -\code{index}. This can be advantageous, if chains are non-stationary. For -successful MCMC sampling the chain must be converged to the target -distribution, the true distribution of parameters, weights and indicators. - -Note, this method calls the equivalent method of the parent class and then -adds to it the sub-chains for the parameters of the hierarchical prior. -} From 9988b26e1a7136a2510de468d4675047c88b35b1 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Mon, 18 Oct 2021 08:42:56 +0200 Subject: [PATCH 16/24] Changed some Rd files --- man/exponentialmodelmoments.Rd | 28 ---------------------------- man/normultmodelmoments.Rd | 28 ---------------------------- man/studentmodelmoments.Rd | 28 ---------------------------- man/studmultmodelmoments.Rd | 28 ---------------------------- 4 files changed, 112 deletions(-) delete mode 100644 man/exponentialmodelmoments.Rd delete mode 100644 man/normultmodelmoments.Rd delete mode 100644 man/studentmodelmoments.Rd delete mode 100644 man/studmultmodelmoments.Rd diff --git a/man/exponentialmodelmoments.Rd b/man/exponentialmodelmoments.Rd deleted file mode 100644 index a7fd36d..0000000 --- a/man/exponentialmodelmoments.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/exponentialmodelmoments.R -\docType{class} -\name{exponentialmodelmoments} -\alias{exponentialmodelmoments} -\alias{.exponentialmodelmoments} -\title{Finmix \code{exponentialmodelmoments} class} -\description{ -Defines a class that holds modelmoments for a finite mixture of exponential -distributions. Note that this class is not directly used, but indirectly -when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. -} -\section{Slots}{ - -\describe{ -\item{\code{B}}{A numeric defining the between-group heterogeneity.} - -\item{\code{W}}{A numeric defining the within-group heterogeneity.} - -\item{\code{R}}{A numeric defining the coefficient of determination.} -}} - -\seealso{ -\itemize{ -\item \linkS4class{modelmoments} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes -} -} diff --git a/man/normultmodelmoments.Rd b/man/normultmodelmoments.Rd deleted file mode 100644 index 7b2f6d9..0000000 --- a/man/normultmodelmoments.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/normultmodelmoments.R -\docType{class} -\name{normultmodelmoments} -\alias{normultmodelmoments} -\alias{.normultmodelmoments} -\title{Finmix \code{normultmodelmoments} class} -\description{ -Defines a class that holds modelmoments for a finite mixture of normult -distributions. Note that this class is not directly used, but indirectly -when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. -} -\section{Slots}{ - -\describe{ -\item{\code{B}}{A numeric defining the between-group heterogeneity.} - -\item{\code{W}}{A numeric defining the within-group heterogeneity.} - -\item{\code{R}}{A numeric defining the coefficient of determination.} -}} - -\seealso{ -\itemize{ -\item \linkS4class{modelmoments} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes -} -} diff --git a/man/studentmodelmoments.Rd b/man/studentmodelmoments.Rd deleted file mode 100644 index 582c0c1..0000000 --- a/man/studentmodelmoments.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/studentmodelmoments.R -\docType{class} -\name{studentmodelmoments} -\alias{studentmodelmoments} -\alias{.studentmodelmoments} -\title{Finmix \code{studentmodelmoments} class} -\description{ -Defines a class that holds theoretical moments for a finite mixture of -student distributions. Note that this class is not directly used, but -indirectly when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. -} -\section{Slots}{ - -\describe{ -\item{\code{B}}{A numeric defining the between-group heterogeneity.} - -\item{\code{W}}{A numeric defining the within-group heterogeneity.} - -\item{\code{R}}{A numeric defining the coefficient of determination.} -}} - -\seealso{ -\itemize{ -\item \linkS4class{modelmoments} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes -} -} diff --git a/man/studmultmodelmoments.Rd b/man/studmultmodelmoments.Rd deleted file mode 100644 index c3cddd1..0000000 --- a/man/studmultmodelmoments.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/studmultmodelmoments.R -\docType{class} -\name{studmultmodelmoments} -\alias{studmultmodelmoments} -\alias{.studmultmodelmoments} -\title{Finmix \code{studmultmodelmoments} class} -\description{ -Defines a class that holds modelmoments for a finite mixture of studmult -distributions. Note that this class is not directly used, but indirectly -when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. -} -\section{Slots}{ - -\describe{ -\item{\code{B}}{A numeric defining the between-group heterogeneity.} - -\item{\code{W}}{A numeric defining the within-group heterogeneity.} - -\item{\code{R}}{A numeric defining the coefficient of determination.} -}} - -\seealso{ -\itemize{ -\item \linkS4class{modelmoments} for the base class for model moments -\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes -} -} From e509f9801161b5e404651f6a59e16af63962a3ff Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Thu, 21 Oct 2021 09:56:37 +0200 Subject: [PATCH 17/24] Changed the documentation and fixed some bugs in the examples. --- NAMESPACE | 15 +++++ R/AllGenerics.R | 32 ++++++++--- R/binomialmodelmoments.R | 5 +- R/cdatamoments.R | 10 ++-- R/cmodelmoments.R | 8 +-- R/csdatamoments.R | 20 +++---- R/dataclass.R | 71 +++++++++++++----------- R/ddatamoments.R | 23 ++++---- R/dmodelmoments.R | 9 ++- R/exponentialmodelmoments.R | 8 +-- R/fdata.R | 19 +------ R/groupmoments.R | 22 +++++--- R/mcmcestfix.R | 50 ++++++++--------- R/mcmcestimate.R | 20 ++++++- R/mcmcestind.R | 107 +++++++++++++++++++++++++++++++++--- R/mcmcextract.R | 2 +- R/mcmcoutputbase.R | 18 +++--- R/mcmcoutputfix.R | 16 +++--- R/mcmcoutputfixhier.R | 2 +- R/mcmcoutputfixpost.R | 2 +- R/mcmcoutputhier.R | 2 +- R/mcmcoutputpermhierpost.R | 55 ++++++++++++++++-- R/mcmcoutputpost.R | 2 +- R/mcmcpermfix.R | 6 +- R/mcmcpermfixhier.R | 2 +- R/mcmcpermfixpost.R | 2 +- R/mcmcpermind.R | 12 ++-- R/mcmcpermindhier.R | 6 +- R/mcmcpermindpost.R | 2 +- R/model.R | 2 +- R/modelmoments.R | 6 +- R/normalmodelmoments.R | 12 ++-- R/normultmodelmoments.R | 13 +++-- R/poissonmodelmoments.R | 2 +- R/prior.R | 25 +++++---- R/sdatamoments.R | 6 +- R/studentmodelmoments.R | 8 +-- R/studmultmodelmoments.R | 12 ++-- man/dataclass.Rd | 21 ++++--- man/mcmcoutputperm-class.Rd | 8 +-- src/Makevars | 25 +-------- src/Makevars.win | 3 +- 42 files changed, 429 insertions(+), 262 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index cf40de6..0e069cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,12 @@ export(datamoments) export(ddirichlet_cc) export(dgamma_cc) export(fdata) +export(getB) +export(getDist) export(groupmoments) +export(hasPar) +export(hasT) +export(hasWeight) export(hungarian_cc) export(lddirichlet_cc) export(ldgamma_cc) @@ -22,11 +27,13 @@ export(mcmc_studmult_cc) export(mcmcestimate) export(mcmcpermute) export(mcmcstart) +export(mixturemar) export(mixturemcmc) export(model) export(modelmoments) export(moments_cc) export(permmoments_cc) +export(plotPointProc) export(prior) export(priordefine) export(qincol) @@ -34,6 +41,7 @@ export(qincolmult) export(qinmatr) export(qinmatrmult) export(sdatamoments) +export(simulate) export(stephens1997a_binomial_cc) export(stephens1997a_poisson_cc) export(stephens1997b_binomial_cc) @@ -131,6 +139,8 @@ exportMethods(getEavg) exportMethods(getEntropy) exportMethods(getEntropyperm) exportMethods(getExp) +exportMethods(getExtrabinvar) +exportMethods(getFactorial) exportMethods(getFdata) exportMethods(getGmoments) exportMethods(getHier) @@ -143,10 +153,13 @@ exportMethods(getIndicmod) exportMethods(getK) exportMethods(getKurtosis) exportMethods(getLog) +exportMethods(getLoglikcd) exportMethods(getLogperm) +exportMethods(getLogpy) exportMethods(getM) exportMethods(getMap) exportMethods(getMean) +exportMethods(getMixlik) exportMethods(getModel) exportMethods(getMperm) exportMethods(getN) @@ -156,8 +169,10 @@ exportMethods(getName) exportMethods(getPar) exportMethods(getParperm) exportMethods(getPost) +exportMethods(getPostS) exportMethods(getPostperm) exportMethods(getPrior) +exportMethods(getProb) exportMethods(getR) exportMethods(getRanperm) exportMethods(getRdet) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 851dab8..1d1d5aa 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -21,25 +21,39 @@ NULL ## Class 'model' -------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("simulate", function(model, N = 100, varargin, seed = 0) standardGeneric("simulate")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("plotPointProc", function(x, dev = TRUE, ...) standardGeneric("plotPointProc")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasWeight", function(object, verbose = FALSE) standardGeneric("hasWeight")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasPar", function(object, verbose = FALSE) standardGeneric("hasPar")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("mixturemar", function(object, J) standardGeneric("mixturemar")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getDist", function(object) standardGeneric("getDist")) #' @noRd @@ -123,7 +137,9 @@ setGeneric("getZero", function(object) standardGeneric("getZero")) #' @noRd setGeneric("generateMoments", function(object) standardGeneric("generateMoments")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getB", function(object) standardGeneric("getB")) #' @noRd diff --git a/R/binomialmodelmoments.R b/R/binomialmodelmoments.R index a365797..86b6403 100644 --- a/R/binomialmodelmoments.R +++ b/R/binomialmodelmoments.R @@ -92,7 +92,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [modelmoments()] for the mutual constructor for all modelmoments #' * [binomialmodelmoments-class] for the class definition @@ -133,7 +133,8 @@ setMethod( #' #' @param object An `binomialmodelmoments` object. #' @returns The `extrabinvar` slot of the `object`. -#' @noRd +#' @exportMethod getExtrabinvar +#' @keywords internal #' #' @examples #' f_model <- model("binomial", par=list(p=c(0.3, 0.5)), diff --git a/R/cdatamoments.R b/R/cdatamoments.R index 476bdab..61ecf8c 100644 --- a/R/cdatamoments.R +++ b/R/cdatamoments.R @@ -172,7 +172,7 @@ setMethod( #' #' @param object An `cdatamoments` object. #' @returns The `smoments` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -200,7 +200,7 @@ setMethod( #' #' @param object An `cdatamoments` object. #' @returns The `higher` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -228,7 +228,7 @@ setMethod( #' #' @param object An `cdatamoments` object. #' @returns The `skewness` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -256,7 +256,7 @@ setMethod( #' #' @param object An `cdatamoments` object. #' @returns The `kurtosis` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -284,7 +284,7 @@ setMethod( #' #' @param object An `cdatamoments` object. #' @returns The `corr` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. diff --git a/R/cmodelmoments.R b/R/cmodelmoments.R index 2e13569..b5854b0 100644 --- a/R/cmodelmoments.R +++ b/R/cmodelmoments.R @@ -59,10 +59,10 @@ #' @param object An `cmodelmoments` object. #' @returns The `higher` slot of the `object`. #' @exportMethod getHigher -#' @noRd +#' @keywords internal #' #' @examples -#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getHigher(f_moments) @@ -81,7 +81,7 @@ setMethod("getHigher", "cmodelmoments", function(object) { #' @param object An `cmodelmoments` object. #' @returns The `skewness` slot of the `object`. #' @exportMethod getSkewness -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), @@ -103,7 +103,7 @@ setMethod("getSkewness", "cmodelmoments", function(object) { #' @param object An `cmodelmoments` object. #' @returns The `kurtosis` slot of the `object`. #' @exportMethod getKurtosis -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), diff --git a/R/csdatamoments.R b/R/csdatamoments.R index 0360826..cacc066 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -125,7 +125,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "csdatamoments", function(object) { @@ -165,7 +165,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `gmoments` slot of the `object`. #' @exportMethod getGmoments -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -197,7 +197,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `WK` slot of the `object`. #' @exportMethod getWK -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -229,7 +229,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `var` slot of the `object`. #' @exportMethod getVar -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -292,7 +292,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `W` slot of the `object`. #' @exportMethod getW -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -324,7 +324,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `T` slot of the `object`. #' @exportMethod getT -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -356,7 +356,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `R` slot of the `object`. #' @exportMethod getR -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -388,7 +388,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `Rtr` slot of the `object`. #' @exportMethod getRtr -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -420,7 +420,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `Rdet` slot of the `object`. #' @exportMethod getRdet -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. @@ -452,7 +452,7 @@ setMethod( #' @param object An `csdatamoments` object. #' @returns The `fdata` slot of the `object`. #' @exportMethod getFdata -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. diff --git a/R/dataclass.R b/R/dataclass.R index 7e8ac6e..d8bb103 100644 --- a/R/dataclass.R +++ b/R/dataclass.R @@ -19,10 +19,10 @@ #' Finmix `dataclass` class #' #' @description -#' Stores objects to classify observations using a fully specified mixture -#' model. If the indicators a finite mixture model is fully specified as then -#' the likelihood can be calculated for each observation depending on the -#' component it stems from. +#' Stores objects to classify observations using a fully specified mixture +#' model. If the indicators are known a finite mixture model is fully specified +#' as then the likelihood can be calculated for each observation depending on +#' the component it stems from. #' #' @slot logpy An array containing the logarithmized #' @slot prob An array storing the probability classification matrix that @@ -76,13 +76,13 @@ #' #' Calling [dataclass()] classifies data using a fully specified mixture model. #' Henceforth, the finite mixture model `model` must be fully specified, i.e. -#' containing parameters in slot `@@par`, weights in slot `@@weight` and -#' indicators in slot `@@S` of the corresponding `fdata` object. +#' containing parameters in slot `par`, weights in slot `weight` and +#' indicators in slot `S` of the corresponding `fdata` object. #' -#' @param fdata An `fdata` object containing observations in slot `@@y` and -#' indicators in slot `@@S`. -#' @param model A `model` object containing parameters in slot `@@par` and -#' and weights in slot `@@weight`. +#' @param fdata An `fdata` object containing observations in slot `y` and +#' indicators in slot `S`. +#' @param model A `model` object containing parameters in slot `par` and +#' and weights in slot `weight`. #' @param simS A logical defining, if the indicators `S` should be simulated. #' @return A `dataclass` object containing the classification matrix, #' model log-likelihood, entropy and indicators, if the latter have been @@ -92,8 +92,9 @@ #' @seealso #' * [dataclass-class] for the class definition #' -#' #' @references -#' Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" +#' @references +#' * Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching +#' Models" "dataclass" <- function(fdata = NULL, model = NULL, simS = FALSE) { .check.fdata.model.Dataclass(fdata, model) .check.model.Dataclass(model) @@ -132,7 +133,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [dataclass-class] for the class definition #' * [dataclass()] for the class constructor @@ -180,7 +181,8 @@ setMethod( #' #' @param object An `dataclass` object. #' @returns The `logpy` slot of the `object`. -#' @noRd +#' @exportMethod getLogpy +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -207,7 +209,8 @@ setMethod( #' #' @param object An `dataclass` object. #' @returns The `prob` slot of the `object`. -#' @noRd +#' @exportMethod getProb +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -234,7 +237,8 @@ setMethod( #' #' @param object An `dataclass` object. #' @returns The `mixlik` slot of the `object`. -#' @noRd +#' @exportMethod getMixlik +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -261,7 +265,8 @@ setMethod( #' #' @param object An `dataclass` object. #' @returns The `entropy` slot of the `object`. -#' @noRd +#' @exportMethod getEntropy +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -270,7 +275,7 @@ setMethod( #' f_data <- simulate(f_model) #' # Classify observations #' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) -#' getEntropy(f_datamoms) +#' getEntropy(f_dataclass) #' #' @seealso #' * [dataclass-class] for the base class @@ -289,7 +294,8 @@ setMethod( #' #' @param object An `dataclass` object. #' @returns The `loglikcd` slot of the `object`. -#' @noRd +#' @exportMethod getLoglikcd +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -317,7 +323,8 @@ setMethod( #' #' @param object An `dataclass` object. #' @returns The `postS` slot of the `object`. -#' @noRd +#' @exportMethod getPostS +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -385,7 +392,7 @@ setMethod( #' For internal usage only. This function checks if the `model` object passed #' in by the user is first of all indeed a finmix `model` object. Furthermore, #' it is checked if the model is fully specified meaning that parameters are -#' defined in slot `@@par` and weights in slot `@@weight`. +#' defined in slot `par` and weights in slot `weight`. #' #' @param model.obj A `model` object. Must be fully specified. #' @return None. If the checks do not pass, an error is thrown. @@ -414,11 +421,11 @@ setMethod( #' #' For internal usage only. This function checks if the indicators stored in #' the `fdata` object are correctly specified meaning if the indicator values -#' are indeed from as many components as specifed in the slot `@@K` of the +#' are indeed from as many components as specifed in the slot `K` of the #' corresponding model object. #' #' @param fdata.obj An `fdata` object containing the indicators in its slot -#' `@@S`. +#' `S`. #' @param model.obj A `model` object. Must be fully specified. #' @return None. If the checks do not pass, an error is thrown. #' @noRd @@ -441,17 +448,17 @@ setMethod( #' Checking Student-t and normal `model` objects for `dataclass` constructor #' #' For internal usage only. Thiss function checks if the `model` object passed -#' in by the user is correctly specified in case the slot `@@dist` is one of +#' in by the user is correctly specified in case the slot `dist` is one of #' `normult` or `studmult`. Correctly specified for data classification means -#' that the slots `@@sigmainv` and `@@logdet` are non-null. `@@sigmainv` is the +#' that the slots `sigmainv` and `logdet` are non-null. `sigmainv` is the #' inverse of the variance-covariance matrix of a multivariate normal or -#' Student-t distribution. Slot `@@logdet` defines the logarithm of the +#' Student-t distribution. Slot `logdet` defines the logarithm of the #' determinant of the inverse of the variance-covariance matrix. If these slots #' are not specified this function specifies these slots for the user. #' #' @param model.obj A `model` object. Must be fully specified. #' @return The passed-in `model` object by the user possibly enriched by slots -#' `@@sigmainv` and `@@logdet`. If the checks do not pass, an error is thrown. +#' `sigmainv` and `logdet`. If the checks do not pass, an error is thrown. #' @noRd #' #' @seealso @@ -491,7 +498,7 @@ setMethod( #' For internal usage only. This function calls the appropriate function for #' each finite mixture model specified in `model.obj`. #' -#' @param fdata.obj An `fdata` object with non-empty slot `@@y`. +#' @param fdata.obj An `fdata` object with non-empty slot `y`. #' @param model.obj A `model` object. Must be fully specified. #' @return A list containing the likelihood, the maximum likelihood and the #' log-likelihood. @@ -563,7 +570,7 @@ setMethod( #' and, if specified, simulates indicators `S`. A corresponding classification #' for a Markov indicator model is not (yet) implemented. #' -#' @param fdata.obj An `fdata` object with non-empty slot `@@y`. +#' @param fdata.obj An `fdata` object with non-empty slot `y`. #' @param model.obj A `model` object. Must be fully specified. #' @param lik.list A list containing the likelihood, maximum likelihood and #' log-likelihood for the data using the specified model. @@ -634,7 +641,7 @@ setMethod( #' @description #' For internal usage only. This function computes the mixture likelihood for #' the finite mixture model specified in `model.obj` using the likelihoods -#' of each single component and the weights specified in slot `@@weight` of the +#' of each single component and the weights specified in slot `weight` of the #' `model` object. #' #' @param model.obj A `model` object. Must be fully specified. @@ -711,9 +718,9 @@ setMethod( #' For internal usage only. This function classifies data from a finite #' mixture model with fixed indicators. #' -#' @param fdata.obj An `fdata` object with non-empty slot `@@y`. +#' @param fdata.obj An `fdata` object with non-empty slot `y`. #' @param model.obj A `model` object. Must be fully specified. The slot -#' `@@indicfix` must be `TRUE`. +#' `indicfix` must be `TRUE`. #' @param lik.list A list containing the likelihood, maximum likelihood, and #' log-likelihood for the data in the `fdata` object. #' @return An object of class `dataclass` containing the likelihood values for diff --git a/R/ddatamoments.R b/R/ddatamoments.R index 60dd56e..ede5adc 100644 --- a/R/ddatamoments.R +++ b/R/ddatamoments.R @@ -112,7 +112,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [datamoments-class] for the parent class definition #' * [datamoments()] for the mutual constructor of all datamoments classes @@ -160,7 +160,7 @@ setMethod( #' #' @param object An `ddatamoments` object. #' @returns The `smoments` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -184,11 +184,12 @@ setMethod( #' Getter method of `ddatamoments` class. #' -#' Returns the `smoments` slot. +#' Returns the `factorial` slot. #' #' @param object An `ddatamoments` object. -#' @returns The `smoments` slot of the `object`. -#' @noRd +#' @returns The `factorial` slot of the `object`. +#' @exportMethod getFactorial +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -212,11 +213,11 @@ setMethod( #' Getter method of `ddatamoments` class. #' -#' Returns the `smoments` slot. +#' Returns the `over` slot. #' #' @param object An `ddatamoments` object. -#' @returns The `smoments` slot of the `object`. -#' @noRd +#' @returns The `over` slot of the `object`. +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -240,11 +241,11 @@ setMethod( #' Getter method of `ddatamoments` class. #' -#' Returns the `smoments` slot. +#' Returns the `zero` slot. #' #' @param object An `ddatamoments` object. -#' @returns The `smoments` slot of the `object`. -#' @noRd +#' @returns The `zero` slot of the `object`. +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. diff --git a/R/dmodelmoments.R b/R/dmodelmoments.R index d2578a3..4b01c29 100644 --- a/R/dmodelmoments.R +++ b/R/dmodelmoments.R @@ -54,7 +54,8 @@ #' #' @param object An `dmodelmoments` object. #' @returns The `higher` slot of the `object`. -#' @noRd +#' @exportMethod getHigher +#' @keywords internal #' #' @examples #' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), @@ -75,7 +76,8 @@ setMethod("getOver", "dmodelmoments", function(object) { #' #' @param object An `dmodelmoments` object. #' @returns The `skewness` slot of the `object`. -#' @noRd +#' @exportMethod getSkewness +#' @keywords internal #' #' @examples #' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), @@ -96,7 +98,8 @@ setMethod("getFactorial", "dmodelmoments", function(object) { #' #' @param object An `dmodelmoments` object. #' @returns The `kurtosis` slot of the `object`. -#' @noRd +#' @exportMethod getKurtosis +#' @keywords internal #' #' @examples #' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index 19156c2..d336e94 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -99,7 +99,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes @@ -139,7 +139,7 @@ setMethod( #' @param object An `exponentialmodelmoments` object. #' @returns The `B` slot of the `object`. #' @exportMethod getB -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), @@ -164,7 +164,7 @@ setMethod( #' @param object An `exponentialmodelmoments` object. #' @returns The `W` slot of the `object`. #' @exportMethod getW -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), @@ -189,7 +189,7 @@ setMethod( #' @param object An `exponentialmodelmoments` object. #' @returns The `R` slot of the `object`. #' @exportMethod getR -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), diff --git a/R/fdata.R b/R/fdata.R index 25b81ba..e3c6b1f 100644 --- a/R/fdata.R +++ b/R/fdata.R @@ -318,7 +318,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' #' @examples #' # Generate some Poisson data and show the `fdata` object @@ -1259,7 +1259,6 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. -#' #' @noRd #' #' @seealso @@ -1507,7 +1506,6 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. - #' @noRd #' #' @seealso @@ -1534,7 +1532,6 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. - #' @noRd #' #' @seealso @@ -1557,7 +1554,6 @@ setReplaceMethod( #' @param y An object passed in by the user. #' @returns None. Checks for validity and if validity is not ensured throws an #' error. - #' @noRd #' #' @seealso @@ -1583,7 +1579,6 @@ setReplaceMethod( #' @param obj An `fdata` object. Must contain data. #' @returns A barplot. #' - #' @noRd #' #' @seealso @@ -1641,7 +1636,6 @@ setReplaceMethod( #' @returns A histogram. #' @importFrom KernSmooth bkde2D #' @importFrom stats sd - #' @noRd #' #' @seealso @@ -1742,7 +1736,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -1772,7 +1765,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -1799,7 +1791,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -1857,7 +1848,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -1921,7 +1911,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -1990,7 +1979,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -2063,7 +2051,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -2131,7 +2118,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -2203,7 +2189,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -2271,7 +2256,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso @@ -2342,7 +2326,6 @@ setReplaceMethod( #' #' @param obj An `fdata` object to be checked. #' @returns None. Throws an error, if a certain condition is not true. - #' @noRd #' #' @seealso diff --git a/R/groupmoments.R b/R/groupmoments.R index 1d099b7..91bfa95 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -149,7 +149,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "groupmoments", function(object) { @@ -184,7 +184,8 @@ setMethod( #' #' @param object An `groupmoments` object. #' @returns The `NK` slot of the `object`. -#' @noRd +#' @exportMethod getNK +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -197,7 +198,7 @@ setMethod( #' getNK(f_gmoments) #' #' @seealso -#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' * [groupmoments-class] for the definition of the `groupmoments` #' class #' * [groupmoments()] for the class constructor setMethod( @@ -213,7 +214,8 @@ setMethod( #' #' @param object An `groupmoments` object. #' @returns The `mean` slot of the `object`. -#' @noRd +#' @exportMethod getMean +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -226,7 +228,7 @@ setMethod( #' getMean(f_gmoments) #' #' @seealso -#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' * [groupmoments-class] for the definition of the `groupmoments` #' class #' * [groupmoments()] for the class constructor setMethod( @@ -242,7 +244,8 @@ setMethod( #' #' @param object An `groupmoments` object. #' @returns The `WK` slot of the `object`. -#' @noRd +#' @exportMethod getWK +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -255,7 +258,7 @@ setMethod( #' getWK(f_gmoments) #' #' @seealso -#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' * [groupmoments-class] for the definition of the `groupmoments` #' class #' * [groupmoments()] for the class constructor setMethod( @@ -271,7 +274,8 @@ setMethod( #' #' @param object An `groupmoments` object. #' @returns The `Var` slot of the `object`. -#' @noRd +#' @exportMethod getVar +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. @@ -284,7 +288,7 @@ setMethod( #' getVar(f_gmoments) #' #' @seealso -#' * [groupmoments][groupmments_class] for the definition of the `groupmoments` +#' * [groupmoments-class] for the definition of the `groupmoments` #' class #' * [groupmoments()] for the class constructor setMethod( diff --git a/R/mcmcestfix.R b/R/mcmcestfix.R index 40060c2..baae1da 100644 --- a/R/mcmcestfix.R +++ b/R/mcmcestfix.R @@ -44,7 +44,7 @@ #' @slot bml A named list containing the parameter estimates of the BML. The #' element `par` is a named list and contains the component parameters and #' the element `weight` contains the weights. -#' @slot A named list containing the parameter estimates of the IEAVG. The +#' @slot ieavg A named list containing the parameter estimates of the IEAVG. The #' element `par` is a named list and contains the component parameters and #' the element `weight` contains the weights. #' @slot sdpost A named list containing the standard deviations of the @@ -99,7 +99,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcestfix", function(object) { @@ -145,7 +145,7 @@ setMethod( #' @returns A console output listing the formatted slots and summary #' information about each of them. #' @exportMethod Summary -#' @noRd +#' @keywords internal setMethod( "Summary", "mcmcestfix", function(x, ..., na.rm = FALSE) { @@ -208,7 +208,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `dist` slot of the `object`. #' @exportMethod getDist -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -224,7 +224,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getDist(f_output) +#' getDist(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -244,7 +244,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `K` slot of the `object`. #' @exportMethod getK -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -260,7 +260,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getK(f_output) +#' getK(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -280,7 +280,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `indicmod` slot of the `object`. #' @exportMethod getIndicmod -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -296,7 +296,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getIndicmod(f_output) +#' getIndicmod(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -316,7 +316,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `burnin` slot of the `object`. #' @exportMethod getBurnin -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -332,7 +332,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getBurnin(f_output) +#' getBurnin(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -352,7 +352,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `M` slot of the `object`. #' @exportMethod getM -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -368,7 +368,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getM(f_output) +#' getM(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -388,7 +388,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `ranperm` slot of the `object`. #' @exportMethod getRanperm -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -404,7 +404,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getRanperm(f_output) +#' getRanperm(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -424,7 +424,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `relabel` slot of the `object`. #' @exportMethod getRelabel -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -440,7 +440,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getRelabel(f_output) +#' getRelabel(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -460,7 +460,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `map` slot of the `object`. #' @exportMethod getMap -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -476,7 +476,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getMap(f_output) +#' getMap(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -496,7 +496,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `bml` slot of the `object`. #' @exportMethod getBml -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -512,7 +512,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getBml(f_output) +#' getBml(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -532,7 +532,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `ieavg` slot of the `object`. #' @exportMethod getIeavg -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -548,7 +548,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getIeavg(f_output) +#' getIeavg(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models @@ -568,7 +568,7 @@ setMethod( #' @param object An `mcmcestfix` object. #' @returns The `sdpost` slot of the `object`. #' @exportMethod getSdpost -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -584,7 +584,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getIeavg(f_output) +#' getIeavg(f_est) #' #' @seealso #' * [mcmcestind-class] for the corresponding class for models diff --git a/R/mcmcestimate.R b/R/mcmcestimate.R index d8ad955..f0328da 100644 --- a/R/mcmcestimate.R +++ b/R/mcmcestimate.R @@ -46,7 +46,7 @@ #' returned as well. Optional. #' @param opt_ctrl A list with an element `max_iter` controlling the number of #' iterations in case the "Stephens1997a" re-labeling algorithm is chosen. -#' @return An `mcmcest` object cotnaining the point estimates together with +#' @return An `mcmcest` object containing the point estimates together with #' additional information about the underlying finite mixture model, MCMC #' sampling hyper-parameters and the data. In case `permOut` is set to #' `TRUE`, the output of this function is a named list with an `mcmcest` @@ -632,8 +632,12 @@ ) } else { sdpar <- apply(obj@par$lambda, 2, sd, na.rm = TRUE) - sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) - identified <- list(par = list(lambda = sdpar), weight = sdweight) + if (!obj@model@indicfix) { + sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) + identified <- list(par = list(lambda = sdpar), weight = sdweight) + } else { + identified <- list(par = list(lambda = sdpar)) + } sdlist <- list(identified = identified) } return(sdlist) @@ -673,6 +677,8 @@ unidentified = unidentified ) } else { + # TODO: Make a difference between indicfix. Take the weight from the + # model for fixed indicators. sdpar <- apply(obj@par$p, 2, sd, na.rm = TRUE) sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) identified <- list( @@ -720,6 +726,8 @@ unidentified = unidentified ) } else { + # TODO: Make a difference between indicfix. Take the weight from the + # model for fixed indicators. sdmu <- apply(obj@par$mu, 2, sd, na.rm = TRUE) sdsigma <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) sdweight <- apply(obj@weight, 2, sd, na.rm = TRUE) @@ -776,6 +784,8 @@ unidentified = unidentified ) } else { + # TODO: Make a difference between indicfix. Take the weight from the + # model for fixed indicators. sdmu <- apply(obj@par$mu, 2, sd, na.rm = TRUE) sdsigma <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) sddf <- apply(obj@par$sigma, 2, sd, na.rm = TRUE) @@ -856,6 +866,8 @@ unidentified = unidentified ) } else { + # TODO: Make a difference between indicfix. Take the weight from the + # model for fixed indicators. if (K == 1) { sdmu <- cov(obj@par$mu) sdsigma <- cov(obj@par$sigma) @@ -951,6 +963,8 @@ unidentified = unidentified ) } else { + # TODO: Make a difference between indicfix. Take the weight from the + # model for fixed indicators. if (K == 1) { sdmu <- cov(obj@par$mu) sdsigma <- cov(obj@par$sigma) diff --git a/R/mcmcestind.R b/R/mcmcestind.R index 3581beb..da61c20 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -49,15 +49,108 @@ prototype(eavg = list()) ) -#' Finmix `mcmcest` class union +#' Finmix `mcmcest` class #' #' @description -#' This class union includes all classes that define objects for storing the -#' parameter estimates and is used to dispatch methods for `mcmcest` objects. +#' This class stores Bayesian parameter estimates from MCMC samples and +#' corresponding metadata. Calling [mcmcestimate()] returns an object of this +#' class. +#' +#' @details +#' Calling [mcmcestimate()] on an object of class `mcmcoutput` or +#' `mcmcoutputperm` returns an object of class `mcmcest` that contains all +#' Bayesian estimates together with corresponding metadata. Three Bayesian +#' point estimates are constructed: +#' +#' * __BML__: The Bayesian Maximum Likelihood, which is the parameter sample +#' from MCMC sampling that maximizes the mixture likelihood. +#' * __MAP__: The Bayesian Maximum A Posterior, which is the parameter sample +#' from MCMC sampling that maximizes the the posterior maximum likelihood. +#' * __EAVG__: The Ergodic Average over the MCMC samples without identification. +#' * __IEAVG__: The Identified Ergodic Average over the MCMC samples with +#' identification. +#' +#' Note that a model with fixed indicators (i.e. slot `indicfix=TRUE`) has +#' always an identified ergodic average, because in each MCMC sample the +#' component labels are the same and therefore identified. In contrast, a +#' model with unknown indicators (i.e. `indicfix=FALSE`) suffers usually under +#' random label switching during sampling and therefore the ergodic average +#' over all MCMC samples is usually not identified as it averages over +#' parameters from different components thereby pulling the component +#' parameters together (sometimes you get the same average for all components). +#' The `ieavg` is calculated for a model with unknown indicators by relabeling +#' the component parameter samples. Re-labeling reassigns component parameters +#' to the most likely label of the mixture in regard to the observations. As a +#' result the `mcmcest` object of a model with unknown indicators will have +#' both, an `eavg` and an `ieavg` slot containing the ergodic average over +#' samples before and after re-labeling. The `relabel` slot indicates which +#' re-labeling algorithm had been chosen. +#' +#' The uncertainty of parameter estimates is measured by the standard deviation +#' over parameters from MCMC sampling and stored in the `sdpost` slot. It is +#' an estimate of the standard deviation of the true posterior parameter +#' distribution. +#' +#' The class `mcmcest` is a class union and includes all classes that define +#' objects for Bayesian estimates of MCMC samples and is used to dispatch +#' methods for `mcmcest` objects. For the user this detail is not important, +#' especially as this class has no exported constructor. Objects are solely +#' constructed internally within the function [mcmcestimate()]. +#' +#' ## Class Methods +#' Similar to the contained classes [mcmcoutput][mcmcoutput-class] this class comes +#' along with a couple of methods that should give the user some comfort in +#' handling the permuted sampling results. There are no setters for this class +#' as the slots are only set internally. +#' +#' ### Show and Summary +#' * `show()` gives a short summary of the object's slots. +#' * `Summary()` prints out a summary of estimation results. +#' +#' ### Getters +#' * `getDist()` returns the `dist` slot. +#' * `getK()` returns the `K` slot. +#' * `getIndicmod()` returns the `indicmod` slot. +#' * `getBurnin()` returns the `burnin` slot. +#' * `getM()` returns the `M` slot. +#' * `getRanperm()` returns the `ranperm` slot. +#' * `getRelabel()` returns the `relabel` slot. +#' * `getMap()` returns the MAP estimates. +#' * `getBml()` returns the BML estimates. +#' * `getEavg()` returns the EAVG estimates. +#' * `getIEAVG()` returns the identified EAVG estimates. +#' * `getSdpost()` returns the `sdpost`. +#' +#' @slot dist A character specifying the distribution family of the mixture +#' model used in MCMC sampling. +#' @slot K An integer specifying the number of components in the mixture model. +#' @slot indicmod A character specifying the indicator model. At this moment +#' only a multinomial model can be chosen. +#' @slot burnin An integer specifying the number of iterations in the burn-in +#' phase of MCMC sampling. +#' @slot M An integer specifying the number of iterations to store in MCMC +#' sampling. +#' @slot ranperm A logical specifying, if random permutation has been used +#' during MCMC sampling. +#' @slot relabel A character specifying the re-labeling algorithm used during +#' parameter estimation for the identified ergodic average. +#' @slot map A named list containing the parameter estimates of the MAP. The +#' element `par` is a named list and contains the component parameters and +#' the element `weight` contains the weights. +#' @slot bml A named list containing the parameter estimates of the BML. The +#' element `par` is a named list and contains the component parameters and +#' the element `weight` contains the weights. +#' @slot eavg A named list containing the parameter estimates of the +#' unidentified EAVG. Note that this is only the case for a model with +#' unknown indicators. +#' @slot ieavg A named list containing the parameter estimates of the IEAVG. The +#' element `par` is a named list and contains the component parameters and +#' the element `weight` contains the weights. +#' @slot sdpost A named list containing the standard deviations of the +#' parameter estimates from the posterior distributions. #' #' @exportClass mcmcest #' @name mcmcest-class -#' @noRd setClassUnion( "mcmcest", c( @@ -75,7 +168,7 @@ setClassUnion( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcestind", function(object) { @@ -204,7 +297,7 @@ setMethod( #' @param object An `mcmcestind` object. #' @returns The `eavg` slot of the `object`. #' @exportMethod getEavg -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -219,7 +312,7 @@ setMethod( #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' f_est <- mcmcestimate(f_output) #' # Get the slot. -#' getEavg(f_output) +#' getEavg(f_est) #' #' @seealso #' * [mcmcestfix-class] for the parent class with fixed indicators diff --git a/R/mcmcextract.R b/R/mcmcextract.R index 7430ba7..b3ac0d7 100644 --- a/R/mcmcextract.R +++ b/R/mcmcextract.R @@ -15,7 +15,7 @@ #' #' @exportClass mcmcextract #' @name mcmcextract-class -#' @noRd +#' @keywords internal .mcmcextract <- setClass("mcmcextract", representation( dist = "character", diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index 2035cf4..920f286 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -15,8 +15,6 @@ # You should have received a copy of the GNU General Public License # along with finmix. If not, see . -# TODO: CHange examples to storepost = FALSE - #' Finmix `mcmcoutput` base class for unknown indicators #' #' @description @@ -510,7 +508,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `weight` slot of the `object`. #' @exportMethod getWeight -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -545,7 +543,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `entropy` slot of the `object`. #' @exportMethod getEntropy -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -580,7 +578,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `ST` slot of the `object`. #' @exportMethod getST -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -614,7 +612,7 @@ setMethod( #' #' @param object An `mcmcoutput` object. #' @returns The `S` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -649,7 +647,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `NK` slot of the `object`. #' @exportMethod getNK -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -684,7 +682,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `clust` slot of the `object`. #' @exportMethod getClust -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -1463,7 +1461,7 @@ setMethod( index.S <- index[(ms + 1):M] N <- dim(obj@S)[1] if (any(index.S)) { - obj@S <- array(obj@S[, index.S], dim = c(N, storeS)) + obj@S <- array(obj@S[, index.S], dim = c(N, sum(index.S))) } else { obj@S <- as.array(NA) } @@ -1493,7 +1491,7 @@ setMethod( K <- ncol(index) storeS <- ifelse(!all(is.na(obj@S)), dim(obj@S)[2], 0) if (storeS != 0) { - index.S <- matrix(index[(M - storeS + 1):M, ], + index.S <- matrix(index[(M - min(storeS, M) + 1):M, ], ncol = K, byrow = TRUE ) obj@S <- swapInd_cc(obj@S, index.S) diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index 4568671..3deb42c 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -581,7 +581,7 @@ setMethod( #' sampling. #' @return The moments on the samples of a multivariate Normal mixture. #' @exportMethod moments -#' @noRd +#' @keywords internal setMethod( "moments", signature(object = "mcmcoutputfix"), function(object) { @@ -600,7 +600,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `M` slot of the `object`. #' @exportMethod getM -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -634,7 +634,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `burnin` slot of the `object`. #' @exportMethod getBurnin -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -668,7 +668,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `ranperm` slot of the `object`. #' @exportMethod getRanperm -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -702,7 +702,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `par` slot of the `object`. #' @exportMethod getPar -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -736,7 +736,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `log` slot of the `object`. #' @exportMethod getLog -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -770,7 +770,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `model` slot of the `object`. #' @exportMethod getModel -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -805,7 +805,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `prior` slot of the `object`. #' @exportMethod getPrior -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index 4f67db4..afee80d 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -490,7 +490,7 @@ setMethod( #' @param object An `mcmcoutput` object. #' @returns The `hyper` slot of the `object`. #' @exportMethod getHyper -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputfixpost.R b/R/mcmcoutputfixpost.R index d44b65b..9b83746 100644 --- a/R/mcmcoutputfixpost.R +++ b/R/mcmcoutputfixpost.R @@ -475,7 +475,7 @@ setMethod( #' @param object An `mcmcoutputfixpost` object. #' @returns The `post` slot of the `object`. #' @exportMethod getPost -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index f53ce25..8a8c306 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -493,7 +493,7 @@ setMethod( #' @param object An `mcmcoutputhier` object. #' @returns The `hyper` slot of the `object`. #' @exportMethod getHyper -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index 8f6eb37..6ef1362 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -619,10 +619,10 @@ setMethod( #' data from permutation. These slots are listed below #' #' ## Class methods -#' Similar to the parent class [mcmcoutput][mcmcoutput-class] this class comes -#' along with a couple of methods that should give the user some comfort in -#' handling the permuted sampling results. There are no setters for this class -#' as the slots are only set internally. +#' Similar to the contained classes [mcmcoutput][mcmcoutput-class] this class +#' comes along with a couple of methods that should give the user some comfort +#' in handling the permuted sampling results. There are no setters for this +#' class as the slots are only set internally. #' #' ### Show #' * `show()` shows a short summary of the object's slots. @@ -655,7 +655,7 @@ setMethod( #' * `plotPostDens()` plots the posterior density of component parameters. Note #' that this function can only be applied for mixtures of two components. See #' [plotPostDens()] for further information. -#' +#' #' @slot Mperm An integer defining the number of permuted MCMC samples. #' @slot parperm A named list containing the permuted component parameter #' samples from MCMC sampling. @@ -1160,4 +1160,49 @@ NULL #' * [mcmcoutput-class] for the class definition #' * [subseq()] for generating sub-chains from MCMC samples #' * [mcmcpermute()] for a calling function +NULL + +#' Extracts single samples from a multivariate Normal mixture +#' +#' @description +#' Calling [extract()] on an `mcmcoutput` object with a multivariate Normal +#' mixture model extracts single samples. +#' +#' @details +#' This function simplifies the analysis of multivariate Normal mixtures that +#' come along with matrices instead of vectors for component parameters as it +#' extracts the mean matrix, the variance matrices and in addition the inverted +#' variance matrices with a single call. In additon, it enriches the output +#' object with metadata like the dimension of the data `r`, the number of +#' components `K`, and the distribution (in this case `"normult`). +#' +#' @param object An `mcmcoutput` or `mcmcoutputperm` object containing the MCMC +#' samples. +#' @param index An `integer` specifying the dimension to extract. +#' @return An `mcmcextract` object containing the parameters, weights, and +#' metadata of the extracted dimension. +#' @rdname extract-method +#' @name extract +#' +#' @examples +#' # Generate a multivariate Normal mixture model. +#' means <- matrix(c(1, 2, 2, 4), nrow = 2) +#' var1 <- matrix(c(1, 0.3, 0.3, 2), nrow=2) +#' var2 <- matrix(c(3, 0.3, 0.3, 6), nrow=2) +#' vars <- array(c(var1,var2), dim = c(2,2,2)) +#' f_model <- model(dist='normult', K = 2, r = 2, par = list(mu=means, sigma=vars)) +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc(storepost = FALSE) +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Extract a single MCMC sample. +#' f_output1 <- extract(f_output, index = 1000) +#' +#' @seealso +#' * [mcmcoutput-class] for the definition of the `mcmcoutput` class +#' * [mcmcoutputperm-class] for the definition of the `mcmcoutputperm` class +#' * [mcmcextract-class] for the output class NULL \ No newline at end of file diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index 4424385..b45d538 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -485,7 +485,7 @@ setMethod( #' @param object An `mcmcoutputhier` object. #' @returns The `post` slot of the `object`. #' @exportMethod getPost -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcpermfix.R b/R/mcmcpermfix.R index a5f50d9..49a378b 100644 --- a/R/mcmcpermfix.R +++ b/R/mcmcpermfix.R @@ -69,7 +69,7 @@ #' @param object An `mcmcpermfix` object. #' @returns The `Mperm` slot of the `object`. #' @exportMethod getMperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getMperm(mcmcperm)} @@ -91,7 +91,7 @@ setMethod( #' @param object An `mcmcpermfix` object. #' @returns The `parperm` slot of the `object`. #' @exportMethod getParperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getParperm(mcmcperm)} @@ -113,7 +113,7 @@ setMethod( #' @param object An `mcmcpermfix` object. #' @returns The `logperm` slot of the `object`. #' @exportMethod getLogperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getLogperm(mcmcperm)} diff --git a/R/mcmcpermfixhier.R b/R/mcmcpermfixhier.R index 7e19e7c..c58523e 100644 --- a/R/mcmcpermfixhier.R +++ b/R/mcmcpermfixhier.R @@ -59,7 +59,7 @@ #' @param object An `mcmcpermfixhier` object. #' @returns The `hyperperm` slot of the `object`. #' @exportMethod getHyperperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getHyperpem(mcmcperm)} diff --git a/R/mcmcpermfixpost.R b/R/mcmcpermfixpost.R index d838fe1..6654447 100644 --- a/R/mcmcpermfixpost.R +++ b/R/mcmcpermfixpost.R @@ -60,7 +60,7 @@ #' @param object An `mcmcpermfixpost` object. #' @returns The `postperm` slot of the `object`. #' @exportMethod getPostperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getMperm(mcmcperm)} diff --git a/R/mcmcpermind.R b/R/mcmcpermind.R index 3192787..3ce7f99 100644 --- a/R/mcmcpermind.R +++ b/R/mcmcpermind.R @@ -87,7 +87,7 @@ #' @param object An `mcmcpermind` object. #' @returns The `relabel` slot of the `object`. #' @exportMethod getRelabel -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getRelabel(mcmcperm)} @@ -109,7 +109,7 @@ setMethod( #' @param object An `mcmcpermind` object. #' @returns The `weightperm` slot of the `object`. #' @exportMethod getWeightperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getWeightperm(mcmcperm)} @@ -131,7 +131,7 @@ setMethod( #' @param object An `mcmcpermind` object. #' @returns The `entropyperm` slot of the `object`. #' @exportMethod getEntropyperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getEntropyperm(mcmcperm)} @@ -153,7 +153,7 @@ setMethod( #' @param object An `mcmcpermind` object. #' @returns The `STperm` slot of the `object`. #' @exportMethod getSTperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getSTperm(mcmcperm)} @@ -175,7 +175,7 @@ setMethod( #' @param object An `mcmcpermind` object. #' @returns The `Sperm` slot of the `object`. #' @exportMethod getSperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getSperm(mcmcperm)} @@ -197,7 +197,7 @@ setMethod( #' @param object An `mcmcpermind` object. #' @returns The `NKperm` slot of the `object`. #' @exportMethod getNKperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getNKperm(mcmcperm)} diff --git a/R/mcmcpermindhier.R b/R/mcmcpermindhier.R index c6bbffe..26224ad 100644 --- a/R/mcmcpermindhier.R +++ b/R/mcmcpermindhier.R @@ -60,14 +60,14 @@ #' @param object An `mcmcpermindhier` object. #' @returns The `hyperperm` slot of the `object`. #' @exportMethod getHyperperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getHyperpem(mcmcperm)} #' #' @seealso -#' * \code{\link{mcmcoutputpermind}} for the inheriting class -#' * \code{\link{mcmcpermute}} for function permuting MCMC samples +#' * [mcmcoutputpermhier-class] for the inheriting class +#' * [mcmcpermute()] for function permuting MCMC samples setMethod( "getHyperperm", "mcmcpermfixpost", function(object) { diff --git a/R/mcmcpermindpost.R b/R/mcmcpermindpost.R index 37f5cdc..d0a48e8 100644 --- a/R/mcmcpermindpost.R +++ b/R/mcmcpermindpost.R @@ -58,7 +58,7 @@ #' @param object An `mcmcpermindpost` object. #' @returns The `postperm` slot of the `object`. #' @exportMethod getPostperm -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{getPostperm(mcmcperm)} diff --git a/R/model.R b/R/model.R index 5c1ea27..e726d9e 100644 --- a/R/model.R +++ b/R/model.R @@ -3118,7 +3118,7 @@ setReplaceMethod( ), call. = FALSE ) - } else if (!all(is.numeric(obj@par$mu) || is.numeric(obj@par$mu))) { + } else if (!all(is.numeric(obj@par$mu) || !is.numeric(obj@par$mu))) { stop(paste("Wrong specification of slot @par: ", "parameters must be of type 'numeric ", "or 'integer'.", diff --git a/R/modelmoments.R b/R/modelmoments.R index c4bb83c..53559bd 100644 --- a/R/modelmoments.R +++ b/R/modelmoments.R @@ -91,7 +91,7 @@ setClass("modelmoments", #' @param object A `modelmoments` object. #' @returns The `mean` slot of the `object`. #' @exportMethod getMean -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), @@ -114,7 +114,7 @@ setMethod( #' @param object A `modelmoments` object. #' @returns The `var` slot of the `object`. #' @exportMethod getVar -#' @noRd +#' @keywords internal #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) @@ -136,7 +136,7 @@ setMethod( #' @param object A `modelmoments` object. #' @returns The `model` slot of the `object`. #' @exportMethod getModel -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), diff --git a/R/normalmodelmoments.R b/R/normalmodelmoments.R index 8df1c4c..a428bff 100644 --- a/R/normalmodelmoments.R +++ b/R/normalmodelmoments.R @@ -99,7 +99,8 @@ setMethod( #' @param object An `normalmodelmoments` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @noRd +#' @exportMethod show +#' @keywords internal #' @seealso #' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes @@ -144,7 +145,8 @@ setMethod( #' #' @param object An `normalmodelmoments` object. #' @returns The `B` slot of the `object`. -#' @noRd +#' @exportMethod getB +#' @keywords internal #' #' @examples #' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) @@ -170,7 +172,8 @@ setMethod( #' #' @param object An `normalmodelmoments` object. #' @returns The `W` slot of the `object`. -#' @noRd +#' @exportMethod getW +#' @keywords internal #' #' @examples #' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) @@ -196,7 +199,8 @@ setMethod( #' #' @param object An `normalmodelmoments` object. #' @returns The `R` slot of the `object`. -#' @noRd +#' @exportMethod getR +#' @keywords internal #' #' @examples #' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index af96571..25f8db8 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -103,7 +103,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes @@ -163,7 +163,7 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns The `B` slot of the `object`. #' @exportMethod getB -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) @@ -191,7 +191,7 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns The `W` slot of the `object`. #' @exportMethod getW -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) @@ -219,7 +219,7 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns The `Rdet` slot of the `object`. #' @exportMethod getRdet -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) @@ -247,7 +247,7 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns The `Rtr` slot of the `object`. #' @exportMethod getRtr -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) @@ -274,7 +274,7 @@ setMethod( #' @param object An `normultmodelmoments` object. #' @returns The `Corr` slot of the `object`. #' @exportMethod getCorr -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) @@ -282,6 +282,7 @@ setMethod( #' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) #' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) #' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) #' getCorr(f_moments) #' #' @seealso diff --git a/R/poissonmodelmoments.R b/R/poissonmodelmoments.R index 20a8fe4..922d83c 100644 --- a/R/poissonmodelmoments.R +++ b/R/poissonmodelmoments.R @@ -88,7 +88,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes diff --git a/R/prior.R b/R/prior.R index 4652ef5..d692c54 100644 --- a/R/prior.R +++ b/R/prior.R @@ -169,14 +169,14 @@ #' Checks for parameters in a `prior` object #' #' @description -#' Calling [hasPriorPar()] checks if `model`-appropriate parameters are stored +#' Calling `hasPriorPar()` checks if `model`-appropriate parameters are stored #' in the `prior` object. #' #' @param object A `prior` object containing the specifications for the prior. #' @param model A `model` object containing the specifications for the model. #' @param verbose A logical indicating, if the output should be verbose. #' @exportMethod hasPriorPar -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model. @@ -280,7 +280,7 @@ setMethod( #' @param s A numeric specifying the standard deviation `s` for the #' Metropolis-Hastings proposal. #' @rdname generatePrior -#' @keywords internal +#' @noRd #' #' @seealso #' * [prior-class] for the class definition @@ -333,7 +333,8 @@ setMethod( #' @param object A `prior` object. #' @returns A console output listing the slots and summary information about #' each of them. -#' @noRd +#' @exportMethod show +#' @keywords internal #' @seealso #' * [prior-class] for the class definition #' * [prior()] for the basic constructor of the class @@ -366,7 +367,7 @@ setMethod( #' @param object An `prior` object. #' @returns The `weight` slot of the `object`. #' @exportMethod getWeight -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -388,7 +389,7 @@ setMethod( #' @param object An `prior` object. #' @returns The `par` slot of the `object`. #' @exportMethod getPar -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -410,7 +411,7 @@ setMethod( #' @param object An `prior` object. #' @returns The `type` slot of the `object`. #' @exportMethod getType -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -432,7 +433,7 @@ setMethod( #' @param object An `prior` object. #' @returns The `hier` slot of the `object`. #' @exportMethod getHier -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -455,7 +456,7 @@ setMethod( #' @param value An integer defining the new value for the `@@weight` slot. #' @returns None. #' @exportMethod setWeight<- -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -479,7 +480,7 @@ setReplaceMethod( #' @param value An integer defining the new value for the `@@par` slot. #' @returns None. #' @exportMethod setPar<- -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -504,7 +505,7 @@ setReplaceMethod( #' @param value An integer defining the new value for the `@@type` slot. #' @returns None. #' @exportMethod setType<- -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. @@ -528,7 +529,7 @@ setReplaceMethod( #' @param value An integer defining the new value for the `@@hier` slot. #' @returns None. #' @exportMethod setHier<- -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a prior object. diff --git a/R/sdatamoments.R b/R/sdatamoments.R index 4a503b8..6b3582a 100644 --- a/R/sdatamoments.R +++ b/R/sdatamoments.R @@ -129,7 +129,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "sdatamoments", function(object) { @@ -152,7 +152,7 @@ setMethod( #' #' @param object An `sdatamoments` object. #' @returns The `gmoments` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @exportMethod getGmoments #' @examples @@ -184,7 +184,7 @@ setMethod( #' #' @param object An `sdatamoments` object. #' @returns The `fdata` slot of the `object`. -#' @noRd +#' @keywords internal #' #' @examples #' # Generate a Poisson mixture model with two components. diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index 6d26921..b586497 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -100,7 +100,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [modelmoments-class] for the base class for model moments #' * [modelmoments()] for the constructor of `modelmoments` classes @@ -146,7 +146,7 @@ setMethod( #' @param object An `studentmodelmoments` object. #' @returns The `B` slot of the `object`. #' @exportMethod getB -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) @@ -173,7 +173,7 @@ setMethod( #' @param object An `studentmodelmoments` object. #' @returns The `W` slot of the `object`. #' @exportMethod getW -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) @@ -200,7 +200,7 @@ setMethod( #' @param object An `studentmodelmoments` object. #' @returns The `R` slot of the `object`. #' @exportMethod getR -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index 5b17c1d..2c38796 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -103,7 +103,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "studmultmodelmoments", function(object) { @@ -156,7 +156,7 @@ setMethod( #' #' @param object An `studmultmodelmoments` object. #' @returns The `B` slot of the `object`. -#' @noRd +#' @keywords internal #' @exportMethod getB #' #' @examples @@ -185,7 +185,7 @@ setMethod( #' @param object An `studmultmodelmoments` object. #' @returns The `W` slot of the `object`. #' @exportMethod getW -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) @@ -213,7 +213,7 @@ setMethod( #' @param object An `studmultmodelmoments` object. #' @returns The `Rdet` slot of the `object`. #' @exportMethod getRdet -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) @@ -241,7 +241,7 @@ setMethod( #' @param object An `studmultmodelmoments` object. #' @returns The `Rtr` slot of the `object`. #' @exportMethod getRtr -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) @@ -269,7 +269,7 @@ setMethod( #' @param object An `studmultmodelmoments` object. #' @returns The `Corr` slot of the `object`. #' @exportMethod getCorr -#' @noRd +#' @keywords internal #' #' @examples #' f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) diff --git a/man/dataclass.Rd b/man/dataclass.Rd index b66ea4c..36b39de 100644 --- a/man/dataclass.Rd +++ b/man/dataclass.Rd @@ -7,11 +7,11 @@ dataclass(fdata = NULL, model = NULL, simS = FALSE) } \arguments{ -\item{fdata}{An \code{fdata} object containing observations in slot \verb{@y} and -indicators in slot \verb{@S}.} +\item{fdata}{An \code{fdata} object containing observations in slot \code{y} and +indicators in slot \code{S}.} -\item{model}{A \code{model} object containing parameters in slot \verb{@par} and -and weights in slot \verb{@weight}.} +\item{model}{A \code{model} object containing parameters in slot \code{par} and +and weights in slot \code{weight}.} \item{simS}{A logical defining, if the indicators \code{S} should be simulated.} } @@ -23,14 +23,17 @@ simulated. \description{ Calling \code{\link[=dataclass]{dataclass()}} classifies data using a fully specified mixture model. Henceforth, the finite mixture model \code{model} must be fully specified, i.e. -containing parameters in slot \verb{@par}, weights in slot \verb{@weight} and -indicators in slot \verb{@S} of the corresponding \code{fdata} object. +containing parameters in slot \code{par}, weights in slot \code{weight} and +indicators in slot \code{S} of the corresponding \code{fdata} object. +} +\references{ +\itemize{ +\item Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching +Models" +} } \seealso{ \itemize{ \item \linkS4class{dataclass} for the class definition } - -#' @references -Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" } diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd index 26d2522..acea480 100644 --- a/man/mcmcoutputperm-class.Rd +++ b/man/mcmcoutputperm-class.Rd @@ -26,10 +26,10 @@ An object of class \code{mcmcoutputperm} inherits all slots from its parent clas data from permutation. These slots are listed below \subsection{Class methods}{ -Similar to the parent class \link[=mcmcoutput-class]{mcmcoutput} this class comes -along with a couple of methods that should give the user some comfort in -handling the permuted sampling results. There are no setters for this class -as the slots are only set internally. +Similar to the contained classes \link[=mcmcoutput-class]{mcmcoutput} this class +comes along with a couple of methods that should give the user some comfort +in handling the permuted sampling results. There are no setters for this +class as the slots are only set internally. \subsection{Show}{ \itemize{ \item \code{show()} shows a short summary of the object's slots. diff --git a/src/Makevars b/src/Makevars index c963b54..ada671b 100644 --- a/src/Makevars +++ b/src/Makevars @@ -1,29 +1,6 @@ ## Use the R_HOME indirection to support installations of multiple R version CXX_STD = CXX11 -PKG_LIBS = $(SHLIB_OPENMP_CFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) +PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -## As an alternative, one can also add this code in a file 'configure' -## -## PKG_LIBS=`${R_HOME}/bin/Rscript -e "Rcpp:::LdFlags()"` -## -## sed -e "s|@PKG_LIBS@|${PKG_LIBS}|" \ -## src/Makevars.in > src/Makevars -## -## which together with the following file 'src/Makevars.in' -## -## PKG_LIBS = @PKG_LIBS@ -## -## can be used to create src/Makevars dynamically. This scheme is more -## powerful and can be expanded to also check for and link with other -## libraries. It should be complemented by a file 'cleanup' -## -## rm src/Makevars -## -## which removes the autogenerated file src/Makevars. -## -## Of course, autoconf can also be used to write configure files. This is -## done by a number of packages, but recommended only for more advanced users -## comfortable with autoconf and its related tools. - diff --git a/src/Makevars.win b/src/Makevars.win index 9840f38..cc21c02 100644 --- a/src/Makevars.win +++ b/src/Makevars.win @@ -2,7 +2,8 @@ ## This assume that we can call Rscript to ask Rcpp about its locations ## Use the R_HOME indirection to support installations of multiple R version CXX_STD = CXX11 -PKG_LIBS = $(SHLIB_OPENMP_CFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) +#PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) +PKG_LIBS = $(shell $(R_HOME)/bin/Rscript.exe -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) From f9b29140fb2f40a469779f20568d0412b10c97da Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Sat, 30 Oct 2021 12:24:08 +0200 Subject: [PATCH 18/24] Modified documentation to remove WARNINGS in R CMD check --- NAMESPACE | 124 +++++++++- R/AllGenerics.R | 471 +++++++++++++++++++++++++++--------- R/binomialmodelmoments.R | 6 +- R/cmodelmoments.R | 6 +- R/csdatamoments.R | 6 +- R/dataclass.R | 10 +- R/datamoments.R | 11 +- R/dmodelmoments.R | 8 +- R/exponentialmodelmoments.R | 3 +- R/graphic_func.R | 3 +- R/mcmc.R | 37 ++- R/mcmcestind.R | 2 +- R/mcmcoutputfix.R | 2 +- R/mcmcstart.R | 32 +-- R/mixturemcmc.R | 6 +- R/model.R | 306 ++++++++++++++++++++--- R/normalmodelmoments.R | 3 +- R/normultmodelmoments.R | 3 +- R/prior.R | 10 +- R/studentmodelmoments.R | 3 +- R/studmultmodelmoments.R | 3 +- man/datamoments.Rd | 11 +- man/graphic_funs.Rd | 15 -- man/hasT-model-method.Rd | 1 + man/mcmcestimate.Rd | 2 +- man/mcmcstart.Rd | 2 +- man/mixturemcmc.Rd | 4 +- man/model.Rd | 2 +- man/model_class.Rd | 57 ----- man/priordefine.Rd | 2 +- man/show-model-method.Rd | 5 +- 31 files changed, 860 insertions(+), 296 deletions(-) delete mode 100644 man/graphic_funs.Rd delete mode 100644 man/model_class.Rd diff --git a/NAMESPACE b/NAMESPACE index 0e069cb..760771f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,17 +1,125 @@ # Generated by roxygen2: do not edit by hand export("%=%") +export("setBurnin<-") +export("setBycolumn<-") +export("setDist<-") +export("setExp<-") +export("setHier<-") +export("setIndicfix<-") +export("setIndicmod<-") +export("setK<-") +export("setM<-") +export("setN<-") +export("setName<-") +export("setPar<-") +export("setR<-") +export("setRanperm<-") +export("setS<-") +export("setSim<-") +export("setStartpar<-") +export("setStoreS<-") +export("setStorepost<-") +export("setT<-") +export("setType<-") +export("setWeight<-") +export("setY<-") export(dataclass) export(datamoments) export(ddirichlet_cc) export(dgamma_cc) +export(extract) export(fdata) +export(generateMoments) +export(generatePrior) export(getB) +export(getBml) +export(getBurnin) +export(getBycolumn) +export(getClust) +export(getColExp) +export(getColS) +export(getColT) +export(getColY) +export(getCorr) export(getDist) +export(getEavg) +export(getEntropy) +export(getEntropyperm) +export(getExp) +export(getExtrabinvar) +export(getFactorial) +export(getFdata) +export(getGmoments) +export(getHier) +export(getHigher) +export(getHyper) +export(getHyperperm) +export(getIeavg) +export(getIndicfix) +export(getIndicmod) +export(getK) +export(getKurtosis) +export(getLog) +export(getLoglikcd) +export(getLogperm) +export(getLogpy) +export(getM) +export(getMap) +export(getMean) +export(getMixlik) +export(getModel) +export(getMperm) +export(getN) +export(getNK) +export(getNKperm) +export(getName) +export(getOver) +export(getPar) +export(getParperm) +export(getPost) +export(getPostS) +export(getPostperm) +export(getPrior) +export(getProb) +export(getR) +export(getRanperm) +export(getRdet) +export(getRelabel) +export(getRowExp) +export(getRowS) +export(getRowT) +export(getRowY) +export(getRtr) +export(getS) +export(getST) +export(getSTperm) +export(getSdpost) +export(getSim) +export(getSkewness) +export(getSmoments) +export(getSperm) +export(getStartpar) +export(getStoreS) +export(getStorepost) +export(getT) +export(getType) +export(getVar) +export(getW) +export(getWK) +export(getWeight) +export(getWeightperm) +export(getY) +export(getZero) export(groupmoments) +export(hasExp) export(hasPar) +export(hasPriorPar) +export(hasPriorWeight) +export(hasS) export(hasT) export(hasWeight) +export(hasY) export(hungarian_cc) export(lddirichlet_cc) export(ldgamma_cc) @@ -31,9 +139,15 @@ export(mixturemar) export(mixturemcmc) export(model) export(modelmoments) +export(moments) export(moments_cc) export(permmoments_cc) +export(plotDens) +export(plotHist) export(plotPointProc) +export(plotPostDens) +export(plotSampRep) +export(plotTraces) export(prior) export(priordefine) export(qincol) @@ -48,6 +162,7 @@ export(stephens1997b_binomial_cc) export(stephens1997b_exponential_cc) export(stephens1997b_poisson_cc) export(subseq) +export(swapElements) export(swapInd_cc) export(swapInteger_cc) export(swapST_cc) @@ -104,19 +219,23 @@ exportClasses(sdatamoments) exportClasses(sdatamomentsOrNULL) exportClasses(studentmodelmoments) exportClasses(studmultmodelmoments) +exportMethods("setBurnin<-") exportMethods("setBycolumn<-") exportMethods("setDist<-") exportMethods("setExp<-") exportMethods("setHier<-") exportMethods("setIndicfix<-") -exportMethods("setIndicmod<-") exportMethods("setK<-") +exportMethods("setM<-") exportMethods("setN<-") exportMethods("setName<-") exportMethods("setPar<-") exportMethods("setR<-") +exportMethods("setRanperm<-") exportMethods("setS<-") exportMethods("setSim<-") +exportMethods("setStartpar<-") +exportMethods("setStoreS<-") exportMethods("setStorepost<-") exportMethods("setT<-") exportMethods("setType<-") @@ -189,6 +308,9 @@ exportMethods(getSdpost) exportMethods(getSim) exportMethods(getSkewness) exportMethods(getSperm) +exportMethods(getStartpar) +exportMethods(getStoreS) +exportMethods(getStorepost) exportMethods(getT) exportMethods(getType) exportMethods(getVar) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 1d1d5aa..c205501 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -56,383 +56,620 @@ setGeneric("mixturemar", function(object, J) standardGeneric("mixturemar")) #' @keywords internal setGeneric("getDist", function(object) standardGeneric("getDist")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getR", function(object) standardGeneric("getR")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getK", function(object) standardGeneric("getK")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getWeight", function(object) standardGeneric("getWeight")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getPar", function(object) standardGeneric("getPar")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getIndicmod", function(object) standardGeneric("getIndicmod")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getIndicfix", function(object) standardGeneric("getIndicfix")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getT", function(object) standardGeneric("getT")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setDist<-", function(object, value) standardGeneric("setDist<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setR<-", function(object, value) standardGeneric("setR<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setK<-", function(object, value) standardGeneric("setK<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setWeight<-", function(object, value) standardGeneric("setWeight<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setPar<-", function(object, value) standardGeneric("setPar<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setIndicmod<-", function(object, value) standardGeneric("setIndicmod<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setIndicfix<-", function(object, value) standardGeneric("setIndicfix<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setT<-", function(object, value) standardGeneric("setT<-")) ## Class 'modelmoments' -------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getMean", function(object) standardGeneric("getMean")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getVar", function(object) standardGeneric("getVar")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getModel", function(object) standardGeneric("getModel")) ## Class 'cmodelmoments' ------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getHigher", function(object) standardGeneric("getHigher")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getSkewness", function(object) standardGeneric("getSkewness")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getKurtosis", function(object) standardGeneric("getKurtosis")) ## Class 'dmodelmoments' ------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getOver", function(object) standardGeneric("getOver")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getFactorial", function(object) standardGeneric("getFactorial")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getZero", function(object) standardGeneric("getZero")) ## Class 'normultmodelmoments' ------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal +#' @aliases generateMoments,cmodelmoments-class,csmodelmoments-class, +#' exponentialmodelmoments,binomialmodelmoments-class setGeneric("generateMoments", function(object) standardGeneric("generateMoments")) #' @export #' @docType methods #' @keywords internal +#' @aliases getB,cmodelmoments-class,exponentialmodelmoments-class setGeneric("getB", function(object) standardGeneric("getB")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getW", function(object) standardGeneric("getW")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRdet", function(object) standardGeneric("getRdet")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRtr", function(object) standardGeneric("getRtr")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getCorr", function(object) standardGeneric("getCorr")) ## Class 'exponentialmodelmoments' --------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getExtrabinvar", function(object) standardGeneric("getExtrabinvar")) ## Class 'fdata' ---------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasY", function(object, verbose = FALSE) standardGeneric("hasY")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasS", function(object, verbose = FALSE) standardGeneric("hasS")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasExp", function(object, verbose = FALSE) standardGeneric("hasExp")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getColY", function(object) standardGeneric("getColY")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRowY", function(object) standardGeneric("getRowY")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getColS", function(object) standardGeneric("getColS")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRowS", function(object) standardGeneric("getRowS")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getColExp", function(object) standardGeneric("getColExp")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRowExp", function(object) standardGeneric("getRowExp")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getColT", function(object) standardGeneric("getColT")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRowT", function(object) standardGeneric("getRowT")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getY", function(object) standardGeneric("getY")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getBycolumn", function(object) standardGeneric("getBycolumn")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getN", function(object) standardGeneric("getN")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getS", function(object) standardGeneric("getS")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getName", function(object) standardGeneric("getName")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getType", function(object) standardGeneric("getType")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getSim", function(object) standardGeneric("getSim")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getExp", function(object) standardGeneric("getExp")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setY<-", function(object, value) standardGeneric("setY<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setN<-", function(object, value) standardGeneric("setN<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setS<-", function(object, value) standardGeneric("setS<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setBycolumn<-", function(object, value) standardGeneric("setBycolumn<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setName<-", function(object, value) standardGeneric("setName<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setType<-", function(object, value) standardGeneric("setType<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setSim<-", function(object, value) standardGeneric("setSim<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setExp<-", function(object, value) standardGeneric("setExp<-")) ## Class 'groupmoments' ---------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getNK", function(object) standardGeneric("getNK")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getWK", function(object) standardGeneric("getWK")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getFdata", function(object) standardGeneric("getFdata")) ## Class 'sdatamoments' ---------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getGmoments", function(object) standardGeneric("getGmoments")) ## Class 'cdatamoments' --------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getSmoments", function(object) standardGeneric("getSmoments")) ## Class 'prior' ----------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasPriorPar", function(object, model, verbose = FALSE) standardGeneric("hasPriorPar")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("hasPriorWeight", function(object, model, verbose = FALSE) standardGeneric("hasPriorWeight")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("generatePrior", function(object, ...) standardGeneric("generatePrior")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getHier", function(object) standardGeneric("getHier")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setHier<-", function(object, value) standardGeneric("setHier<-")) ## Class 'mcmc' ------------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getBurnin", function(object) standardGeneric("getBurnin")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getM", function(object) standardGeneric("getM")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getStartpar", function(object) standardGeneric("getStartpar")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getStoreS", function(object) standardGeneric("getStoreS")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getStorepost", function(object) standardGeneric("getStorepost")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRanperm", function(object) standardGeneric("getRanperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setBurnin<-", function(object, value) standardGeneric("setBurnin<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setM<-", function(object, value) standardGeneric("setM<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setStartpar<-", function(object, value) standardGeneric("setStartpar<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setStoreS<-", function(object, value) standardGeneric("setStoreS<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setStorepost<-", function(object, value) standardGeneric("setStorepost<-")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("setRanperm<-", function(object, value) standardGeneric("setRanperm<-")) ## Class 'dataclass' ---------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getLogpy", function(object) standardGeneric("getLogpy")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getProb", function(object) standardGeneric("getProb")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getMixlik", function(object) standardGeneric("getMixlik")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getEntropy", function(object) standardGeneric("getEntropy")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getPostS", function(object) standardGeneric("getPostS")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getLoglikcd", function(object) standardGeneric("getLoglikcd")) ## Class 'mcmcextract' -------------------------------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("moments", function(object) standardGeneric("moments")) ## Class 'mcmcoutputfix' ------------------------------------------------ -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("plotTraces", function(x, dev = TRUE, lik = 1, col = FALSE, ...) standardGeneric("plotTraces")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("plotHist", function(x, dev = TRUE, ...) standardGeneric("plotHist")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("plotDens", function(x, dev = TRUE, ...) standardGeneric("plotDens")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSampRep")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPostDens")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("subseq", function(object, index) standardGeneric("subseq")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("swapElements", function(object, index) standardGeneric("swapElements")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("extract", function(object, index) standardGeneric("extract")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getLog", function(object) standardGeneric("getLog")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getPrior", function(object) standardGeneric("getPrior")) ## Class 'mcmcoutputhier' ----------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getHyper", function(object) standardGeneric("getHyper")) ## Class 'mcmcoutputpost' ----------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getPost", function(object) standardGeneric("getPost")) ## Class 'mcmcoutputbase' ----------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getST", function(object) standardGeneric("getST")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getClust", function(object) standardGeneric("getClust")) ## Class 'mcmcpermfix' --------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getMperm", function(object) standardGeneric("getMperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getParperm", function(object) standardGeneric("getParperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getLogperm", function(object) standardGeneric("getLogperm")) ## Class 'mcmcpermfixhier' ----------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getHyperperm", function(object) standardGeneric("getHyperperm")) ## Class 'mcmcpermfixpost' ----------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getPostperm", function(object) standardGeneric("getPostperm")) ## Class 'mcmcpermind' --------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getRelabel", function(object) standardGeneric("getRelabel")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getWeightperm", function(object) standardGeneric("getWeightperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getEntropyperm", function(object) standardGeneric("getEntropyperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getSTperm", function(object) standardGeneric("getSTperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getSperm", function(object) standardGeneric("getSperm")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getNKperm", function(object) standardGeneric("getNKperm")) ## Class 'mcmcestfix' ----------------------------------------------------- -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getMap", function(object) standardGeneric("getMap")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getBml", function(object) standardGeneric("getBml")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getIeavg", function(object) standardGeneric("getIeavg")) -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getSdpost", function(object) standardGeneric("getSdpost")) ## Class 'mcmcestind' ------------------------------------------------------ -#' @noRd +#' @export +#' @docType methods +#' @keywords internal setGeneric("getEavg", function(object) standardGeneric("getEavg")) diff --git a/R/binomialmodelmoments.R b/R/binomialmodelmoments.R index 86b6403..fecb7e8 100644 --- a/R/binomialmodelmoments.R +++ b/R/binomialmodelmoments.R @@ -143,8 +143,8 @@ setMethod( #' getExtrabinvar(f_moments) #' #' @seealso -#' * \code{\link{modelmoments-class}} for the base class for model moments -#' * \code{\link{modelmoments}} for the constructor of the `modelmoments` class family +#' * [modelmoments-class] for the base class for model moments +#' * [modelmoments()] for the constructor of the `modelmoments` class family setMethod( "getExtrabinvar", "binomialmodelmoments", function(object) { @@ -160,7 +160,7 @@ setMethod( #' Generates theoretical moments for a binomial mixture #' #' @description -#' Calling [.genwerateMomentsBinomial()] generates theoretical model moments +#' Calling `.generateMomentsBinomial()` generates theoretical model moments #' for the binomial model defined in the `model` object. Next to the general #' mixture moments available to any mixture model, the binomial moments also #' include the extra-binomial variation `extrabinvar` diff --git a/R/cmodelmoments.R b/R/cmodelmoments.R index b5854b0..21727b1 100644 --- a/R/cmodelmoments.R +++ b/R/cmodelmoments.R @@ -62,7 +62,7 @@ #' @keywords internal #' #' @examples -#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getHigher(f_moments) @@ -84,7 +84,7 @@ setMethod("getHigher", "cmodelmoments", function(object) { #' @keywords internal #' #' @examples -#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getSkewness(f_moments) @@ -106,7 +106,7 @@ setMethod("getSkewness", "cmodelmoments", function(object) { #' @keywords internal #' #' @examples -#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getKurtosis(f_moments) diff --git a/R/csdatamoments.R b/R/csdatamoments.R index cacc066..41b3f48 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -69,7 +69,7 @@ #' be `NULL`. #' #' @exportClass csdatamomentsOrNULL -#' @noRd +#' @keywords internal setClassUnion("csdatamomentsOrNULL", members = c("csdatamoments", "NULL")) #' Initializer of the `csdatamoments` class @@ -256,11 +256,13 @@ setMethod( #' Getter method of `csdatamoments` class. #' +#' @description #' Returns the `B` slot. #' #' @param object An `csdatamoments` object. -#' @returns The `B` slot of the `object`. +#' @return The `B` slot of the `object`. #' @exportMethod getB +#' @keywords internal #' #' @examples #' # Generate an exponential mixture model with two components. diff --git a/R/dataclass.R b/R/dataclass.R index d8bb103..79306ed 100644 --- a/R/dataclass.R +++ b/R/dataclass.R @@ -191,7 +191,7 @@ setMethod( #' f_data <- simulate(f_model) #' # Classify observations #' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) -#' getLogpy(f_datamoms) +#' getLogpy(f_dataclass) #' #' @seealso #' * [dataclass-class] for the base class @@ -219,7 +219,7 @@ setMethod( #' f_data <- simulate(f_model) #' # Classify observations #' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) -#' getProb(f_datamoms) +#' getProb(f_dataclass) #' #' @seealso #' * [dataclass-class] for the base class @@ -247,7 +247,7 @@ setMethod( #' f_data <- simulate(f_model) #' # Classify observations #' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) -#' getMixlik(f_datamoms) +#' getMixlik(f_dataclass) #' #' @seealso #' * [dataclass-class] for the base class @@ -304,7 +304,7 @@ setMethod( #' f_data <- simulate(f_model) #' # Classify observations #' f_dataclass <- dataclass(f_data, f_model, simS = FALSE) -#' getLoglikcd(f_datamoms) +#' getLoglikcd(f_dataclass) #' #' @seealso #' * [dataclass-class] for the base class @@ -333,7 +333,7 @@ setMethod( #' f_data <- simulate(f_model) #' # Classify observations #' f_dataclass <- dataclass(f_data, f_model, simS = TRUE)[[1]] -#' getPostS(f_datamoms) +#' getPostS(f_dataclass) #' #' @seealso #' * [dataclass-class] for the base class diff --git a/R/datamoments.R b/R/datamoments.R index e7cb44b..f1ea0f5 100644 --- a/R/datamoments.R +++ b/R/datamoments.R @@ -48,15 +48,16 @@ #' Constructor for `datamoments` classes #' #' @description -#' Calling [datamoments()] generates the datamoments for an `fdata` object. +#' Calling [datamoments()] generates the moments for an `fdata` object. #' Depending on the type of data either an `cdatamoments` or `ddatamoments` -#' object is generated. If in addition the `fdata` object containes fixed -#' indicators, these `datamoments` object also hold an `sdatamoments` class to +#' object is generated. If in addition the `fdata` object contains fixed +#' indicators, the `datamoments` object also holds an `sdatamoments` object to #' store the data moments of these indicators. #' #' @param value An `fdata` object with at least slot `y` non-empty. -#' @returns An `datamoments` object containing the data moments for slot `y` -#' and if available slot `S`. +#' @returns A `datamoments` object containing the data moments for the +#' observations in slot `y` and if available also for the indicators in slot +#' `S`. #' @export #' #' @examples diff --git a/R/dmodelmoments.R b/R/dmodelmoments.R index 4b01c29..f5e2673 100644 --- a/R/dmodelmoments.R +++ b/R/dmodelmoments.R @@ -58,7 +58,7 @@ #' @keywords internal #' #' @examples -#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getHigher(f_moments) @@ -80,10 +80,10 @@ setMethod("getOver", "dmodelmoments", function(object) { #' @keywords internal #' #' @examples -#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) -#' getSkewness(f_moments) +#' getFactorial(f_moments) #' #' @seealso #' * [modelmoments] for the base class for model moments @@ -102,7 +102,7 @@ setMethod("getFactorial", "dmodelmoments", function(object) { #' @keywords internal #' #' @examples -#' f_model <- model("c", par=list(lambda=c(0.3, 0.1)), +#' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) #' getKurtosis(f_moments) diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index d336e94..aa750f0 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -134,10 +134,11 @@ setMethod( #' Getter method of `exponentialmodelmoments` class. #' +#' @description #' Returns the `B` slot. #' #' @param object An `exponentialmodelmoments` object. -#' @returns The `B` slot of the `object`. +#' @return The `B` slot of the `object`. #' @exportMethod getB #' @keywords internal #' diff --git a/R/graphic_func.R b/R/graphic_func.R index 5c7ac2c..59790f0 100644 --- a/R/graphic_func.R +++ b/R/graphic_func.R @@ -28,7 +28,8 @@ #' For internal use only. #' #' @returns `TRUE` if `title` option exists. -#' @name graphic_funs +#' @name graphic_func +#' @keywords internal ".check.grDevice" <- function() { ## title argument ## any(names(formals(getOption("device"))) diff --git a/R/mcmc.R b/R/mcmc.R index 9bb099f..720ad7c 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -127,7 +127,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' #' @seealso #' * [mcmc-class] for the class definition @@ -154,8 +154,9 @@ setMethod( #' #' @param object An `mcmc` object. #' @returns The `burnin` slot of the `object`. -#' @noRd -#' @export +#' @exportMethod getBurnin +#' @keywords internal +#' #' @examples #' # Generate an mcmc object #' f_mcmc <- mcmc() @@ -178,7 +179,8 @@ setMethod( #' #' @param object An `mcmc` object. #' @returns The `M` slot of the `object`. -#' @noRd +#' @exportMethod getM +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -202,7 +204,8 @@ setMethod( #' #' @param object An `mcmc` object. #' @returns The `startpar` slot of the `object`. -#' @noRd +#' @exportMethod getStartpar +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -226,7 +229,8 @@ setMethod( #' #' @param object An `mcmc` object. #' @returns The `storeS` slot of the `object`. -#' @noRd +#' @exportMethod getStoreS +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -250,7 +254,8 @@ setMethod( #' #' @param object An `mcmc` object. #' @returns The `storepost` slot of the `object`. -#' @noRd +#' @exportMethod getStorepost +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -274,7 +279,8 @@ setMethod( #' #' @param object An `mcmc` object. #' @returns The `ranperm` slot of the `object`. -#' @noRd +#' @exportMethod getRanperm +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -300,7 +306,8 @@ setMethod( #' @param object An `mcmc` object. #' @param value An integer defining the new value for the `@@burnin` slot. #' @returns None. -#' @noRd +#' @exportMethod setBurnin<- +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -327,7 +334,8 @@ setReplaceMethod( #' @param object An `mcmc` object. #' @param value An integer defining the new value for the `@@M` slot. #' @returns None. -#' @noRd +#' @exportMethod setM<- +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -354,7 +362,8 @@ setReplaceMethod( #' @param object An `mcmc` object. #' @param value An integer defining the new value for the `@@startpar` slot. #' @returns None. -#' @noRd +#' @exportMethod setStartpar<- +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -381,7 +390,8 @@ setReplaceMethod( #' @param object An `mcmc` object. #' @param value An integer defining the new value for the `@@storeS` slot. #' @returns None. -#' @noRd +#' @exportMethod setStoreS<- +#' @keywords internal #' #' @examples #' # Generate an mcmc object @@ -436,7 +446,8 @@ setReplaceMethod( #' @param object An `mcmc` object. #' @param value An integer defining the new value for the `@@ranperm` slot. #' @returns None. -#' @noRd +#' @exportMethod setRanperm<- +#' @keywords internal #' #' @examples #' # Generate an mcmc object diff --git a/R/mcmcestind.R b/R/mcmcestind.R index da61c20..0f6d59b 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -118,7 +118,7 @@ #' * `getMap()` returns the MAP estimates. #' * `getBml()` returns the BML estimates. #' * `getEavg()` returns the EAVG estimates. -#' * `getIEAVG()` returns the identified EAVG estimates. +#' * `getIeavg()` returns the identified EAVG estimates. #' * `getSdpost()` returns the `sdpost`. #' #' @slot dist A character specifying the distribution family of the mixture diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index 3deb42c..b346bfe 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -554,8 +554,8 @@ setMethod( #' mixture should be extracted. #' @return An object class `mcmcextract` containing all samples of an extracted #' dimension. -#' @noRd #' @exportMethod extract +#' @keywords internal setMethod( "extract", signature( object = "mcmcoutputfix", diff --git a/R/mcmcstart.R b/R/mcmcstart.R index d13d47e..5c8102b 100644 --- a/R/mcmcstart.R +++ b/R/mcmcstart.R @@ -49,7 +49,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling "mcmcstart" <- function(fdata, model, varargin) { @@ -123,7 +123,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".check.fdata.model.Mcmcstart" <- function(fdata.obj, model.obj) { @@ -162,7 +162,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".check.mcmc.Mcmcstart" <- function(mcmc.obj) { @@ -193,7 +193,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".parameters.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { @@ -237,7 +237,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".mcmcstart.Exp" <- function(data.obj) { @@ -294,7 +294,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class #' * [mixturemcmc()] for the starting MCMC sampling ".parameters.multinomial.Mcmcstart" <- function(model.obj) { @@ -318,7 +318,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".parameters.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { K <- model.obj@K @@ -356,7 +356,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".parameters.exponential.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { @@ -386,7 +386,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".parameters.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { if (!hasPar(model.obj) && hasT(fdata.obj, verbose = TRUE)) { @@ -419,7 +419,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".parameters.Norstud.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { @@ -473,7 +473,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".parameters.Norstudmult.Mcmcstart" <- function(fdata.obj, model.obj, mcmc.obj) { @@ -533,7 +533,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".mcmcstart.Student.Df" <- function(model.obj) { K <- model.obj@K @@ -565,7 +565,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".indicators.Mcmcstart" <- function(fdata.obj, model.obj) { dist <- model.obj@dist @@ -599,7 +599,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".indicators.poisson.Mcmcstart" <- function(fdata.obj, model.obj) { K <- model.obj@K @@ -631,7 +631,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".indicators.binomial.Mcmcstart" <- function(fdata.obj, model.obj) { if (!hasS(fdata.obj)) { @@ -680,7 +680,7 @@ #' #' @seealso #' * [fdata-class] for the definition of the `fdata` class -#' * [model][model_class] for the definition of the `model` class +#' * [model-class] for the definition of the `model` class #' * [mcmc-class] for the definition of the `mcmc` class ".mcmcstart.Ind.Norstud" <- function(data.obj, model.obj) { K <- model.obj@K diff --git a/R/mixturemcmc.R b/R/mixturemcmc.R index 95191df..58d0da7 100644 --- a/R/mixturemcmc.R +++ b/R/mixturemcmc.R @@ -98,8 +98,8 @@ #' #' @seealso #' * [fdata-class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition -#' * [prior][prior-class] for the `prior` class definition +#' * [model-class] for the `model` class definition +#' * [prior-class] for the `prior` class definition #' * [prior()] for the `prior` class constructor #' * [priordefine()] for the advanced class constructor of the `prior` class #' * [mcmc-class] for the `mcmc` class definition @@ -319,7 +319,7 @@ #' #' @seealso #' * [fdata-class] for the `fdata` class definition -#' * [model][model_class] for the `model` class definition +#' * [model-class] for the `model` class definition ".valid.Reps.Binomial" <- function(data, model) { has.reps <- !all(is.na(data@T)) N <- data@N diff --git a/R/model.R b/R/model.R index e726d9e..0716cde 100644 --- a/R/model.R +++ b/R/model.R @@ -156,7 +156,7 @@ #' f_model <- model(dist = "poisson", K = 2, par = list(lambda = c(0.17, 0.2))) #' #' @seealso -#' * [model][model_class] for the class definition +#' * [model][model-class] for the class definition "model" <- function(dist = "poisson", r, K, weight = matrix(), par = list(), indicmod = "multinomial", @@ -202,12 +202,12 @@ #' @param verbose A logical indicating, if the function should give a print out. #' @return Matrix of weights. #' @exportMethod hasWeight -#' +#' @keywords internal +#' #' @examples #' \dontrun{ #' weight <- hasWeight(model) #' } -#' @rdname model_class setMethod( "hasWeight", "model", function(object, verbose = FALSE) { @@ -249,6 +249,7 @@ setMethod( #' @return A logical. \code{TRUE} if repetitions are existent in the model. If #' values of slot \code{T} are \code{NA} it returns \code{FALSE}. #' @exportMethod hasT +#' @keywords internal #' #' @examples #' \dontrun{ @@ -454,13 +455,15 @@ setMethod( #' @param object An S4 model object. #' @return A print out of model information about all slots. #' @exportMethod show +#' @keywords internal #' #' @examples #' \dontrun{ #' show(f_model) #' } #' -#' @seealso \code{model} +#' @seealso +#' * [model-class] for the class definition setMethod( "show", "model", function(object) { @@ -494,8 +497,24 @@ setMethod( ) ## Getters ## -#' @name model_class + +#' Getter method of `model` class. +#' +#' Returns the `dist` slot. +#' +#' @param object An `model` object. +#' @returns The `dist` slot of the `object`. #' @exportMethod getDist +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getDist(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getDist", "model", function(object) { @@ -503,8 +522,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `r` slot. +#' +#' @param object An `model` object. +#' @returns The `r` slot of the `object`. #' @exportMethod getR +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getR(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getR", "model", function(object) { @@ -512,8 +546,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `K` slot. +#' +#' @param object An `model` object. +#' @returns The `K` slot of the `object`. #' @exportMethod getK +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getK(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getK", "model", function(object) { @@ -521,8 +570,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `weight` slot. +#' +#' @param object An `model` object. +#' @returns The `weight` slot of the `object`. #' @exportMethod getWeight +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getWeight(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getWeight", "model", function(object) { @@ -530,8 +594,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `par` slot. +#' +#' @param object An `model` object. +#' @returns The `par` slot of the `object`. #' @exportMethod getPar +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getPar(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getPar", "model", function(object) { @@ -539,8 +618,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `indicmod` slot. +#' +#' @param object An `model` object. +#' @returns The `indicmod` slot of the `object`. #' @exportMethod getIndicmod +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getIndicmod(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getIndicmod", "model", function(object) { @@ -548,8 +642,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `indicfix` slot. +#' +#' @param object An `model` object. +#' @returns The `indicfix` slot of the `object`. #' @exportMethod getIndicfix +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getIndicfix(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getIndicfix", "model", function(object) { @@ -557,8 +666,23 @@ setMethod( } ) -#' @name model_class +#' Getter method of `model` class. +#' +#' Returns the `T` slot. +#' +#' @param object An `model` object. +#' @returns The `T` slot of the `object`. #' @exportMethod getT +#' @keywords internal +#' +#' @examples +#' # Generate an exponential mixture model with two components. +#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Get the slot +#' getT(f_model) +#' +#' @seealso +#' * [model-class] for the class definition setMethod( "getT", "model", function(object) { @@ -567,8 +691,24 @@ setMethod( ) ## Setters ## -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `dist` slot. +#' +#' @param object An `model` object. +#' @param value A character defining the distribution. +#' @returns The `model` object with slot `dist` set to `value`. #' @exportMethod setDist<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Get the slot +#' setDist(f_model) <- "poisson" +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setDist", "model", function(object, value) { @@ -578,8 +718,24 @@ setReplaceMethod( } ) -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `r` slot. +#' +#' @param object An `model` object. +#' @param value A character defining the distribution. +#' @returns The `model` object with slot `r` set to `value`. #' @exportMethod setR<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setR(f_model) <- 1 +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setR", "model", function(object, value) { @@ -589,8 +745,24 @@ setReplaceMethod( } ) -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `K` slot. +#' +#' @param object An `model` object. +#' @param value An integer specifying the number of components. +#' @returns The `model` object with slot `K` set to `value`. #' @exportMethod setK<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setK(f_model) <- 2 +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setK", "model", function(object, value) { @@ -607,8 +779,24 @@ setReplaceMethod( } ) -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `weight` slot. +#' +#' @param object An `model` object. +#' @param value An matrix specifying the weights. +#' @returns The `model` object with slot `weight` set to `value`. #' @exportMethod setWeight<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setWeight(f_model) <- matrix(c(0.4, 0.6), nrow = 1) +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setWeight", "model", function(object, value) { @@ -619,8 +807,24 @@ setReplaceMethod( } ) -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `par` slot. +#' +#' @param object An `model` object. +#' @param value A list specifying the component parameters. +#' @returns The `model` object with slot `par` set to `value`. #' @exportMethod setPar<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setPar(f_model) <- 2 +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setPar", "model", function(object, value) { @@ -630,8 +834,24 @@ setReplaceMethod( } ) -#' @name model_class -#' @exportMethod setIndicmod<- +#' Setter method of `model` class. +#' +#' Sets a value for the `indicmod` slot. +#' +#' @param object An `model` object. +#' @param value An character specifying the indicator model. +#' @returns The `model` object with slot `indicmod` set to `value`. +#' @exportMethod setK<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setK(f_model) <- 2 +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setIndicmod", "model", function(object, value) { @@ -640,8 +860,24 @@ setReplaceMethod( } ) -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `indicfix` slot. +#' +#' @param object An `model` object. +#' @param value A logical specifying, if the model is one with fixed indicators. +#' @returns The `model` object with slot `indicfix` set to `value`. #' @exportMethod setIndicfix<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setIndicfix(f_model) <- TRUE +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setIndicfix", "model", function(object, value) { @@ -650,8 +886,24 @@ setReplaceMethod( } ) -#' @name model_class +#' Setter method of `model` class. +#' +#' Sets a value for the `T` slot. +#' +#' @param object An `model` object. +#' @param value An integer specifying the number of components. +#' @returns The `model` object with slot `T` set to `value`. #' @exportMethod setT<- +#' @keywords internal +#' +#' @examples +#' # Generate an default mixture model. +#' f_model <- model() +#' # Set the slot. +#' setT(f_model) <- matrix(4) +#' +#' @seealso +#' * [model-class] for the class definition setReplaceMethod( "setT", "model", function(object, value) { @@ -903,7 +1155,7 @@ setReplaceMethod( #' @noRd #' #' @seealso -#' [simulate()][model_class] for the calling function +#' [simulate()][model-class] for the calling function ".simulate.data.binomial.Model" <- function(obj, N, fdata.obj) { if (!hasT(fdata.obj)) { fdata.obj@T <- as.matrix(1) @@ -927,7 +1179,7 @@ setReplaceMethod( #' @noRd #' #' @seealso -#' [simulate()][model_class] for the calling function +#' [simulate()][model-class] for the calling function ".simulate.data.exponential.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -947,7 +1199,7 @@ setReplaceMethod( #' @noRd #' #' @seealso -#' [simulate()][model_class] for the calling function +#' [simulate()][model-class] for the calling function ".simulate.data.normal.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -973,7 +1225,7 @@ setReplaceMethod( #' @noRd #' #' @seealso -#' [simulate()][model_class] for the calling function +#' [simulate()][model-class] for the calling function ".simulate.data.student.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -1001,7 +1253,7 @@ setReplaceMethod( #' @noRd #' #' @seealso -#' [simulate()][model_class] for the calling function +#' [simulate()][model-class] for the calling function ".simulate.data.normult.Model" <- function(obj, N, fdata.obj) { fdata.obj@type <- "continuous" fdata.obj@sim <- TRUE @@ -2644,7 +2896,7 @@ setReplaceMethod( ), call. = FALSE ) - } else if (!all(obj@par$p > 0 && obj@par$p < 1)) { + } else if (!all(obj@par$p > 0) || !all(obj@par$p < 1)) { stop(paste("Wrong specification of slot @par: ", "Binomial parameters must be all ", "between 0 and 1.", diff --git a/R/normalmodelmoments.R b/R/normalmodelmoments.R index a428bff..49518df 100644 --- a/R/normalmodelmoments.R +++ b/R/normalmodelmoments.R @@ -141,10 +141,11 @@ setMethod( ## Getters ## #' Getter method of `normalmodelmoments` class. #' +#' @description #' Returns the `B` slot. #' #' @param object An `normalmodelmoments` object. -#' @returns The `B` slot of the `object`. +#' @return The `B` slot of the `object`. #' @exportMethod getB #' @keywords internal #' diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index 25f8db8..12af329 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -158,10 +158,11 @@ setMethod( ## Getters ## #' Getter method of `normultmodelmoments` class. #' +#' @description #' Returns the `B` slot. #' #' @param object An `normultmodelmoments` object. -#' @returns The `B` slot of the `object`. +#' @return The `B` slot of the `object`. #' @exportMethod getB #' @keywords internal #' diff --git a/R/prior.R b/R/prior.R index d692c54..017a274 100644 --- a/R/prior.R +++ b/R/prior.R @@ -142,7 +142,7 @@ #' f_prior <- priordefine(f_data, f_model) #' #' @seealso -#' * [prior][prior-class] for the class definition +#' * [prior-class] for the class definition #' * [prior()] for the default constructor of the class #' #' @references @@ -224,8 +224,8 @@ setMethod( #' \dontrun{hasPriorWeight(f_prior, f_model, TRUE)} #' #' @seealso -#' * [prior][prior-class] for the definition of the `prior` class -#' * [model][model_class] for the definition of the `model` class +#' * [prior-class] for the definition of the `prior` class +#' * [model-class] for the definition of the `model` class setMethod( "hasPriorWeight", signature( object = "prior", @@ -574,7 +574,7 @@ setReplaceMethod( #' @description #' For internal usage only. This function checks the optional `prior` object #' passed in to [priordefine()]. This object has to be of class -#' [prior][prior-class] and has to be valid as this. +#' [model-class] and has to be valid as this. #' #' @param obj Any object. #' @returns None. If the checks do not pass, an error is thrown. @@ -597,7 +597,7 @@ setReplaceMethod( #' #' @description #' For internal usage only. This function checks, if a given -#' [prior][prior-class] contains specified parameters in its slot `@@par`. +#' [model-class] contains specified parameters in its slot `@@par`. #' #' @param obj A `prior` object to be checked. #' @param model.obj A `model` object providing the model distribution for diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index b586497..e5f7a42 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -141,10 +141,11 @@ setMethod( ## Getters ## #' Getter method of `studentmodelmoments` class. #' +#' @description #' Returns the `B` slot. #' #' @param object An `studentmodelmoments` object. -#' @returns The `B` slot of the `object`. +#' @return The `B` slot of the `object`. #' @exportMethod getB #' @keywords internal #' diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index 2c38796..ba6fca7 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -152,10 +152,11 @@ setMethod( ## Getters ## #' Getter method of `studmultmodelmoments` class. #' +#' @description #' Returns the `B` slot. #' #' @param object An `studmultmodelmoments` object. -#' @returns The `B` slot of the `object`. +#' @return The `B` slot of the `object`. #' @keywords internal #' @exportMethod getB #' diff --git a/man/datamoments.Rd b/man/datamoments.Rd index 73dad10..1178dd1 100644 --- a/man/datamoments.Rd +++ b/man/datamoments.Rd @@ -10,14 +10,15 @@ datamoments(value = fdata()) \item{value}{An \code{fdata} object with at least slot \code{y} non-empty.} } \value{ -An \code{datamoments} object containing the data moments for slot \code{y} -and if available slot \code{S}. +A \code{datamoments} object containing the data moments for the +observations in slot \code{y} and if available also for the indicators in slot +\code{S}. } \description{ -Calling \code{\link[=datamoments]{datamoments()}} generates the datamoments for an \code{fdata} object. +Calling \code{\link[=datamoments]{datamoments()}} generates the moments for an \code{fdata} object. Depending on the type of data either an \code{cdatamoments} or \code{ddatamoments} -object is generated. If in addition the \code{fdata} object containes fixed -indicators, these \code{datamoments} object also hold an \code{sdatamoments} class to +object is generated. If in addition the \code{fdata} object contains fixed +indicators, the \code{datamoments} object also holds an \code{sdatamoments} object to store the data moments of these indicators. } \examples{ diff --git a/man/graphic_funs.Rd b/man/graphic_funs.Rd deleted file mode 100644 index 47daa02..0000000 --- a/man/graphic_funs.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/graphic_func.R -\name{graphic_funs} -\alias{graphic_funs} -\alias{.check.grDevice} -\title{Checks if graphical device has \code{title} option} -\usage{ -.check.grDevice() -} -\value{ -\code{TRUE} if \code{title} option exists. -} -\description{ -For internal use only. -} diff --git a/man/hasT-model-method.Rd b/man/hasT-model-method.Rd index abb064c..a86c691 100644 --- a/man/hasT-model-method.Rd +++ b/man/hasT-model-method.Rd @@ -27,3 +27,4 @@ if(hasT(model)) {cat('Has repetitions.')} \seealso{ \code{model} } +\keyword{internal} diff --git a/man/mcmcestimate.Rd b/man/mcmcestimate.Rd index d724f42..7918e5c 100644 --- a/man/mcmcestimate.Rd +++ b/man/mcmcestimate.Rd @@ -30,7 +30,7 @@ returned as well. Optional.} iterations in case the "Stephens1997a" re-labeling algorithm is chosen.} } \value{ -An \code{mcmcest} object cotnaining the point estimates together with +An \code{mcmcest} object containing the point estimates together with additional information about the underlying finite mixture model, MCMC sampling hyper-parameters and the data. In case \code{permOut} is set to \code{TRUE}, the output of this function is a named list with an \code{mcmcest} diff --git a/man/mcmcstart.Rd b/man/mcmcstart.Rd index 84cff6d..8561f8d 100644 --- a/man/mcmcstart.Rd +++ b/man/mcmcstart.Rd @@ -43,7 +43,7 @@ f_data <- simulate(f_model) \seealso{ \itemize{ \item \linkS4class{fdata} for the definition of the \code{fdata} class -\item \link[=model_class]{model} for the definition of the \code{model} class +\item \linkS4class{model} for the definition of the \code{model} class \item \linkS4class{mcmc} for the definition of the \code{mcmc} class \item \code{\link[=mixturemcmc]{mixturemcmc()}} for the starting MCMC sampling } diff --git a/man/mixturemcmc.Rd b/man/mixturemcmc.Rd index 2164063..979f31c 100644 --- a/man/mixturemcmc.Rd +++ b/man/mixturemcmc.Rd @@ -104,8 +104,8 @@ Models", Springer \seealso{ \itemize{ \item \linkS4class{fdata} for the \code{fdata} class definition -\item \link[=model_class]{model} for the \code{model} class definition -\item \link[=prior-class]{prior} for the \code{prior} class definition +\item \linkS4class{model} for the \code{model} class definition +\item \linkS4class{prior} for the \code{prior} class definition \item \code{\link[=prior]{prior()}} for the \code{prior} class constructor \item \code{\link[=priordefine]{priordefine()}} for the advanced class constructor of the \code{prior} class \item \linkS4class{mcmc} for the \code{mcmc} class definition diff --git a/man/model.Rd b/man/model.Rd index 8c27ee2..d27ba13 100644 --- a/man/model.Rd +++ b/man/model.Rd @@ -75,6 +75,6 @@ f_model <- model(dist = "poisson", K = 2, par = list(lambda = c(0.17, 0.2))) } \seealso{ \itemize{ -\item \link[=model_class]{model} for the class definition +\item \link[=model-class]{model} for the class definition } } diff --git a/man/model_class.Rd b/man/model_class.Rd deleted file mode 100644 index eb84843..0000000 --- a/man/model_class.Rd +++ /dev/null @@ -1,57 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model.R -\name{hasWeight,model-method} -\alias{hasWeight,model-method} -\alias{model_class} -\title{Getter for weights} -\usage{ -\S4method{hasWeight}{model}(object, verbose = FALSE) - -\S4method{getDist}{model}(object) - -\S4method{getR}{model}(object) - -\S4method{getK}{model}(object) - -\S4method{getWeight}{model}(object) - -\S4method{getPar}{model}(object) - -\S4method{getIndicmod}{model}(object) - -\S4method{getIndicfix}{model}(object) - -\S4method{getT}{model}(object) - -\S4method{setDist}{model}(object) <- value - -\S4method{setR}{model}(object) <- value - -\S4method{setK}{model}(object) <- value - -\S4method{setWeight}{model}(object) <- value - -\S4method{setPar}{model}(object) <- value - -\S4method{setIndicmod}{model}(object) <- value - -\S4method{setIndicfix}{model}(object) <- value - -\S4method{setT}{model}(object) <- value -} -\arguments{ -\item{verbose}{A logical indicating, if the function should give a print out.} - -\item{model}{An S4 model object.} -} -\value{ -Matrix of weights. -} -\description{ -\code{hasWeight} returns the weight matrix. -} -\examples{ -\dontrun{ -weight <- hasWeight(model) -} -} diff --git a/man/priordefine.Rd b/man/priordefine.Rd index 384b150..6afb801 100644 --- a/man/priordefine.Rd +++ b/man/priordefine.Rd @@ -55,7 +55,7 @@ Journal of Applied Mathematics, Statistics and Informatics 3, 165-183 } \seealso{ \itemize{ -\item \link[=prior-class]{prior} for the class definition +\item \linkS4class{prior} for the class definition \item \code{\link[=prior]{prior()}} for the default constructor of the class } } diff --git a/man/show-model-method.Rd b/man/show-model-method.Rd index 4790c3a..2b11350 100644 --- a/man/show-model-method.Rd +++ b/man/show-model-method.Rd @@ -22,5 +22,8 @@ show(f_model) } \seealso{ -\code{model} +\itemize{ +\item \linkS4class{model} for the class definition } +} +\keyword{internal} From 969f0ca63b7c6f8b60c1a825452ec133e9429ec5 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Tue, 2 Nov 2021 09:34:46 +0100 Subject: [PATCH 19/24] Modified the generics and set exported functions to @keywords internal instead of @noR --- NAMESPACE | 2 + R/AllGenerics.R | 138 +++++++++++++++++++++++++++++++++- R/binomialmodelmoments.R | 4 +- R/cdatamoments.R | 6 +- R/csdatamoments.R | 68 +---------------- R/ddatamoments.R | 4 +- R/dmodelmoments.R | 8 +- R/exponentialmodelmoments.R | 4 +- R/groupmoments.R | 27 ++++++- R/mcmc.R | 2 +- R/mcmcextract.R | 2 +- R/mcmcoutputbase.R | 16 ++-- R/mcmcoutputfix.R | 18 ++--- R/mcmcoutputfixhier.R | 18 ++--- R/mcmcoutputfixhierpost.R | 53 ++++++++++--- R/mcmcoutputfixpost.R | 20 ++--- R/mcmcoutputhier.R | 8 +- R/mcmcoutputhierpost.R | 16 ++-- R/mcmcoutputpermbase.R | 14 ++-- R/mcmcoutputpermfix.R | 14 ++-- R/mcmcoutputpermfixhier.R | 4 +- R/mcmcoutputpermfixhierpost.R | 2 +- R/mcmcoutputpermfixpost.R | 2 +- R/mcmcoutputpermhier.R | 2 +- R/mcmcoutputpermhierpost.R | 14 ++-- R/mcmcoutputpost.R | 16 ++-- R/normultmodelmoments.R | 11 ++- R/poissonmodelmoments.R | 4 +- R/prior.R | 2 +- R/studentmodelmoments.R | 4 +- R/studmultmodelmoments.R | 4 +- 31 files changed, 321 insertions(+), 186 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 760771f..75a7bfa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -285,6 +285,7 @@ exportMethods(getN) exportMethods(getNK) exportMethods(getNKperm) exportMethods(getName) +exportMethods(getOver) exportMethods(getPar) exportMethods(getParperm) exportMethods(getPost) @@ -319,6 +320,7 @@ exportMethods(getWK) exportMethods(getWeight) exportMethods(getWeightperm) exportMethods(getY) +exportMethods(getZero) exportMethods(hasExp) exportMethods(hasPar) exportMethods(hasPriorPar) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index c205501..44323ae 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -21,111 +21,134 @@ NULL ## Class 'model' -------------------------------------------------- +#' Simulates data from a finite mixture model #' @export #' @docType methods #' @keywords internal setGeneric("simulate", function(model, N = 100, varargin, seed = 0) standardGeneric("simulate")) +#' Plots the point process of a finite mixture model #' @export #' @docType methods #' @keywords internal +#' @rdname plotPointProc-generic setGeneric("plotPointProc", function(x, dev = TRUE, ...) standardGeneric("plotPointProc")) +#' Checks a finite mixture model for the weight #' @export #' @docType methods #' @keywords internal setGeneric("hasWeight", function(object, verbose = FALSE) standardGeneric("hasWeight")) +#' Checks a finite mixture model for repetitions #' @export #' @docType methods #' @keywords internal setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) +#' Checks a finite mixture model for the parameters #' @export #' @docType methods #' @keywords internal setGeneric("hasPar", function(object, verbose = FALSE) standardGeneric("hasPar")) +#' Extracts the marginal distribution from a finite mixture model #' @export #' @docType methods #' @keywords internal setGeneric("mixturemar", function(object, J) standardGeneric("mixturemar")) +#' Getter for the `dist` slot #' @export #' @docType methods #' @keywords internal setGeneric("getDist", function(object) standardGeneric("getDist")) +#' Getter for the `r` slot #' @export #' @docType methods #' @keywords internal setGeneric("getR", function(object) standardGeneric("getR")) +#' Getter for the `K` slot #' @export #' @docType methods #' @keywords internal setGeneric("getK", function(object) standardGeneric("getK")) +#' Getter for the `weight` slot #' @export #' @docType methods #' @keywords internal setGeneric("getWeight", function(object) standardGeneric("getWeight")) +#' Getter for the `par` slot #' @export #' @docType methods #' @keywords internal setGeneric("getPar", function(object) standardGeneric("getPar")) +#' Getter for the `indicmod` slot #' @export #' @docType methods #' @keywords internal setGeneric("getIndicmod", function(object) standardGeneric("getIndicmod")) +#' Getter for the `indicfix` slot #' @export #' @docType methods #' @keywords internal setGeneric("getIndicfix", function(object) standardGeneric("getIndicfix")) +#' Getter for the `T` slot #' @export #' @docType methods #' @keywords internal setGeneric("getT", function(object) standardGeneric("getT")) +#' Setter for the `dist` slot #' @export #' @docType methods #' @keywords internal setGeneric("setDist<-", function(object, value) standardGeneric("setDist<-")) +#' Setter for the `r` slot #' @export #' @docType methods #' @keywords internal setGeneric("setR<-", function(object, value) standardGeneric("setR<-")) +#' Setter for the `K` slot #' @export #' @docType methods #' @keywords internal setGeneric("setK<-", function(object, value) standardGeneric("setK<-")) +#' Setter for the `weight` slot #' @export #' @docType methods #' @keywords internal setGeneric("setWeight<-", function(object, value) standardGeneric("setWeight<-")) +#' Setter for the `par` slot #' @export #' @docType methods #' @keywords internal setGeneric("setPar<-", function(object, value) standardGeneric("setPar<-")) +#' Setter for the `indicmod` slot #' @export #' @docType methods #' @keywords internal setGeneric("setIndicmod<-", function(object, value) standardGeneric("setIndicmod<-")) +#' Setter for the `indicfix` slot #' @export #' @docType methods #' @keywords internal setGeneric("setIndicfix<-", function(object, value) standardGeneric("setIndicfix<-")) +#' Setter for the `T` slot #' @export #' @docType methods #' @keywords internal @@ -133,16 +156,19 @@ setGeneric("setT<-", function(object, value) standardGeneric("setT<-")) ## Class 'modelmoments' -------------------------------------------- +#' Getter for the `mean` slot #' @export #' @docType methods #' @keywords internal setGeneric("getMean", function(object) standardGeneric("getMean")) +#' Getter for the `var` slot #' @export #' @docType methods #' @keywords internal setGeneric("getVar", function(object) standardGeneric("getVar")) +#' Getter for the `model` slot #' @export #' @docType methods #' @keywords internal @@ -150,525 +176,629 @@ setGeneric("getModel", function(object) standardGeneric("getModel")) ## Class 'cmodelmoments' ------------------------------------------- +#' Getter for the `higher` slot #' @export #' @docType methods #' @keywords internal setGeneric("getHigher", function(object) standardGeneric("getHigher")) +#' Getter for the `skewness` slot #' @export #' @docType methods #' @keywords internal setGeneric("getSkewness", function(object) standardGeneric("getSkewness")) +#' Getter for the `kurtosis` slot #' @export #' @docType methods #' @keywords internal setGeneric("getKurtosis", function(object) standardGeneric("getKurtosis")) ## Class 'dmodelmoments' ------------------------------------------- +#' Getter for the `over` slot #' @export #' @docType methods #' @keywords internal setGeneric("getOver", function(object) standardGeneric("getOver")) +#' Getter for the `factorial` slot #' @export #' @docType methods #' @keywords internal setGeneric("getFactorial", function(object) standardGeneric("getFactorial")) +#' Getter for `zero` slot #' @export #' @docType methods #' @keywords internal setGeneric("getZero", function(object) standardGeneric("getZero")) ## Class 'normultmodelmoments' ------------------------------------- +#' Generates the moments of a finite mixture model #' @export #' @docType methods #' @keywords internal -#' @aliases generateMoments,cmodelmoments-class,csmodelmoments-class, -#' exponentialmodelmoments,binomialmodelmoments-class setGeneric("generateMoments", function(object) standardGeneric("generateMoments")) +#' Getter for the `B` slot. #' @export #' @docType methods #' @keywords internal -#' @aliases getB,cmodelmoments-class,exponentialmodelmoments-class setGeneric("getB", function(object) standardGeneric("getB")) +#' Getter for the `W` slot #' @export #' @docType methods #' @keywords internal setGeneric("getW", function(object) standardGeneric("getW")) +#' Getter for the `Rdet` slot #' @export #' @docType methods #' @keywords internal setGeneric("getRdet", function(object) standardGeneric("getRdet")) +#' Getter for the `Rtr` slot #' @export #' @docType methods #' @keywords internal setGeneric("getRtr", function(object) standardGeneric("getRtr")) +#' Getter for the `corr` slot #' @export #' @docType methods #' @keywords internal setGeneric("getCorr", function(object) standardGeneric("getCorr")) ## Class 'exponentialmodelmoments' --------------------------------- +#' Getter for the `extrabinvar` slot #' @export #' @docType methods #' @keywords internal setGeneric("getExtrabinvar", function(object) standardGeneric("getExtrabinvar")) ## Class 'fdata' ---------------------------------------------------- +#' Checks for the `y` slot of an `fdata` object #' @export #' @docType methods #' @keywords internal setGeneric("hasY", function(object, verbose = FALSE) standardGeneric("hasY")) +#' Checks for the `S` slot of an `fdata` object #' @export #' @docType methods #' @keywords internal setGeneric("hasS", function(object, verbose = FALSE) standardGeneric("hasS")) +#' Checks for the `exp` slot of an `fdata` object #' @export #' @docType methods #' @keywords internal setGeneric("hasExp", function(object, verbose = FALSE) standardGeneric("hasExp")) +#' Checks for the `T` slot of an `fdata` object #' @export #' @docType methods #' @keywords internal setGeneric("hasT", function(object, verbose = FALSE) standardGeneric("hasT")) +#' Getter for the `y` slot in column format #' @export #' @docType methods #' @keywords internal setGeneric("getColY", function(object) standardGeneric("getColY")) +#' Getter for the `y` slot in row format #' @export #' @docType methods #' @keywords internal setGeneric("getRowY", function(object) standardGeneric("getRowY")) +#' Getter for the `S` slot in column format #' @export #' @docType methods #' @keywords internal setGeneric("getColS", function(object) standardGeneric("getColS")) +#' Getter for the `S` slot in row format #' @export #' @docType methods #' @keywords internal setGeneric("getRowS", function(object) standardGeneric("getRowS")) +#' Getter for the `exp` slot in column format #' @export #' @docType methods #' @keywords internal setGeneric("getColExp", function(object) standardGeneric("getColExp")) +#' Getter for the `exp` slot in row format #' @export #' @docType methods #' @keywords internal setGeneric("getRowExp", function(object) standardGeneric("getRowExp")) +#' Getter for the `T` slot in column format #' @export #' @docType methods #' @keywords internal setGeneric("getColT", function(object) standardGeneric("getColT")) +#' Getter for the `T` slot in row format #' @export #' @docType methods #' @keywords internal setGeneric("getRowT", function(object) standardGeneric("getRowT")) +#' Getter for the `y` slot in stored format #' @export #' @docType methods #' @keywords internal setGeneric("getY", function(object) standardGeneric("getY")) +#' Getter for the `bycolumn` slot #' @export #' @docType methods #' @keywords internal setGeneric("getBycolumn", function(object) standardGeneric("getBycolumn")) +#' Getter for the `N` slot #' @export #' @docType methods #' @keywords internal setGeneric("getN", function(object) standardGeneric("getN")) +#' Getter for the `S` slot #' @export #' @docType methods #' @keywords internal setGeneric("getS", function(object) standardGeneric("getS")) +#' Getter for the `name` slot #' @export #' @docType methods #' @keywords internal setGeneric("getName", function(object) standardGeneric("getName")) +#' Getter for the `type` format #' @export #' @docType methods #' @keywords internal setGeneric("getType", function(object) standardGeneric("getType")) +#' Getter for the `sim` format #' @export #' @docType methods #' @keywords internal setGeneric("getSim", function(object) standardGeneric("getSim")) +#' Getter for the `exp` format #' @export #' @docType methods #' @keywords internal setGeneric("getExp", function(object) standardGeneric("getExp")) +#' Setter for the `y` slot #' @export #' @docType methods #' @keywords internal setGeneric("setY<-", function(object, value) standardGeneric("setY<-")) +#' Getter for the `N` slot #' @export #' @docType methods #' @keywords internal setGeneric("setN<-", function(object, value) standardGeneric("setN<-")) +#' Getter for the `S` slot #' @export #' @docType methods #' @keywords internal setGeneric("setS<-", function(object, value) standardGeneric("setS<-")) +#' Setter for the `bycolumn` format #' @export #' @docType methods #' @keywords internal setGeneric("setBycolumn<-", function(object, value) standardGeneric("setBycolumn<-")) +#' Setter for the `name` slot #' @export #' @docType methods #' @keywords internal setGeneric("setName<-", function(object, value) standardGeneric("setName<-")) +#' Setter for the `type` format #' @export #' @docType methods #' @keywords internal setGeneric("setType<-", function(object, value) standardGeneric("setType<-")) +#' Setter for the `sim` slot #' @export #' @docType methods #' @keywords internal setGeneric("setSim<-", function(object, value) standardGeneric("setSim<-")) +#' Setter for the `exp` slot #' @export #' @docType methods #' @keywords internal setGeneric("setExp<-", function(object, value) standardGeneric("setExp<-")) ## Class 'groupmoments' ---------------------------------------------- +#' Getter for the `NK` slot #' @export #' @docType methods #' @keywords internal setGeneric("getNK", function(object) standardGeneric("getNK")) +#' Setter for the `WK` slot #' @export #' @docType methods #' @keywords internal setGeneric("getWK", function(object) standardGeneric("getWK")) +#' Getter for the `fdata` slot #' @export #' @docType methods #' @keywords internal setGeneric("getFdata", function(object) standardGeneric("getFdata")) ## Class 'sdatamoments' ---------------------------------------------- +#' Getter for the `gmoments` slot #' @export #' @docType methods #' @keywords internal setGeneric("getGmoments", function(object) standardGeneric("getGmoments")) ## Class 'cdatamoments' --------------------------------------------- +#' Getter for the `smoments` slot #' @export #' @docType methods #' @keywords internal setGeneric("getSmoments", function(object) standardGeneric("getSmoments")) ## Class 'prior' ----------------------------------------------------- +#' Checks for the `par` slot in the `prior` class #' @export #' @docType methods #' @keywords internal setGeneric("hasPriorPar", function(object, model, verbose = FALSE) standardGeneric("hasPriorPar")) +#' Checks for the `weight` slot in the `prior` class #' @export #' @docType methods #' @keywords internal setGeneric("hasPriorWeight", function(object, model, verbose = FALSE) standardGeneric("hasPriorWeight")) +#' Generates the prior for a specific `model` #' @export #' @docType methods #' @keywords internal setGeneric("generatePrior", function(object, ...) standardGeneric("generatePrior")) +#' Getter for the `hier` slot #' @export #' @docType methods #' @keywords internal setGeneric("getHier", function(object) standardGeneric("getHier")) +#' Setter for the `hier` slot #' @export #' @docType methods #' @keywords internal setGeneric("setHier<-", function(object, value) standardGeneric("setHier<-")) ## Class 'mcmc' ------------------------------------------------------- +#' Getter for the `burnin` slot #' @export #' @docType methods #' @keywords internal setGeneric("getBurnin", function(object) standardGeneric("getBurnin")) +#' Getter for the `M` slot #' @export #' @docType methods #' @keywords internal setGeneric("getM", function(object) standardGeneric("getM")) +#' Getter for the `startpar` slot #' @export #' @docType methods #' @keywords internal setGeneric("getStartpar", function(object) standardGeneric("getStartpar")) +#' Getter for the `storeS` slot #' @export #' @docType methods #' @keywords internal setGeneric("getStoreS", function(object) standardGeneric("getStoreS")) +#' Getter for the `storepost` slot #' @export #' @docType methods #' @keywords internal setGeneric("getStorepost", function(object) standardGeneric("getStorepost")) +#' Getter for the `ranperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getRanperm", function(object) standardGeneric("getRanperm")) +#' Setter for the `burnin` slot #' @export #' @docType methods #' @keywords internal setGeneric("setBurnin<-", function(object, value) standardGeneric("setBurnin<-")) +#' Setter for the `M` slot #' @export #' @docType methods #' @keywords internal setGeneric("setM<-", function(object, value) standardGeneric("setM<-")) +#' Setter for the `startpar` slot #' @export #' @docType methods #' @keywords internal setGeneric("setStartpar<-", function(object, value) standardGeneric("setStartpar<-")) +#' Setter for the `storeS` slot #' @export #' @docType methods #' @keywords internal setGeneric("setStoreS<-", function(object, value) standardGeneric("setStoreS<-")) +#' Setter for the `storepost` slot #' @export #' @docType methods #' @keywords internal setGeneric("setStorepost<-", function(object, value) standardGeneric("setStorepost<-")) +#' Setter for the `ranperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("setRanperm<-", function(object, value) standardGeneric("setRanperm<-")) ## Class 'dataclass' ---------------------------------------------------- +#' Getter for the `logpy` slot #' @export #' @docType methods #' @keywords internal setGeneric("getLogpy", function(object) standardGeneric("getLogpy")) +#' Getter for the `prob` slot #' @export #' @docType methods #' @keywords internal setGeneric("getProb", function(object) standardGeneric("getProb")) +#' Getter for the mixlik slot #' @export #' @docType methods #' @keywords internal setGeneric("getMixlik", function(object) standardGeneric("getMixlik")) +#' Getter for the `entropy` slot #' @export #' @docType methods #' @keywords internal setGeneric("getEntropy", function(object) standardGeneric("getEntropy")) +#' Getter for the `postS` slot #' @export #' @docType methods #' @keywords internal setGeneric("getPostS", function(object) standardGeneric("getPostS")) +#' Getter for the `loglikcd` slot #' @export #' @docType methods #' @keywords internal setGeneric("getLoglikcd", function(object) standardGeneric("getLoglikcd")) -## Class 'mcmcextract' -------------------------------------------------------------------------- +## Class 'mcmcextract' -------------------------------------------------- +#' Computes the model moments from MCMC samples #' @export #' @docType methods #' @keywords internal setGeneric("moments", function(object) standardGeneric("moments")) ## Class 'mcmcoutputfix' ------------------------------------------------ +#' Plots the traces of the MCMC samples #' @export #' @docType methods #' @keywords internal +#' @rdname plotTraces-generic setGeneric("plotTraces", function(x, dev = TRUE, lik = 1, col = FALSE, ...) standardGeneric("plotTraces")) +#' Plots histograms of MCMC samples #' @export #' @docType methods #' @keywords internal +#' @rdname plotHist-generic setGeneric("plotHist", function(x, dev = TRUE, ...) standardGeneric("plotHist")) +#' Plots densities of MCMC samples #' @export #' @docType methods #' @keywords internal +#' @rdname plotDens-generic setGeneric("plotDens", function(x, dev = TRUE, ...) standardGeneric("plotDens")) +#' Plots sample representations of MCMC samples #' @export #' @docType methods #' @keywords internal +#' @rdname plotSampRep-generic setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSampRep")) +#' Plots the posterior density of sampled component parameters #' @export #' @docType methods #' @keywords internal +#' @rdname plotPostDens-generic setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPostDens")) +#' Generates a sub-chain from MCMC samples #' @export #' @docType methods #' @keywords internal +#' @rdname subseq-generic setGeneric("subseq", function(object, index) standardGeneric("subseq")) +#' Swaps elements in the MCMC sample arrays #' @export #' @docType methods #' @keywords internal +#' @rdname swapElements-generic setGeneric("swapElements", function(object, index) standardGeneric("swapElements")) +#' Extracts the MCMC samples from a specific dimension of a multivariate model #' @export #' @docType methods #' @keywords internal setGeneric("extract", function(object, index) standardGeneric("extract")) +#' Getter for the `log` slot #' @export #' @docType methods #' @keywords internal setGeneric("getLog", function(object) standardGeneric("getLog")) +#' Getter for the `prior` slot #' @export #' @docType methods #' @keywords internal setGeneric("getPrior", function(object) standardGeneric("getPrior")) ## Class 'mcmcoutputhier' ----------------------------------------------- +#' Getter for the `hyper` slot #' @export #' @docType methods #' @keywords internal setGeneric("getHyper", function(object) standardGeneric("getHyper")) ## Class 'mcmcoutputpost' ----------------------------------------------- +#' Getter for the `post` slot #' @export #' @docType methods #' @keywords internal setGeneric("getPost", function(object) standardGeneric("getPost")) ## Class 'mcmcoutputbase' ----------------------------------------------- +#' Getter for the `ST` slot #' @export #' @docType methods #' @keywords internal setGeneric("getST", function(object) standardGeneric("getST")) +#' Getter for the `clust` slot #' @export #' @docType methods #' @keywords internal setGeneric("getClust", function(object) standardGeneric("getClust")) ## Class 'mcmcpermfix' --------------------------------------------------- +#' Getter for the `Mperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getMperm", function(object) standardGeneric("getMperm")) +#' Getter for the `parperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getParperm", function(object) standardGeneric("getParperm")) +#' Getter for the `logperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getLogperm", function(object) standardGeneric("getLogperm")) ## Class 'mcmcpermfixhier' ----------------------------------------------- +#' Getter for the `hyperperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getHyperperm", function(object) standardGeneric("getHyperperm")) ## Class 'mcmcpermfixpost' ----------------------------------------------- +#' Getter for the `postperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getPostperm", function(object) standardGeneric("getPostperm")) ## Class 'mcmcpermind' --------------------------------------------------- +#' Getter for the `relabel` slot #' @export #' @docType methods #' @keywords internal setGeneric("getRelabel", function(object) standardGeneric("getRelabel")) +#' Getter for the `weightperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getWeightperm", function(object) standardGeneric("getWeightperm")) +#' Getter for the `entropyperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getEntropyperm", function(object) standardGeneric("getEntropyperm")) +#' Getter for the `STperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getSTperm", function(object) standardGeneric("getSTperm")) +#' Getter for the `Sperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getSperm", function(object) standardGeneric("getSperm")) +#' Getter for the `NKperm` slot #' @export #' @docType methods #' @keywords internal setGeneric("getNKperm", function(object) standardGeneric("getNKperm")) ## Class 'mcmcestfix' ----------------------------------------------------- +#' Getter for the `map` slot #' @export #' @docType methods #' @keywords internal setGeneric("getMap", function(object) standardGeneric("getMap")) +#' Getter for the `bml` slot #' @export #' @docType methods #' @keywords internal setGeneric("getBml", function(object) standardGeneric("getBml")) +#' Getter for the `ieavg` slot #' @export #' @docType methods #' @keywords internal setGeneric("getIeavg", function(object) standardGeneric("getIeavg")) +#' Getter for the `sdpost` slot #' @export #' @docType methods #' @keywords internal setGeneric("getSdpost", function(object) standardGeneric("getSdpost")) ## Class 'mcmcestind' ------------------------------------------------------ +#' Getter for the `eavg` slot #' @export #' @docType methods #' @keywords internal diff --git a/R/binomialmodelmoments.R b/R/binomialmodelmoments.R index fecb7e8..0511575 100644 --- a/R/binomialmodelmoments.R +++ b/R/binomialmodelmoments.R @@ -54,7 +54,7 @@ #' to `initialize()`. #' @param model A finmix `model` object containing the definition of the #' finite mixture distribution. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -75,7 +75,7 @@ setMethod( #' #' @param object An `binomialmodelmoments` object. #' @return An `binomialmodelmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "binomialmodelmoments", function(object) { diff --git a/R/cdatamoments.R b/R/cdatamoments.R index 61ecf8c..102b5c3 100644 --- a/R/cdatamoments.R +++ b/R/cdatamoments.R @@ -75,7 +75,7 @@ #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. #' @param model A finmix `fdata` object containing the observations. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -101,7 +101,7 @@ setMethod( #' #' @param object An `cdatamoments` object. #' @return An `cdatamoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "cdatamoments", function(object) { @@ -118,7 +118,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' @seealso #' * [datamoments-class] for the parent class #' * [datamoments()] for the class constructor diff --git a/R/csdatamoments.R b/R/csdatamoments.R index 41b3f48..dd4864c 100644 --- a/R/csdatamoments.R +++ b/R/csdatamoments.R @@ -84,7 +84,7 @@ setClassUnion("csdatamomentsOrNULL", members = c("csdatamoments", "NULL")) #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. #' @param model A finmix [fdata-class] object containing the observations. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -108,7 +108,7 @@ setMethod( #' #' @param object An `csdatamoments` object. #' @return An `csdatamoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "csdatamoments", function(object) { @@ -190,70 +190,6 @@ setMethod( } ) -#' Getter method of `csdatamoments` class. -#' -#' Returns the `WK` slot. -#' -#' @param object An `csdatamoments` object. -#' @returns The `WK` slot of the `object`. -#' @exportMethod getWK -#' @keywords internal -#' -#' @examples -#' # Generate an exponential mixture model with two components. -#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) -#' # Simulate data from the model. -#' f_data <- simulate(f_model) -#' # Calculate the mixture moments. -#' f_sdatamoms <- sdatamoments(f_data) -#' # Get the moments for the included indicators of the data. -#' getWK(f_sdatamoms) -#' -#' @seealso -#' * [datamoments-class] for the base class for model moments -#' * [datamoments()] for the constructor of the `datamoments` -#' class family -#' * [csdatamoments-class] for the class definition -#' * [sdatamoments()] for the constructor of the class -setMethod( - "getWK", "csdatamoments", - function(object) { - return(object@WK) - } -) - -#' Getter method of `csdatamoments` class. -#' -#' Returns the `var` slot. -#' -#' @param object An `csdatamoments` object. -#' @returns The `var` slot of the `object`. -#' @exportMethod getVar -#' @keywords internal -#' -#' @examples -#' # Generate an exponential mixture model with two components. -#' f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) -#' # Simulate data from the model. -#' f_data <- simulate(f_model) -#' # Calculate the mixture moments. -#' f_sdatamoms <- sdatamoments(f_data) -#' # Get the moments for the included indicators of the data. -#' getVar(f_sdatamoms) -#' -#' @seealso -#' * [datamoments-class] for the base class for model moments -#' * [datamoments()] for the constructor of the `datamoments` -#' class family -#' * [csdatamoments-class] for the class definition -#' * [sdatamoments()] for the constructor of the class -setMethod( - "getVar", "csdatamoments", - function(object) { - return(object@var) - } -) - #' Getter method of `csdatamoments` class. #' #' @description diff --git a/R/ddatamoments.R b/R/ddatamoments.R index ede5adc..d27aab6 100644 --- a/R/ddatamoments.R +++ b/R/ddatamoments.R @@ -68,7 +68,7 @@ #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. #' @param model A finmix `fdata` object containing the observations. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -95,7 +95,7 @@ setMethod( #' #' @param object An `ddatamoments` object. #' @return An `ddatamoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "ddatamoments", function(object) { diff --git a/R/dmodelmoments.R b/R/dmodelmoments.R index f5e2673..7da4bc7 100644 --- a/R/dmodelmoments.R +++ b/R/dmodelmoments.R @@ -54,14 +54,14 @@ #' #' @param object An `dmodelmoments` object. #' @returns The `higher` slot of the `object`. -#' @exportMethod getHigher +#' @exportMethod getOver #' @keywords internal #' #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) -#' getHigher(f_moments) +#' getOver(f_moments) #' #' @seealso #' * [modelmoments] for the base class for model moments @@ -98,14 +98,14 @@ setMethod("getFactorial", "dmodelmoments", function(object) { #' #' @param object An `dmodelmoments` object. #' @returns The `kurtosis` slot of the `object`. -#' @exportMethod getKurtosis +#' @exportMethod getZero #' @keywords internal #' #' @examples #' f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), #' weight=matrix(c(0.3, 0.7), nrow=1)) #' f_moments <- modelmoments(f_model) -#' getKurtosis(f_moments) +#' getZero(f_moments) #' #' @seealso #' * [modelmoments] for the base class for model moments diff --git a/R/exponentialmodelmoments.R b/R/exponentialmodelmoments.R index aa750f0..a8a5695 100644 --- a/R/exponentialmodelmoments.R +++ b/R/exponentialmodelmoments.R @@ -61,7 +61,7 @@ #' to `initialize()`. #' @param model A finmix `model` object containing the definition of the #' finite mixture distribution. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -82,7 +82,7 @@ setMethod( #' #' @param object An `exponentialmodelmoments` object. #' @return An `exponentialmodelmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "exponentialmodelmoments", function(object) { diff --git a/R/groupmoments.R b/R/groupmoments.R index 91bfa95..1735e86 100644 --- a/R/groupmoments.R +++ b/R/groupmoments.R @@ -110,7 +110,7 @@ #' @param ... Arguments to specify properties of the new object, to be passed #' to `initialize()`. #' @param model A finmix [fdata-class] object containing the observations. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -131,7 +131,7 @@ setMethod( #' #' @param object A `groupmoments` object. #' @return An `groupmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "groupmoments", function(object) { @@ -298,6 +298,29 @@ setMethod( } ) +#' Getter method of `groupmoments` class. +#' +#' Returns the `fdata` slot. +#' +#' @param object An `groupmoments` object. +#' @returns The `fdata` slot of the `object`. +#' @exportMethod getFdata +#' @keywords internal +#' +#' @examples +#' # Generate a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +#' # Simulate data from the model. +#' f_data <- simulate(f_model) +#' # Calculate the mixture moments. +#' f_gmoments <- groupmoments(f_data) +#' # Get the data< +#' getFdata(f_gmoments) +#' +#' @seealso +#' * [groupmoments-class] for the definition of the `groupmoments` +#' class +#' * [groupmoments()] for the class constructor setMethod( "getFdata", "groupmoments", function(object) { diff --git a/R/mcmc.R b/R/mcmc.R index 720ad7c..d3269e5 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -419,7 +419,7 @@ setReplaceMethod( #' @param value An integer defining the new value for the `@@storepost` slot. #' @returns None. #' @exportMethod setStorepost<- -#' @noRd +#' @keywords internal #' #' @examples #' # Generate an mcmc object diff --git a/R/mcmcextract.R b/R/mcmcextract.R index b3ac0d7..d2305f8 100644 --- a/R/mcmcextract.R +++ b/R/mcmcextract.R @@ -49,7 +49,7 @@ #' from MCMC sampling. #' @return A list containing the model moments calculated from MCMC samples. #' @exportMethod moments -#' @noRd +#' @keywords internal #' @seealso #' * [mcmcoutput-class] for the results from MCMC sampling #' * [extract()] for the calling method diff --git a/R/mcmcoutputbase.R b/R/mcmcoutputbase.R index 920f286..1151e69 100644 --- a/R/mcmcoutputbase.R +++ b/R/mcmcoutputbase.R @@ -73,7 +73,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputbase", function(object) { @@ -144,7 +144,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -218,7 +218,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -270,7 +270,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -321,7 +321,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point processes of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -368,7 +368,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representations of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -415,7 +415,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -462,7 +462,7 @@ setMethod( #' @param object An `mcmcoutput` object containing all sampled values. #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputbase", diff --git a/R/mcmcoutputfix.R b/R/mcmcoutputfix.R index b346bfe..e4534ce 100644 --- a/R/mcmcoutputfix.R +++ b/R/mcmcoutputfix.R @@ -75,7 +75,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputfix", function(object) { @@ -124,7 +124,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -195,7 +195,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -257,7 +257,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -319,7 +319,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -371,7 +371,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -421,7 +421,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -472,7 +472,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod subseq -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputfix", @@ -512,7 +512,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputfix", diff --git a/R/mcmcoutputfixhier.R b/R/mcmcoutputfixhier.R index afee80d..edbea04 100644 --- a/R/mcmcoutputfixhier.R +++ b/R/mcmcoutputfixhier.R @@ -47,7 +47,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputfixhier", function(object) { @@ -106,7 +106,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -175,7 +175,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -236,7 +236,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -296,7 +296,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -342,7 +342,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -388,7 +388,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -435,7 +435,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod subseq -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputfixhier", @@ -465,7 +465,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputfixhier", diff --git a/R/mcmcoutputfixhierpost.R b/R/mcmcoutputfixhierpost.R index 6fc23b3..4beb3fc 100644 --- a/R/mcmcoutputfixhierpost.R +++ b/R/mcmcoutputfixhierpost.R @@ -54,7 +54,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputfixhierpost", function(object) { @@ -112,7 +112,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -166,7 +166,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -218,7 +218,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -269,7 +269,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -320,7 +320,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -371,7 +371,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -423,7 +423,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod subseq -#' @noRd +#' @keywords internal #' #' @export subseq setMethod( @@ -458,7 +458,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputfixhierpost", @@ -484,3 +484,38 @@ setMethod( } } ) + +#' Getter method of `mcmcoutputfixpost` class. +#' +#' Returns the `post` slot. +#' +#' @param object An `mcmcoutputfixpost` object. +#' @returns The `post` slot of the `object`. +#' @exportMethod getPost +#' @keywords internal +#' +#' @examples +#' # Define a Poisson mixture model with two components. +#' f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, +#' indicfix = TRUE) +#' # Simulate data from the mixture model. +#' f_data <- simulate(f_model) +#' # Define the hyper-parameters for MCMC sampling. +#' f_mcmc <- mcmc() +#' # Define the prior distribution by relying on the data. +#' f_prior <- priordefine(f_data, f_model) +#' # Do not use hierarchical sampling +#' # Start MCMC sampling. +#' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +#' # Get the slot. +#' getPost(f_output) +#' +#' @seealso +#' * [mcmcoutput-class] for the class definition +#' * [mixturemcmc()] for performing MCMC sampling +setMethod( + "getPost", "mcmcoutputfixhierpost", + function(object) { + return(object@post) + } +) \ No newline at end of file diff --git a/R/mcmcoutputfixpost.R b/R/mcmcoutputfixpost.R index 9b83746..d277b00 100644 --- a/R/mcmcoutputfixpost.R +++ b/R/mcmcoutputfixpost.R @@ -56,7 +56,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputfixpost", function(object) { @@ -110,7 +110,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -162,7 +162,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -213,7 +213,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -262,7 +262,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -311,7 +311,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -360,7 +360,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -410,7 +410,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod subseq -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputfixpost", @@ -442,7 +442,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputfixpost", @@ -487,6 +487,8 @@ setMethod( #' f_mcmc <- mcmc() #' # Define the prior distribution by relying on the data. #' f_prior <- priordefine(f_data, f_model) +#' # Do not use hierarchical sampling +#' setHier(f_prior) <- FALSE #' # Start MCMC sampling. #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' # Get the slot. diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index 8a8c306..1a7b2e8 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -55,7 +55,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputhier", function(object) { @@ -393,7 +393,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -444,7 +444,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutput` object containing the values from the sub-chain. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputhier", @@ -473,7 +473,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutput` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputhier", diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index b3de46a..d2e8507 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -193,7 +193,7 @@ setClassUnion( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputhierpost", function(object) { @@ -272,7 +272,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -324,7 +324,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -375,7 +375,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -521,7 +521,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -574,7 +574,7 @@ setMethod( #' @return An `mcmcoutputhierpost` object containing the values from the #' sub-chain. #' @exportMethod subseq -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputhierpost", @@ -606,7 +606,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutputhierpost` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputhierpost", @@ -639,7 +639,7 @@ setMethod( #' #' @param object An `mcmcoutputhierpost` object. #' @returns The `post` slot of the `object`. -#' @noRd +#' @exportMethod getPost #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpermbase.R b/R/mcmcoutputpermbase.R index bf53c1a..e8f2cf7 100644 --- a/R/mcmcoutputpermbase.R +++ b/R/mcmcoutputpermbase.R @@ -126,7 +126,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputpermbase", function(object) { @@ -225,7 +225,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -305,7 +305,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -360,7 +360,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -416,7 +416,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -474,7 +474,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -532,7 +532,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfix.R b/R/mcmcoutputpermfix.R index 55f9514..af3d986 100644 --- a/R/mcmcoutputpermfix.R +++ b/R/mcmcoutputpermfix.R @@ -95,7 +95,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputpermfix", function(object) { @@ -153,7 +153,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -225,7 +225,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -281,7 +281,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -337,7 +337,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -393,7 +393,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling represetnation of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -449,7 +449,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index 03125c9..bdb27fb 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -99,7 +99,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputpermfixhier", function(object) { @@ -462,7 +462,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index 171af97..f8a7df5 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -109,7 +109,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputpermfixhierpost", function(object) { diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index 420f1d3..6fceaf1 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -95,7 +95,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal #' #' @seealso #' * [mcmcoutputpermfixpost-class] for the class definition diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index 2385084..46752b8 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -477,7 +477,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index 6ef1362..4b97366 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -139,7 +139,7 @@ setMethod( #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputpermhierpost", function(object) { @@ -259,7 +259,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -339,7 +339,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -394,7 +394,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -448,7 +448,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -502,7 +502,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotSampRep -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. @@ -556,7 +556,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index b45d538..0f55b2c 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -53,7 +53,7 @@ #' @returns A console output listing the slots and summary information about #' each of them. #' @exportMethod show -#' @noRd +#' @keywords internal setMethod( "show", "mcmcoutputpost", function(object) { @@ -368,7 +368,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens -#' @noRd +#' @keywords internal #' #' @examples #' \dontrun{ @@ -420,7 +420,7 @@ setMethod( #' @param index An array specifying the extraction of the sub-chain. #' @return An `mcmcoutputpost` object containing the values from the sub-chain. #' @exportMethod subseq -#' @noRd +#' @keywords internal setMethod( "subseq", signature( object = "mcmcoutputpost", @@ -452,7 +452,7 @@ setMethod( #' @param index An array specifying the extraction of the values. #' @return An `mcmcoutputpost` object with swapped elements. #' @exportMethod swapElements -#' @noRd +#' @keywords internal setMethod( "swapElements", signature( object = "mcmcoutputpost", @@ -478,11 +478,11 @@ setMethod( } ) -#' Getter method of `mcmcoutputhier` class. +#' Getter method of `mcmcoutputpost` class. #' #' Returns the `post` slot. #' -#' @param object An `mcmcoutputhier` object. +#' @param object An `mcmcoutputpost` object. #' @returns The `post` slot of the `object`. #' @exportMethod getPost #' @keywords internal @@ -493,9 +493,11 @@ setMethod( #' # Simulate data from the mixture model. #' f_data <- simulate(f_model) #' # Define the hyper-parameters for MCMC sampling. -#' f_mcmc <- mcmc(storepost = FALSE) +#' f_mcmc <- mcmc() #' # Define the prior distribution by relying on the data. #' f_prior <- priordefine(f_data, f_model) +#' # Do not use a hierarchical prior. +#' setHier(f_prior) <- FALSE #' # Start MCMC sampling. #' f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) #' # Get the slot. diff --git a/R/normultmodelmoments.R b/R/normultmodelmoments.R index 12af329..6fce063 100644 --- a/R/normultmodelmoments.R +++ b/R/normultmodelmoments.R @@ -23,7 +23,11 @@ #' #' @slot B A numeric defining the between-group heterogeneity. #' @slot W A numeric defining the within-group heterogeneity. -#' @slot R A numeric defining the coefficient of determination. +#' @slot Rdet A numeric defining the coefficient of determination based on the +#' determinant of the covariance matrix. +#' @slot Rtr A numeric defining the coefficient of determination based on the +#' trace of the covariance matrix. +#' @slot corr A `matrix` storing the correlation matrix. #' @exportClass normultmodelmoments #' @name normultmodelmoments-class #' @@ -65,7 +69,7 @@ #' to `initialize()`. #' @param model A finmix `model` object containing the definition of the #' finite mixture distribution. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -86,7 +90,7 @@ setMethod( #' #' @param object An `normultmodelmoments` object. #' @return An `normultmodelmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "normultmodelmoments", function(object) { @@ -256,6 +260,7 @@ setMethod( #' covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) #' sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) #' setPar(f_model) <- list(mu = means, sigma = sigmas) +#' f_moments <- modelmoments(f_model) #' getRtr(f_moments) #' #' @seealso diff --git a/R/poissonmodelmoments.R b/R/poissonmodelmoments.R index 922d83c..4d36dd4 100644 --- a/R/poissonmodelmoments.R +++ b/R/poissonmodelmoments.R @@ -50,7 +50,7 @@ #' to `initialize()`. #' @param model A finmix `model` object containing the definition of the #' finite mixture distribution. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -71,7 +71,7 @@ setMethod( #' #' @param object An `poissonmodelmoments` object. #' @return An `poissonmodelmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "poissonmodelmoments", function(object) { diff --git a/R/prior.R b/R/prior.R index 017a274..82a80a6 100644 --- a/R/prior.R +++ b/R/prior.R @@ -280,7 +280,7 @@ setMethod( #' @param s A numeric specifying the standard deviation `s` for the #' Metropolis-Hastings proposal. #' @rdname generatePrior -#' @noRd +#' @keywords internal #' #' @seealso #' * [prior-class] for the class definition diff --git a/R/studentmodelmoments.R b/R/studentmodelmoments.R index e5f7a42..7fcea8a 100644 --- a/R/studentmodelmoments.R +++ b/R/studentmodelmoments.R @@ -62,7 +62,7 @@ #' to `initialize()`. #' @param model A finmix `model` object containing the definition of the #' finite mixture distribution. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -83,7 +83,7 @@ setMethod( #' #' @param object An `studentmodelmoments` object. #' @return An `studentmodelmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "studentmodelmoments", function(object) { diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index ba6fca7..6889b08 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -65,7 +65,7 @@ #' to `initialize()`. #' @param model A finmix `model` object containing the definition of the #' finite mixture distribution. -#' @noRd +#' @keywords internal #' #' @seealso #' * [Classes_Details] for details of class definitions, and @@ -86,7 +86,7 @@ setMethod( #' #' @param object An `studmultmodelmoments` object. #' @return An `studmultmodelmoments` object with calculated moments. -#' @noRd +#' @keywords internal setMethod( "generateMoments", "studmultmodelmoments", function(object) { From 7bcbc919538d7d5a49040f0064ce8c54246e3651 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Wed, 3 Nov 2021 09:28:27 +0100 Subject: [PATCH 20/24] Fixed some bugs in the documentation. --- .gitignore | 6 + R/RcppExports.R | 9 +- R/datamoments.R | 4 +- R/mcmcestind.R | 5 +- R/mcmcoutputpermhierpost.R | 2 +- R/mcmcpermute.R | 12 ++ R/mincol.R | 10 +- R/model.R | 25 ++- R/prior.R | 12 +- R/studmultmodelmoments.R | 6 +- man/Summary-mcmcestfix-method.Rd | 24 +++ man/Summary-mcmcestind-method.Rd | 7 +- man/cdatamoments-class.Rd | 42 ++++ man/cmodelmoments-class.Rd | 30 +++ man/csdatamomentsOrNULL-class.Rd | 11 ++ man/dataclass-class.Rd | 47 +++++ man/datamoments-class.Rd | 29 +++ man/ddatamoments-class.Rd | 37 ++++ man/dmodelmoments-class.Rd | 27 +++ man/exponentialmodelmoments-class.Rd | 28 +++ man/extract-mcmcoutputfix-numeric-method.Rd | 23 +++ man/extract-method.Rd | 52 +++++ man/extract.Rd | 13 ++ man/fdata-class.Rd | 179 ++++++++++++++++++ ...rateMoments-binomialmodelmoments-method.Rd | 19 ++ man/generateMoments-cdatamoments-method.Rd | 19 ++ man/generateMoments-csdatamoments-method.Rd | 19 ++ man/generateMoments-ddatamoments-method.Rd | 19 ++ ...eMoments-exponentialmodelmoments-method.Rd | 19 ++ man/generateMoments-groupmoments-method.Rd | 19 ++ ...erateMoments-normultmodelmoments-method.Rd | 19 ++ ...erateMoments-poissonmodelmoments-method.Rd | 19 ++ ...erateMoments-studentmodelmoments-method.Rd | 19 ++ ...rateMoments-studmultmodelmoments-method.Rd | 19 ++ man/generateMoments.Rd | 13 ++ man/generatePrior.Rd | 41 ++++ man/getB-csdatamoments-method.Rd | 38 ++++ man/getB-exponentialmodelmoments-method.Rd | 31 +++ man/getB-normalmodelmoments-method.Rd | 33 ++++ man/getB-normultmodelmoments-method.Rd | 34 ++++ man/getB-studentmodelmoments-method.Rd | 33 ++++ man/getB-studmultmodelmoments-method.Rd | 34 ++++ man/getB.Rd | 13 ++ man/getBml-mcmcestfix-method.Rd | 42 ++++ man/getBml.Rd | 13 ++ man/getBurnin-mcmc-method.Rd | 31 +++ man/getBurnin-mcmcestfix-method.Rd | 42 ++++ man/getBurnin-mcmcoutputfix-method.Rd | 40 ++++ man/getBurnin.Rd | 13 ++ man/getBycolumn-fdata-method.Rd | 26 +++ man/getBycolumn.Rd | 13 ++ man/getClust-mcmcoutputbase-method.Rd | 41 ++++ man/getClust.Rd | 13 ++ man/getColExp-fdata-method.Rd | 26 +++ man/getColExp.Rd | 13 ++ man/getColS-fdata-method.Rd | 26 +++ man/getColS.Rd | 13 ++ man/getColT-fdata-method.Rd | 26 +++ man/getColT.Rd | 13 ++ man/getColY-fdata-method.Rd | 26 +++ man/getColY.Rd | 13 ++ man/getCorr-cdatamoments-method.Rd | 35 ++++ man/getCorr-normultmodelmoments-method.Rd | 34 ++++ man/getCorr-studmultmodelmoments-method.Rd | 34 ++++ man/getCorr.Rd | 13 ++ man/getDist-mcmcestfix-method.Rd | 42 ++++ man/getDist-model-method.Rd | 30 +++ man/getDist.Rd | 13 ++ man/getEavg-mcmcestind-method.Rd | 40 ++++ man/getEavg.Rd | 13 ++ man/getEntropy-dataclass-method.Rd | 34 ++++ man/getEntropy-mcmcoutputbase-method.Rd | 41 ++++ man/getEntropy.Rd | 13 ++ man/getEntropyperm-mcmcpermind-method.Rd | 28 +++ man/getEntropyperm.Rd | 13 ++ man/getExp-fdata-method.Rd | 26 +++ man/getExp.Rd | 13 ++ ...Extrabinvar-binomialmodelmoments-method.Rd | 31 +++ man/getExtrabinvar.Rd | 13 ++ man/getFactorial-ddatamoments-method.Rd | 35 ++++ man/getFactorial-dmodelmoments-method.Rd | 31 +++ man/getFactorial.Rd | 13 ++ man/getFdata-csdatamoments-method.Rd | 38 ++++ man/getFdata-groupmoments-method.Rd | 36 ++++ man/getFdata-sdatamoments-method.Rd | 38 ++++ man/getFdata.Rd | 13 ++ man/getGmoments-csdatamoments-method.Rd | 38 ++++ man/getGmoments-sdatamoments-method.Rd | 38 ++++ man/getGmoments.Rd | 13 ++ man/getHier-prior-method.Rd | 24 +++ man/getHier.Rd | 13 ++ man/getHigher-cdatamoments-method.Rd | 35 ++++ man/getHigher-cmodelmoments-method.Rd | 31 +++ man/getHigher.Rd | 13 ++ man/getHyper-mcmcoutputfixhier-method.Rd | 40 ++++ man/getHyper-mcmcoutputhier-method.Rd | 39 ++++ man/getHyper.Rd | 13 ++ man/getHyperperm-mcmcpermfixhier-method.Rd | 28 +++ man/getHyperperm-mcmcpermfixpost-method.Rd | 28 +++ man/getHyperperm.Rd | 13 ++ man/getIeavg-mcmcestfix-method.Rd | 42 ++++ man/getIeavg.Rd | 13 ++ man/getIndicfix-model-method.Rd | 30 +++ man/getIndicfix.Rd | 13 ++ man/getIndicmod-mcmcestfix-method.Rd | 42 ++++ man/getIndicmod-model-method.Rd | 30 +++ man/getIndicmod.Rd | 13 ++ man/getK-mcmcestfix-method.Rd | 42 ++++ man/getK-model-method.Rd | 30 +++ man/getK.Rd | 13 ++ man/getKurtosis-cdatamoments-method.Rd | 35 ++++ man/getKurtosis-cmodelmoments-method.Rd | 31 +++ man/getKurtosis.Rd | 13 ++ man/getLog-mcmcoutputfix-method.Rd | 40 ++++ man/getLog.Rd | 13 ++ man/getLoglikcd-dataclass-method.Rd | 35 ++++ man/getLoglikcd.Rd | 13 ++ man/getLogperm-mcmcpermfix-method.Rd | 28 +++ man/getLogperm.Rd | 13 ++ man/getLogpy-dataclass-method.Rd | 34 ++++ man/getLogpy.Rd | 13 ++ man/getM-mcmc-method.Rd | 31 +++ man/getM-mcmcestfix-method.Rd | 42 ++++ man/getM-mcmcoutputfix-method.Rd | 40 ++++ man/getM.Rd | 13 ++ man/getMap-mcmcestfix-method.Rd | 42 ++++ man/getMap.Rd | 13 ++ man/getMean-groupmoments-method.Rd | 36 ++++ man/getMean-modelmoments-method.Rd | 28 +++ man/getMean.Rd | 13 ++ man/getMixlik-dataclass-method.Rd | 34 ++++ man/getMixlik.Rd | 13 ++ man/getModel-mcmcoutputfix-method.Rd | 41 ++++ man/getModel-modelmoments-method.Rd | 28 +++ man/getModel.Rd | 13 ++ man/getMperm-mcmcpermfix-method.Rd | 28 +++ man/getMperm.Rd | 13 ++ man/getN-fdata-method.Rd | 26 +++ man/getN.Rd | 13 ++ man/getNK-groupmoments-method.Rd | 36 ++++ man/getNK-mcmcoutputbase-method.Rd | 41 ++++ man/getNK.Rd | 13 ++ man/getNKperm-mcmcpermind-method.Rd | 28 +++ man/getNKperm.Rd | 13 ++ man/getName-fdata-method.Rd | 26 +++ man/getName.Rd | 13 ++ man/getOver-ddatamoments-method.Rd | 35 ++++ man/getOver-dmodelmoments-method.Rd | 31 +++ man/getOver.Rd | 13 ++ man/getPar-mcmcoutputfix-method.Rd | 40 ++++ man/getPar-model-method.Rd | 30 +++ man/getPar-prior-method.Rd | 24 +++ man/getPar.Rd | 13 ++ man/getParperm-mcmcpermfix-method.Rd | 28 +++ man/getParperm.Rd | 13 ++ man/getPost-mcmcoutputfixhierpost-method.Rd | 41 ++++ man/getPost-mcmcoutputfixpost-method.Rd | 42 ++++ man/getPost-mcmcoutputhierpost-method.Rd | 38 ++++ man/getPost-mcmcoutputpost-method.Rd | 41 ++++ man/getPost.Rd | 13 ++ man/getPostS-dataclass-method.Rd | 35 ++++ man/getPostS.Rd | 13 ++ man/getPostperm-mcmcpermfixpost-method.Rd | 28 +++ man/getPostperm-mcmcpermindpost-method.Rd | 30 +++ man/getPostperm.Rd | 13 ++ man/getPrior-mcmcoutputfix-method.Rd | 40 ++++ man/getPrior.Rd | 13 ++ man/getProb-dataclass-method.Rd | 34 ++++ man/getProb.Rd | 13 ++ man/getR-csdatamoments-method.Rd | 38 ++++ man/getR-exponentialmodelmoments-method.Rd | 31 +++ man/getR-fdata-method.Rd | 26 +++ man/getR-model-method.Rd | 30 +++ man/getR-normalmodelmoments-method.Rd | 33 ++++ man/getR-studentmodelmoments-method.Rd | 33 ++++ man/getR.Rd | 13 ++ man/getRanperm-mcmc-method.Rd | 31 +++ man/getRanperm-mcmcestfix-method.Rd | 42 ++++ man/getRanperm-mcmcoutputfix-method.Rd | 40 ++++ man/getRanperm.Rd | 13 ++ man/getRdet-csdatamoments-method.Rd | 38 ++++ man/getRdet-normultmodelmoments-method.Rd | 34 ++++ man/getRdet-studmultmodelmoments-method.Rd | 34 ++++ man/getRdet.Rd | 13 ++ man/getRelabel-mcmcestfix-method.Rd | 42 ++++ man/getRelabel-mcmcpermind-method.Rd | 28 +++ man/getRelabel.Rd | 13 ++ man/getRowExp-fdata-method.Rd | 26 +++ man/getRowExp.Rd | 13 ++ man/getRowS-fdata-method.Rd | 26 +++ man/getRowS.Rd | 13 ++ man/getRowT-fdata-method.Rd | 26 +++ man/getRowT.Rd | 13 ++ man/getRowY-fdata-method.Rd | 26 +++ man/getRowY.Rd | 13 ++ man/getRtr-csdatamoments-method.Rd | 38 ++++ man/getRtr-normultmodelmoments-method.Rd | 34 ++++ man/getRtr-studmultmodelmoments-method.Rd | 34 ++++ man/getRtr.Rd | 13 ++ man/getS-fdata-method.Rd | 26 +++ man/getS-mcmcoutputbase-method.Rd | 41 ++++ man/getS.Rd | 13 ++ man/getST-mcmcoutputbase-method.Rd | 41 ++++ man/getST.Rd | 13 ++ man/getSTperm-mcmcpermind-method.Rd | 28 +++ man/getSTperm.Rd | 13 ++ man/getSdpost-mcmcestfix-method.Rd | 42 ++++ man/getSdpost.Rd | 13 ++ man/getSim-fdata-method.Rd | 26 +++ man/getSim.Rd | 13 ++ man/getSkewness-cdatamoments-method.Rd | 35 ++++ man/getSkewness-cmodelmoments-method.Rd | 31 +++ man/getSkewness.Rd | 13 ++ man/getSmoments-cdatamoments-method.Rd | 35 ++++ man/getSmoments-ddatamoments-method.Rd | 35 ++++ man/getSmoments.Rd | 13 ++ man/getSperm-mcmcpermind-method.Rd | 28 +++ man/getSperm.Rd | 13 ++ man/getStartpar-mcmc-method.Rd | 31 +++ man/getStartpar.Rd | 13 ++ man/getStoreS-mcmc-method.Rd | 31 +++ man/getStoreS.Rd | 13 ++ man/getStorepost-mcmc-method.Rd | 31 +++ man/getStorepost.Rd | 13 ++ man/getT-csdatamoments-method.Rd | 38 ++++ man/getT-fdata-method.Rd | 26 +++ man/getT-model-method.Rd | 30 +++ man/getT.Rd | 13 ++ man/getType-fdata-method.Rd | 26 +++ man/getType-prior-method.Rd | 24 +++ man/getType.Rd | 13 ++ man/getVar-groupmoments-method.Rd | 36 ++++ man/getVar-modelmoments-method.Rd | 28 +++ man/getVar.Rd | 13 ++ man/getW-csdatamoments-method.Rd | 38 ++++ man/getW-exponentialmodelmoments-method.Rd | 31 +++ man/getW-normalmodelmoments-method.Rd | 33 ++++ man/getW-normultmodelmoments-method.Rd | 34 ++++ man/getW-studentmodelmoments-method.Rd | 33 ++++ man/getW-studmultmodelmoments-method.Rd | 34 ++++ man/getW.Rd | 13 ++ man/getWK-groupmoments-method.Rd | 36 ++++ man/getWK.Rd | 13 ++ man/getWeight-mcmcoutputbase-method.Rd | 41 ++++ man/getWeight-model-method.Rd | 30 +++ man/getWeight-prior-method.Rd | 24 +++ man/getWeight.Rd | 13 ++ man/getWeightperm-mcmcpermind-method.Rd | 28 +++ man/getWeightperm.Rd | 13 ++ man/getY-fdata-method.Rd | 26 +++ man/getY.Rd | 13 ++ man/getZero-ddatamoments-method.Rd | 35 ++++ man/getZero-dmodelmoments-method.Rd | 31 +++ man/getZero.Rd | 13 ++ man/graphic_func.Rd | 16 ++ man/hasExp-fdata-method.Rd | 33 ++++ man/hasExp.Rd | 13 ++ man/hasPar-model-method.Rd | 4 +- man/hasPar.Rd | 13 ++ man/hasPriorPar-prior-model-method.Rd | 36 ++++ man/hasPriorPar.Rd | 13 ++ man/hasPriorWeight.Rd | 40 ++++ man/hasS.Rd | 13 ++ man/hasT-fdata-method.Rd | 33 ++++ man/hasT.Rd | 17 ++ man/hasWeight-model-method.Rd | 25 +++ man/hasWeight.Rd | 13 ++ man/hasY-fdata-method.Rd | 31 +++ man/hasY.Rd | 13 ++ man/initialize-binomialmodelmoments-method.Rd | 30 +++ man/initialize-cdatamoments-method.Rd | 29 +++ man/initialize-csdatamoments-method.Rd | 29 +++ man/initialize-ddatamoments-method.Rd | 29 +++ ...itialize-exponentialmodelmoments-method.Rd | 30 +++ man/initialize-groupmoments-method.Rd | 29 +++ man/initialize-normultmodelmoments-method.Rd | 30 +++ man/initialize-poissonmodelmoments-method.Rd | 30 +++ man/initialize-studentmodelmoments-method.Rd | 30 +++ man/initialize-studmultmodelmoments-method.Rd | 30 +++ man/mcmc-class.Rd | 46 +++++ man/mcmc_binomial_cc.Rd | 4 +- man/mcmcest-class.Rd | 127 +++++++++++++ man/mcmcestfix-class.Rd | 62 ++++++ man/mcmcestind-class.Rd | 34 ++++ man/mcmcextract-class.Rd | 29 +++ man/mcmcoutputfix-class.Rd | 37 ++++ man/mcmcoutputfixhier-class.Rd | 23 +++ man/mcmcoutputfixhierpost-class.Rd | 29 +++ man/mcmcoutputfixpost-class.Rd | 31 +++ man/mcmcoutputperm-class.Rd | 2 +- man/mcmcoutputpermhierpost-class.Rd | 29 +++ man/mcmcpermfixpost-class.Rd | 35 ++++ man/mcmcpermind-class.Rd | 54 ++++++ man/mcmcpermindhier-class.Rd | 36 ++++ man/mcmcpermindpost-class.Rd | 34 ++++ man/mcmcpermute.Rd | 19 ++ man/mixturemar.Rd | 13 ++ man/model-class.Rd | 81 ++++++++ man/moments-mcmcextract-method.Rd | 28 +++ man/moments-mcmcoutputfix-method.Rd | 20 ++ man/moments.Rd | 13 ++ man/normultmodelmoments-class.Rd | 34 ++++ man/plot-fdata-missing-method.Rd | 32 ++++ man/plot-model-ANY-method.Rd | 8 +- man/plotDens-generic.Rd | 13 ++ man/plotDens-mcmcoutputbase-method.Rd | 51 +++++ man/plotDens-mcmcoutputfix-method.Rd | 52 +++++ man/plotDens-mcmcoutputfixhier-method.Rd | 50 +++++ man/plotDens-mcmcoutputfixhierpost-method.Rd | 55 ++++++ man/plotDens-mcmcoutputfixpost-method.Rd | 53 ++++++ man/plotDens-mcmcoutputhierpost-method.Rd | 54 ++++++ man/plotDens-mcmcoutputpermbase-method.Rd | 52 +++++ man/plotDens-mcmcoutputpermfix-method.Rd | 55 ++++++ man/plotDens-mcmcoutputpermhier-method.Rd | 54 ++++++ man/plotDens-mcmcoutputpermhierpost-method.Rd | 54 ++++++ man/plotDens-mcmcoutputpermpost-method.Rd | 55 ++++++ man/plotDens-method.Rd | 67 +++++++ man/plotHist-generic.Rd | 13 ++ man/plotHist-mcmcoutputbase-method.Rd | 51 +++++ man/plotHist-mcmcoutputfix-method.Rd | 51 +++++ man/plotHist-mcmcoutputfixhier-method.Rd | 50 +++++ man/plotHist-mcmcoutputfixhierpost-method.Rd | 55 ++++++ man/plotHist-mcmcoutputfixpost-method.Rd | 54 ++++++ man/plotHist-mcmcoutputhierpost-method.Rd | 54 ++++++ man/plotHist-mcmcoutputpermbase-method.Rd | 57 ++++++ man/plotHist-mcmcoutputpermfix-method.Rd | 55 ++++++ man/plotHist-mcmcoutputpermhier-method.Rd | 54 ++++++ man/plotHist-mcmcoutputpermhierpost-method.Rd | 54 ++++++ man/plotHist-mcmcoutputpermpost-method.Rd | 55 ++++++ man/plotHist-method.Rd | 67 +++++++ man/plotPointProc-generic.Rd | 13 ++ man/plotPointProc-mcmcoutputbase-method.Rd | 50 +++++ man/plotPointProc-mcmcoutputfix-method.Rd | 51 +++++ man/plotPointProc-mcmcoutputfixhier-method.Rd | 49 +++++ ...tPointProc-mcmcoutputfixhierpost-method.Rd | 54 ++++++ man/plotPointProc-mcmcoutputfixpost-method.Rd | 52 +++++ ...plotPointProc-mcmcoutputpermbase-method.Rd | 57 ++++++ man/plotPointProc-mcmcoutputpermfix-method.Rd | 55 ++++++ ...plotPointProc-mcmcoutputpermhier-method.Rd | 52 +++++ ...PointProc-mcmcoutputpermhierpost-method.Rd | 53 ++++++ ...plotPointProc-mcmcoutputpermpost-method.Rd | 55 ++++++ man/plotPointProc-method.Rd | 67 +++++++ man/plotPointProc-model-method.Rd | 7 +- man/plotPostDens-generic.Rd | 13 ++ man/plotPostDens-mcmcoutputbase-method.Rd | 50 +++++ man/plotPostDens-mcmcoutputfix-method.Rd | 49 +++++ man/plotPostDens-mcmcoutputfixhier-method.Rd | 49 +++++ ...otPostDens-mcmcoutputfixhierpost-method.Rd | 54 ++++++ man/plotPostDens-mcmcoutputfixpost-method.Rd | 52 +++++ man/plotPostDens-mcmcoutputhier-method.Rd | 50 +++++ man/plotPostDens-mcmcoutputhierpost-method.Rd | 52 +++++ man/plotPostDens-mcmcoutputpermbase-method.Rd | 57 ++++++ man/plotPostDens-mcmcoutputpermfix-method.Rd | 55 ++++++ ...otPostDens-mcmcoutputpermfixhier-method.Rd | 56 ++++++ man/plotPostDens-mcmcoutputpermhier-method.Rd | 53 ++++++ ...tPostDens-mcmcoutputpermhierpost-method.Rd | 53 ++++++ man/plotPostDens-mcmcoutputpermpost-method.Rd | 55 ++++++ man/plotPostDens-mcmcoutputpost-method.Rd | 52 +++++ man/plotPostDens-method.Rd | 59 ++++++ man/plotSampRep-generic.Rd | 13 ++ man/plotSampRep-mcmcoutputbase-method.Rd | 50 +++++ man/plotSampRep-mcmcoutputfix-method.Rd | 49 +++++ man/plotSampRep-mcmcoutputfixhier-method.Rd | 49 +++++ ...lotSampRep-mcmcoutputfixhierpost-method.Rd | 54 ++++++ man/plotSampRep-mcmcoutputfixpost-method.Rd | 52 +++++ man/plotSampRep-mcmcoutputpermbase-method.Rd | 57 ++++++ man/plotSampRep-mcmcoutputpermfix-method.Rd | 55 ++++++ man/plotSampRep-mcmcoutputpermhier-method.Rd | 53 ++++++ ...otSampRep-mcmcoutputpermhierpost-method.Rd | 53 ++++++ man/plotSampRep-mcmcoutputpermpost-method.Rd | 55 ++++++ man/plotSampRep-method.Rd | 83 ++++++++ man/plotTraces-generic.Rd | 13 ++ man/plotTraces-mcmcoutputbase-method.Rd | 61 ++++++ man/plotTraces-mcmcoutputfix-method.Rd | 62 ++++++ man/plotTraces-mcmcoutputfixhier-method.Rd | 60 ++++++ ...plotTraces-mcmcoutputfixhierpost-method.Rd | 63 ++++++ man/plotTraces-mcmcoutputfixpost-method.Rd | 61 ++++++ man/plotTraces-mcmcoutputhierpost-method.Rd | 61 ++++++ man/plotTraces-mcmcoutputpermbase-method.Rd | 65 +++++++ man/plotTraces-mcmcoutputpermfix-method.Rd | 64 +++++++ man/plotTraces-mcmcoutputpermhier-method.Rd | 61 ++++++ ...lotTraces-mcmcoutputpermhierpost-method.Rd | 64 +++++++ man/plotTraces-mcmcoutputpermpost-method.Rd | 63 ++++++ man/plotTraces-method.Rd | 80 ++++++++ man/poissonmodelmoments-class.Rd | 20 ++ man/prior.Rd | 39 ++-- man/qincol.Rd | 2 +- man/qincolmult.Rd | 6 +- man/qinmatrmult.Rd | 2 +- man/sdatamoments-class.Rd | 30 +++ man/setBurnin-set-mcmc-method.Rd | 33 ++++ man/setBurnin-set.Rd | 13 ++ man/setBycolumn-set-fdata-method.Rd | 31 +++ man/setBycolumn-set.Rd | 13 ++ man/setDist-set-model-method.Rd | 32 ++++ man/setDist-set.Rd | 13 ++ man/setExp-set-fdata-method.Rd | 31 +++ man/setExp-set.Rd | 13 ++ man/setHier-set-prior-method.Rd | 26 +++ man/setHier-set.Rd | 13 ++ man/setIndicfix-set-model-method.Rd | 32 ++++ man/setIndicfix-set.Rd | 13 ++ man/setIndicmod-set-model-method.Rd | 32 ++++ man/setIndicmod-set.Rd | 13 ++ man/setK-set-model-method.Rd | 32 ++++ man/setK-set.Rd | 13 ++ man/setM-set-mcmc-method.Rd | 33 ++++ man/setM-set.Rd | 13 ++ man/setN-set-fdata-method.Rd | 29 +++ man/setN-set.Rd | 13 ++ man/setName-set-fdata-method.Rd | 31 +++ man/setName-set.Rd | 13 ++ man/setPar-set-model-method.Rd | 34 ++++ man/setPar-set-prior-method.Rd | 27 +++ man/setPar-set.Rd | 13 ++ man/setR-set-fdata-method.Rd | 29 +++ man/setR-set-model-method.Rd | 32 ++++ man/setR-set.Rd | 13 ++ man/setRanperm-set-mcmc-method.Rd | 33 ++++ man/setRanperm-set.Rd | 13 ++ man/setS-set-fdata-method.Rd | 31 +++ man/setS-set.Rd | 13 ++ man/setSim-set-fdata-method.Rd | 31 +++ man/setSim-set.Rd | 13 ++ man/setStartpar-set-mcmc-method.Rd | 33 ++++ man/setStartpar-set.Rd | 13 ++ man/setStoreS-set-mcmc-method.Rd | 33 ++++ man/setStoreS-set.Rd | 13 ++ man/setStorepost-set-mcmc-method.Rd | 33 ++++ man/setStorepost-set.Rd | 13 ++ man/setT-set-fdata-method.Rd | 31 +++ man/setT-set-model-method.Rd | 32 ++++ man/setT-set.Rd | 13 ++ man/setType-set-fdata-method.Rd | 31 +++ man/setType-set-prior-method.Rd | 26 +++ man/setType-set.Rd | 13 ++ man/setWeight-set-model-method.Rd | 32 ++++ man/setWeight-set-prior-method.Rd | 26 +++ man/setWeight-set.Rd | 13 ++ man/setY-set-fdata-method.Rd | 29 +++ man/setY-set.Rd | 13 ++ man/show-binomialmodelmoments-method.Rd | 26 +++ man/show-cdatamoments-method.Rd | 26 +++ man/show-csdatamoments-method.Rd | 20 ++ man/show-dataclass-method.Rd | 26 +++ man/show-ddatamoments-method.Rd | 26 +++ man/show-exponentialmodelmoments-method.Rd | 26 +++ man/show-fdata-method.Rd | 29 +++ man/show-groupmoments-method.Rd | 20 ++ man/show-mcmc-method.Rd | 26 +++ man/show-mcmcestfix-method.Rd | 20 ++ man/show-mcmcestind-method.Rd | 20 ++ man/show-mcmcoutputbase-method.Rd | 20 ++ man/show-mcmcoutputfix-method.Rd | 20 ++ man/show-mcmcoutputfixhier-method.Rd | 20 ++ man/show-mcmcoutputfixhierpost-method.Rd | 20 ++ man/show-mcmcoutputfixpost-method.Rd | 20 ++ man/show-mcmcoutputhier-method.Rd | 20 ++ man/show-mcmcoutputhierpost-method.Rd | 20 ++ man/show-mcmcoutputpermbase-method.Rd | 20 ++ man/show-mcmcoutputpermfix-method.Rd | 20 ++ man/show-mcmcoutputpermfixhier-method.Rd | 20 ++ man/show-mcmcoutputpermfixhierpost-method.Rd | 20 ++ man/show-mcmcoutputpermfixpost-method.Rd | 25 +++ man/show-mcmcoutputpermhierpost-method.Rd | 20 ++ man/show-mcmcoutputpost-method.Rd | 20 ++ man/show-normalmodelmoments-method.Rd | 26 +++ man/show-normultmodelmoments-method.Rd | 26 +++ man/show-poissonmodelmoments-method.Rd | 26 +++ man/show-prior-method.Rd | 27 +++ man/show-sdatamoments-method.Rd | 20 ++ man/show-studentmodelmoments-method.Rd | 26 +++ man/show-studmultmodelmoments-method.Rd | 20 ++ man/simulate-model-method.Rd | 38 ++++ man/simulate.Rd | 13 ++ man/stephens1997b_binomial_cc.Rd | 7 +- man/studentmodelmoments-class.Rd | 28 +++ man/studmultmodelmoments-class.Rd | 34 ++++ man/subseq-generic.Rd | 13 ++ man/subseq-mcmcoutputbase-array-method.Rd | 24 +++ man/subseq-mcmcoutputfix-array-method.Rd | 24 +++ man/subseq-mcmcoutputfixhier-array-method.Rd | 24 +++ ...bseq-mcmcoutputfixhierpost-array-method.Rd | 27 +++ man/subseq-mcmcoutputfixpost-array-method.Rd | 27 +++ man/subseq-mcmcoutputhier-array-method.Rd | 27 +++ man/subseq-mcmcoutputhierpost-array-method.Rd | 29 +++ man/subseq-mcmcoutputpost-array-method.Rd | 27 +++ man/subseq-method.Rd | 57 ++++++ man/swapElements-generic.Rd | 13 ++ ...wapElements-mcmcoutputbase-array-method.Rd | 20 ++ ...swapElements-mcmcoutputfix-array-method.Rd | 20 ++ ...Elements-mcmcoutputfixhier-array-method.Rd | 20 ++ ...ents-mcmcoutputfixhierpost-array-method.Rd | 20 ++ ...Elements-mcmcoutputfixpost-array-method.Rd | 20 ++ ...wapElements-mcmcoutputhier-array-method.Rd | 20 ++ ...lements-mcmcoutputhierpost-array-method.Rd | 20 ++ ...wapElements-mcmcoutputpost-array-method.Rd | 20 ++ man/swapElements-method.Rd | 50 +++++ man/swap_3d_cc.Rd | 5 +- src/attributes.cpp | 2 +- src/mcmc_binomial.cpp | 2 +- src/relabel_algorithms.cpp | 5 +- 502 files changed, 14725 insertions(+), 74 deletions(-) create mode 100644 man/Summary-mcmcestfix-method.Rd create mode 100644 man/cdatamoments-class.Rd create mode 100644 man/cmodelmoments-class.Rd create mode 100644 man/csdatamomentsOrNULL-class.Rd create mode 100644 man/dataclass-class.Rd create mode 100644 man/datamoments-class.Rd create mode 100644 man/ddatamoments-class.Rd create mode 100644 man/dmodelmoments-class.Rd create mode 100644 man/exponentialmodelmoments-class.Rd create mode 100644 man/extract-mcmcoutputfix-numeric-method.Rd create mode 100644 man/extract-method.Rd create mode 100644 man/extract.Rd create mode 100644 man/fdata-class.Rd create mode 100644 man/generateMoments-binomialmodelmoments-method.Rd create mode 100644 man/generateMoments-cdatamoments-method.Rd create mode 100644 man/generateMoments-csdatamoments-method.Rd create mode 100644 man/generateMoments-ddatamoments-method.Rd create mode 100644 man/generateMoments-exponentialmodelmoments-method.Rd create mode 100644 man/generateMoments-groupmoments-method.Rd create mode 100644 man/generateMoments-normultmodelmoments-method.Rd create mode 100644 man/generateMoments-poissonmodelmoments-method.Rd create mode 100644 man/generateMoments-studentmodelmoments-method.Rd create mode 100644 man/generateMoments-studmultmodelmoments-method.Rd create mode 100644 man/generateMoments.Rd create mode 100644 man/generatePrior.Rd create mode 100644 man/getB-csdatamoments-method.Rd create mode 100644 man/getB-exponentialmodelmoments-method.Rd create mode 100644 man/getB-normalmodelmoments-method.Rd create mode 100644 man/getB-normultmodelmoments-method.Rd create mode 100644 man/getB-studentmodelmoments-method.Rd create mode 100644 man/getB-studmultmodelmoments-method.Rd create mode 100644 man/getB.Rd create mode 100644 man/getBml-mcmcestfix-method.Rd create mode 100644 man/getBml.Rd create mode 100644 man/getBurnin-mcmc-method.Rd create mode 100644 man/getBurnin-mcmcestfix-method.Rd create mode 100644 man/getBurnin-mcmcoutputfix-method.Rd create mode 100644 man/getBurnin.Rd create mode 100644 man/getBycolumn-fdata-method.Rd create mode 100644 man/getBycolumn.Rd create mode 100644 man/getClust-mcmcoutputbase-method.Rd create mode 100644 man/getClust.Rd create mode 100644 man/getColExp-fdata-method.Rd create mode 100644 man/getColExp.Rd create mode 100644 man/getColS-fdata-method.Rd create mode 100644 man/getColS.Rd create mode 100644 man/getColT-fdata-method.Rd create mode 100644 man/getColT.Rd create mode 100644 man/getColY-fdata-method.Rd create mode 100644 man/getColY.Rd create mode 100644 man/getCorr-cdatamoments-method.Rd create mode 100644 man/getCorr-normultmodelmoments-method.Rd create mode 100644 man/getCorr-studmultmodelmoments-method.Rd create mode 100644 man/getCorr.Rd create mode 100644 man/getDist-mcmcestfix-method.Rd create mode 100644 man/getDist-model-method.Rd create mode 100644 man/getDist.Rd create mode 100644 man/getEavg-mcmcestind-method.Rd create mode 100644 man/getEavg.Rd create mode 100644 man/getEntropy-dataclass-method.Rd create mode 100644 man/getEntropy-mcmcoutputbase-method.Rd create mode 100644 man/getEntropy.Rd create mode 100644 man/getEntropyperm-mcmcpermind-method.Rd create mode 100644 man/getEntropyperm.Rd create mode 100644 man/getExp-fdata-method.Rd create mode 100644 man/getExp.Rd create mode 100644 man/getExtrabinvar-binomialmodelmoments-method.Rd create mode 100644 man/getExtrabinvar.Rd create mode 100644 man/getFactorial-ddatamoments-method.Rd create mode 100644 man/getFactorial-dmodelmoments-method.Rd create mode 100644 man/getFactorial.Rd create mode 100644 man/getFdata-csdatamoments-method.Rd create mode 100644 man/getFdata-groupmoments-method.Rd create mode 100644 man/getFdata-sdatamoments-method.Rd create mode 100644 man/getFdata.Rd create mode 100644 man/getGmoments-csdatamoments-method.Rd create mode 100644 man/getGmoments-sdatamoments-method.Rd create mode 100644 man/getGmoments.Rd create mode 100644 man/getHier-prior-method.Rd create mode 100644 man/getHier.Rd create mode 100644 man/getHigher-cdatamoments-method.Rd create mode 100644 man/getHigher-cmodelmoments-method.Rd create mode 100644 man/getHigher.Rd create mode 100644 man/getHyper-mcmcoutputfixhier-method.Rd create mode 100644 man/getHyper-mcmcoutputhier-method.Rd create mode 100644 man/getHyper.Rd create mode 100644 man/getHyperperm-mcmcpermfixhier-method.Rd create mode 100644 man/getHyperperm-mcmcpermfixpost-method.Rd create mode 100644 man/getHyperperm.Rd create mode 100644 man/getIeavg-mcmcestfix-method.Rd create mode 100644 man/getIeavg.Rd create mode 100644 man/getIndicfix-model-method.Rd create mode 100644 man/getIndicfix.Rd create mode 100644 man/getIndicmod-mcmcestfix-method.Rd create mode 100644 man/getIndicmod-model-method.Rd create mode 100644 man/getIndicmod.Rd create mode 100644 man/getK-mcmcestfix-method.Rd create mode 100644 man/getK-model-method.Rd create mode 100644 man/getK.Rd create mode 100644 man/getKurtosis-cdatamoments-method.Rd create mode 100644 man/getKurtosis-cmodelmoments-method.Rd create mode 100644 man/getKurtosis.Rd create mode 100644 man/getLog-mcmcoutputfix-method.Rd create mode 100644 man/getLog.Rd create mode 100644 man/getLoglikcd-dataclass-method.Rd create mode 100644 man/getLoglikcd.Rd create mode 100644 man/getLogperm-mcmcpermfix-method.Rd create mode 100644 man/getLogperm.Rd create mode 100644 man/getLogpy-dataclass-method.Rd create mode 100644 man/getLogpy.Rd create mode 100644 man/getM-mcmc-method.Rd create mode 100644 man/getM-mcmcestfix-method.Rd create mode 100644 man/getM-mcmcoutputfix-method.Rd create mode 100644 man/getM.Rd create mode 100644 man/getMap-mcmcestfix-method.Rd create mode 100644 man/getMap.Rd create mode 100644 man/getMean-groupmoments-method.Rd create mode 100644 man/getMean-modelmoments-method.Rd create mode 100644 man/getMean.Rd create mode 100644 man/getMixlik-dataclass-method.Rd create mode 100644 man/getMixlik.Rd create mode 100644 man/getModel-mcmcoutputfix-method.Rd create mode 100644 man/getModel-modelmoments-method.Rd create mode 100644 man/getModel.Rd create mode 100644 man/getMperm-mcmcpermfix-method.Rd create mode 100644 man/getMperm.Rd create mode 100644 man/getN-fdata-method.Rd create mode 100644 man/getN.Rd create mode 100644 man/getNK-groupmoments-method.Rd create mode 100644 man/getNK-mcmcoutputbase-method.Rd create mode 100644 man/getNK.Rd create mode 100644 man/getNKperm-mcmcpermind-method.Rd create mode 100644 man/getNKperm.Rd create mode 100644 man/getName-fdata-method.Rd create mode 100644 man/getName.Rd create mode 100644 man/getOver-ddatamoments-method.Rd create mode 100644 man/getOver-dmodelmoments-method.Rd create mode 100644 man/getOver.Rd create mode 100644 man/getPar-mcmcoutputfix-method.Rd create mode 100644 man/getPar-model-method.Rd create mode 100644 man/getPar-prior-method.Rd create mode 100644 man/getPar.Rd create mode 100644 man/getParperm-mcmcpermfix-method.Rd create mode 100644 man/getParperm.Rd create mode 100644 man/getPost-mcmcoutputfixhierpost-method.Rd create mode 100644 man/getPost-mcmcoutputfixpost-method.Rd create mode 100644 man/getPost-mcmcoutputhierpost-method.Rd create mode 100644 man/getPost-mcmcoutputpost-method.Rd create mode 100644 man/getPost.Rd create mode 100644 man/getPostS-dataclass-method.Rd create mode 100644 man/getPostS.Rd create mode 100644 man/getPostperm-mcmcpermfixpost-method.Rd create mode 100644 man/getPostperm-mcmcpermindpost-method.Rd create mode 100644 man/getPostperm.Rd create mode 100644 man/getPrior-mcmcoutputfix-method.Rd create mode 100644 man/getPrior.Rd create mode 100644 man/getProb-dataclass-method.Rd create mode 100644 man/getProb.Rd create mode 100644 man/getR-csdatamoments-method.Rd create mode 100644 man/getR-exponentialmodelmoments-method.Rd create mode 100644 man/getR-fdata-method.Rd create mode 100644 man/getR-model-method.Rd create mode 100644 man/getR-normalmodelmoments-method.Rd create mode 100644 man/getR-studentmodelmoments-method.Rd create mode 100644 man/getR.Rd create mode 100644 man/getRanperm-mcmc-method.Rd create mode 100644 man/getRanperm-mcmcestfix-method.Rd create mode 100644 man/getRanperm-mcmcoutputfix-method.Rd create mode 100644 man/getRanperm.Rd create mode 100644 man/getRdet-csdatamoments-method.Rd create mode 100644 man/getRdet-normultmodelmoments-method.Rd create mode 100644 man/getRdet-studmultmodelmoments-method.Rd create mode 100644 man/getRdet.Rd create mode 100644 man/getRelabel-mcmcestfix-method.Rd create mode 100644 man/getRelabel-mcmcpermind-method.Rd create mode 100644 man/getRelabel.Rd create mode 100644 man/getRowExp-fdata-method.Rd create mode 100644 man/getRowExp.Rd create mode 100644 man/getRowS-fdata-method.Rd create mode 100644 man/getRowS.Rd create mode 100644 man/getRowT-fdata-method.Rd create mode 100644 man/getRowT.Rd create mode 100644 man/getRowY-fdata-method.Rd create mode 100644 man/getRowY.Rd create mode 100644 man/getRtr-csdatamoments-method.Rd create mode 100644 man/getRtr-normultmodelmoments-method.Rd create mode 100644 man/getRtr-studmultmodelmoments-method.Rd create mode 100644 man/getRtr.Rd create mode 100644 man/getS-fdata-method.Rd create mode 100644 man/getS-mcmcoutputbase-method.Rd create mode 100644 man/getS.Rd create mode 100644 man/getST-mcmcoutputbase-method.Rd create mode 100644 man/getST.Rd create mode 100644 man/getSTperm-mcmcpermind-method.Rd create mode 100644 man/getSTperm.Rd create mode 100644 man/getSdpost-mcmcestfix-method.Rd create mode 100644 man/getSdpost.Rd create mode 100644 man/getSim-fdata-method.Rd create mode 100644 man/getSim.Rd create mode 100644 man/getSkewness-cdatamoments-method.Rd create mode 100644 man/getSkewness-cmodelmoments-method.Rd create mode 100644 man/getSkewness.Rd create mode 100644 man/getSmoments-cdatamoments-method.Rd create mode 100644 man/getSmoments-ddatamoments-method.Rd create mode 100644 man/getSmoments.Rd create mode 100644 man/getSperm-mcmcpermind-method.Rd create mode 100644 man/getSperm.Rd create mode 100644 man/getStartpar-mcmc-method.Rd create mode 100644 man/getStartpar.Rd create mode 100644 man/getStoreS-mcmc-method.Rd create mode 100644 man/getStoreS.Rd create mode 100644 man/getStorepost-mcmc-method.Rd create mode 100644 man/getStorepost.Rd create mode 100644 man/getT-csdatamoments-method.Rd create mode 100644 man/getT-fdata-method.Rd create mode 100644 man/getT-model-method.Rd create mode 100644 man/getT.Rd create mode 100644 man/getType-fdata-method.Rd create mode 100644 man/getType-prior-method.Rd create mode 100644 man/getType.Rd create mode 100644 man/getVar-groupmoments-method.Rd create mode 100644 man/getVar-modelmoments-method.Rd create mode 100644 man/getVar.Rd create mode 100644 man/getW-csdatamoments-method.Rd create mode 100644 man/getW-exponentialmodelmoments-method.Rd create mode 100644 man/getW-normalmodelmoments-method.Rd create mode 100644 man/getW-normultmodelmoments-method.Rd create mode 100644 man/getW-studentmodelmoments-method.Rd create mode 100644 man/getW-studmultmodelmoments-method.Rd create mode 100644 man/getW.Rd create mode 100644 man/getWK-groupmoments-method.Rd create mode 100644 man/getWK.Rd create mode 100644 man/getWeight-mcmcoutputbase-method.Rd create mode 100644 man/getWeight-model-method.Rd create mode 100644 man/getWeight-prior-method.Rd create mode 100644 man/getWeight.Rd create mode 100644 man/getWeightperm-mcmcpermind-method.Rd create mode 100644 man/getWeightperm.Rd create mode 100644 man/getY-fdata-method.Rd create mode 100644 man/getY.Rd create mode 100644 man/getZero-ddatamoments-method.Rd create mode 100644 man/getZero-dmodelmoments-method.Rd create mode 100644 man/getZero.Rd create mode 100644 man/graphic_func.Rd create mode 100644 man/hasExp-fdata-method.Rd create mode 100644 man/hasExp.Rd create mode 100644 man/hasPar.Rd create mode 100644 man/hasPriorPar-prior-model-method.Rd create mode 100644 man/hasPriorPar.Rd create mode 100644 man/hasPriorWeight.Rd create mode 100644 man/hasS.Rd create mode 100644 man/hasT-fdata-method.Rd create mode 100644 man/hasT.Rd create mode 100644 man/hasWeight-model-method.Rd create mode 100644 man/hasWeight.Rd create mode 100644 man/hasY-fdata-method.Rd create mode 100644 man/hasY.Rd create mode 100644 man/initialize-binomialmodelmoments-method.Rd create mode 100644 man/initialize-cdatamoments-method.Rd create mode 100644 man/initialize-csdatamoments-method.Rd create mode 100644 man/initialize-ddatamoments-method.Rd create mode 100644 man/initialize-exponentialmodelmoments-method.Rd create mode 100644 man/initialize-groupmoments-method.Rd create mode 100644 man/initialize-normultmodelmoments-method.Rd create mode 100644 man/initialize-poissonmodelmoments-method.Rd create mode 100644 man/initialize-studentmodelmoments-method.Rd create mode 100644 man/initialize-studmultmodelmoments-method.Rd create mode 100644 man/mcmc-class.Rd create mode 100644 man/mcmcest-class.Rd create mode 100644 man/mcmcestfix-class.Rd create mode 100644 man/mcmcestind-class.Rd create mode 100644 man/mcmcextract-class.Rd create mode 100644 man/mcmcoutputfix-class.Rd create mode 100644 man/mcmcoutputfixhier-class.Rd create mode 100644 man/mcmcoutputfixhierpost-class.Rd create mode 100644 man/mcmcoutputfixpost-class.Rd create mode 100644 man/mcmcoutputpermhierpost-class.Rd create mode 100644 man/mcmcpermfixpost-class.Rd create mode 100644 man/mcmcpermind-class.Rd create mode 100644 man/mcmcpermindhier-class.Rd create mode 100644 man/mcmcpermindpost-class.Rd create mode 100644 man/mixturemar.Rd create mode 100644 man/model-class.Rd create mode 100644 man/moments-mcmcextract-method.Rd create mode 100644 man/moments-mcmcoutputfix-method.Rd create mode 100644 man/moments.Rd create mode 100644 man/normultmodelmoments-class.Rd create mode 100644 man/plot-fdata-missing-method.Rd create mode 100644 man/plotDens-generic.Rd create mode 100644 man/plotDens-mcmcoutputbase-method.Rd create mode 100644 man/plotDens-mcmcoutputfix-method.Rd create mode 100644 man/plotDens-mcmcoutputfixhier-method.Rd create mode 100644 man/plotDens-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotDens-mcmcoutputfixpost-method.Rd create mode 100644 man/plotDens-mcmcoutputhierpost-method.Rd create mode 100644 man/plotDens-mcmcoutputpermbase-method.Rd create mode 100644 man/plotDens-mcmcoutputpermfix-method.Rd create mode 100644 man/plotDens-mcmcoutputpermhier-method.Rd create mode 100644 man/plotDens-mcmcoutputpermhierpost-method.Rd create mode 100644 man/plotDens-mcmcoutputpermpost-method.Rd create mode 100644 man/plotDens-method.Rd create mode 100644 man/plotHist-generic.Rd create mode 100644 man/plotHist-mcmcoutputbase-method.Rd create mode 100644 man/plotHist-mcmcoutputfix-method.Rd create mode 100644 man/plotHist-mcmcoutputfixhier-method.Rd create mode 100644 man/plotHist-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotHist-mcmcoutputfixpost-method.Rd create mode 100644 man/plotHist-mcmcoutputhierpost-method.Rd create mode 100644 man/plotHist-mcmcoutputpermbase-method.Rd create mode 100644 man/plotHist-mcmcoutputpermfix-method.Rd create mode 100644 man/plotHist-mcmcoutputpermhier-method.Rd create mode 100644 man/plotHist-mcmcoutputpermhierpost-method.Rd create mode 100644 man/plotHist-mcmcoutputpermpost-method.Rd create mode 100644 man/plotHist-method.Rd create mode 100644 man/plotPointProc-generic.Rd create mode 100644 man/plotPointProc-mcmcoutputbase-method.Rd create mode 100644 man/plotPointProc-mcmcoutputfix-method.Rd create mode 100644 man/plotPointProc-mcmcoutputfixhier-method.Rd create mode 100644 man/plotPointProc-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputfixpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermbase-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermfix-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermhier-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermhierpost-method.Rd create mode 100644 man/plotPointProc-mcmcoutputpermpost-method.Rd create mode 100644 man/plotPointProc-method.Rd create mode 100644 man/plotPostDens-generic.Rd create mode 100644 man/plotPostDens-mcmcoutputbase-method.Rd create mode 100644 man/plotPostDens-mcmcoutputfix-method.Rd create mode 100644 man/plotPostDens-mcmcoutputfixhier-method.Rd create mode 100644 man/plotPostDens-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputfixpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputhier-method.Rd create mode 100644 man/plotPostDens-mcmcoutputhierpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermbase-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermfix-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermfixhier-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermhier-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermhierpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpermpost-method.Rd create mode 100644 man/plotPostDens-mcmcoutputpost-method.Rd create mode 100644 man/plotPostDens-method.Rd create mode 100644 man/plotSampRep-generic.Rd create mode 100644 man/plotSampRep-mcmcoutputbase-method.Rd create mode 100644 man/plotSampRep-mcmcoutputfix-method.Rd create mode 100644 man/plotSampRep-mcmcoutputfixhier-method.Rd create mode 100644 man/plotSampRep-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputfixpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermbase-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermfix-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermhier-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermhierpost-method.Rd create mode 100644 man/plotSampRep-mcmcoutputpermpost-method.Rd create mode 100644 man/plotSampRep-method.Rd create mode 100644 man/plotTraces-generic.Rd create mode 100644 man/plotTraces-mcmcoutputbase-method.Rd create mode 100644 man/plotTraces-mcmcoutputfix-method.Rd create mode 100644 man/plotTraces-mcmcoutputfixhier-method.Rd create mode 100644 man/plotTraces-mcmcoutputfixhierpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputfixpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputhierpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermbase-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermfix-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermhier-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermhierpost-method.Rd create mode 100644 man/plotTraces-mcmcoutputpermpost-method.Rd create mode 100644 man/plotTraces-method.Rd create mode 100644 man/poissonmodelmoments-class.Rd create mode 100644 man/sdatamoments-class.Rd create mode 100644 man/setBurnin-set-mcmc-method.Rd create mode 100644 man/setBurnin-set.Rd create mode 100644 man/setBycolumn-set-fdata-method.Rd create mode 100644 man/setBycolumn-set.Rd create mode 100644 man/setDist-set-model-method.Rd create mode 100644 man/setDist-set.Rd create mode 100644 man/setExp-set-fdata-method.Rd create mode 100644 man/setExp-set.Rd create mode 100644 man/setHier-set-prior-method.Rd create mode 100644 man/setHier-set.Rd create mode 100644 man/setIndicfix-set-model-method.Rd create mode 100644 man/setIndicfix-set.Rd create mode 100644 man/setIndicmod-set-model-method.Rd create mode 100644 man/setIndicmod-set.Rd create mode 100644 man/setK-set-model-method.Rd create mode 100644 man/setK-set.Rd create mode 100644 man/setM-set-mcmc-method.Rd create mode 100644 man/setM-set.Rd create mode 100644 man/setN-set-fdata-method.Rd create mode 100644 man/setN-set.Rd create mode 100644 man/setName-set-fdata-method.Rd create mode 100644 man/setName-set.Rd create mode 100644 man/setPar-set-model-method.Rd create mode 100644 man/setPar-set-prior-method.Rd create mode 100644 man/setPar-set.Rd create mode 100644 man/setR-set-fdata-method.Rd create mode 100644 man/setR-set-model-method.Rd create mode 100644 man/setR-set.Rd create mode 100644 man/setRanperm-set-mcmc-method.Rd create mode 100644 man/setRanperm-set.Rd create mode 100644 man/setS-set-fdata-method.Rd create mode 100644 man/setS-set.Rd create mode 100644 man/setSim-set-fdata-method.Rd create mode 100644 man/setSim-set.Rd create mode 100644 man/setStartpar-set-mcmc-method.Rd create mode 100644 man/setStartpar-set.Rd create mode 100644 man/setStoreS-set-mcmc-method.Rd create mode 100644 man/setStoreS-set.Rd create mode 100644 man/setStorepost-set-mcmc-method.Rd create mode 100644 man/setStorepost-set.Rd create mode 100644 man/setT-set-fdata-method.Rd create mode 100644 man/setT-set-model-method.Rd create mode 100644 man/setT-set.Rd create mode 100644 man/setType-set-fdata-method.Rd create mode 100644 man/setType-set-prior-method.Rd create mode 100644 man/setType-set.Rd create mode 100644 man/setWeight-set-model-method.Rd create mode 100644 man/setWeight-set-prior-method.Rd create mode 100644 man/setWeight-set.Rd create mode 100644 man/setY-set-fdata-method.Rd create mode 100644 man/setY-set.Rd create mode 100644 man/show-binomialmodelmoments-method.Rd create mode 100644 man/show-cdatamoments-method.Rd create mode 100644 man/show-csdatamoments-method.Rd create mode 100644 man/show-dataclass-method.Rd create mode 100644 man/show-ddatamoments-method.Rd create mode 100644 man/show-exponentialmodelmoments-method.Rd create mode 100644 man/show-fdata-method.Rd create mode 100644 man/show-groupmoments-method.Rd create mode 100644 man/show-mcmc-method.Rd create mode 100644 man/show-mcmcestfix-method.Rd create mode 100644 man/show-mcmcestind-method.Rd create mode 100644 man/show-mcmcoutputbase-method.Rd create mode 100644 man/show-mcmcoutputfix-method.Rd create mode 100644 man/show-mcmcoutputfixhier-method.Rd create mode 100644 man/show-mcmcoutputfixhierpost-method.Rd create mode 100644 man/show-mcmcoutputfixpost-method.Rd create mode 100644 man/show-mcmcoutputhier-method.Rd create mode 100644 man/show-mcmcoutputhierpost-method.Rd create mode 100644 man/show-mcmcoutputpermbase-method.Rd create mode 100644 man/show-mcmcoutputpermfix-method.Rd create mode 100644 man/show-mcmcoutputpermfixhier-method.Rd create mode 100644 man/show-mcmcoutputpermfixhierpost-method.Rd create mode 100644 man/show-mcmcoutputpermfixpost-method.Rd create mode 100644 man/show-mcmcoutputpermhierpost-method.Rd create mode 100644 man/show-mcmcoutputpost-method.Rd create mode 100644 man/show-normalmodelmoments-method.Rd create mode 100644 man/show-normultmodelmoments-method.Rd create mode 100644 man/show-poissonmodelmoments-method.Rd create mode 100644 man/show-prior-method.Rd create mode 100644 man/show-sdatamoments-method.Rd create mode 100644 man/show-studentmodelmoments-method.Rd create mode 100644 man/show-studmultmodelmoments-method.Rd create mode 100644 man/simulate-model-method.Rd create mode 100644 man/simulate.Rd create mode 100644 man/studentmodelmoments-class.Rd create mode 100644 man/studmultmodelmoments-class.Rd create mode 100644 man/subseq-generic.Rd create mode 100644 man/subseq-mcmcoutputbase-array-method.Rd create mode 100644 man/subseq-mcmcoutputfix-array-method.Rd create mode 100644 man/subseq-mcmcoutputfixhier-array-method.Rd create mode 100644 man/subseq-mcmcoutputfixhierpost-array-method.Rd create mode 100644 man/subseq-mcmcoutputfixpost-array-method.Rd create mode 100644 man/subseq-mcmcoutputhier-array-method.Rd create mode 100644 man/subseq-mcmcoutputhierpost-array-method.Rd create mode 100644 man/subseq-mcmcoutputpost-array-method.Rd create mode 100644 man/subseq-method.Rd create mode 100644 man/swapElements-generic.Rd create mode 100644 man/swapElements-mcmcoutputbase-array-method.Rd create mode 100644 man/swapElements-mcmcoutputfix-array-method.Rd create mode 100644 man/swapElements-mcmcoutputfixhier-array-method.Rd create mode 100644 man/swapElements-mcmcoutputfixhierpost-array-method.Rd create mode 100644 man/swapElements-mcmcoutputfixpost-array-method.Rd create mode 100644 man/swapElements-mcmcoutputhier-array-method.Rd create mode 100644 man/swapElements-mcmcoutputhierpost-array-method.Rd create mode 100644 man/swapElements-mcmcoutputpost-array-method.Rd create mode 100644 man/swapElements-method.Rd diff --git a/.gitignore b/.gitignore index fae8299..c81469f 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,12 @@ # Example code in package build process *-Ex.R +# Object files from R CMD INSTALL +*.o + +# Shared libraries from R CMD INSTALL +*.so + # Output files from R CMD build /*.tar.gz diff --git a/R/RcppExports.R b/R/RcppExports.R index 6b6ef91..17c6e7b 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -34,7 +34,7 @@ swap_cc <- function(values, index) { #' @param values An array of dimension `M x r x K` of values to swap. #' @param index An integer matrix of dimension `M x K`. containing the scheme #' by which values should be swapped. -#' @param A three-dimensional array with swapped values. +#' @return A three-dimensional array with swapped values. #' @export #' #' @examples @@ -280,7 +280,7 @@ permmoments_cc <- function(classS4) { #' density parameters. See for more information on mixin layers Smaragdakis #' and Butory (1998). #' -#' @param data_S4 An `fdata` object storing the observations and indicators. +#' @param fdata_S4 An `fdata` object storing the observations and indicators. #' @param model_S4 A `model` object specifying the Binomial finite mixture #' model. #' @param prior_S4 A `prior` object specifying the prior distribution for MCMC @@ -720,12 +720,11 @@ stephens1997b_poisson_cc <- function(values, comp_par, weight_par, max_iter = 20 #' Stephens (1997b) for MCMC samples of a Binomial mixture distribution. #' #' @param values A matrix of observations of dimension `Nx1`. +#' @param reps A vector containing the repetitions. #' @param comp_par An array of component parameter samples from MCMC sampling. #' Dimension is `MxK`. -#' @param weight An array of weight parameter samples from MCMC sampling. +#' @param weight_par An array of weight parameter samples from MCMC sampling. #' Dimension is `MxK`. -#' @param max_iter A signed integer specifying the number of iterations to be -#' run in optimization. Unused. #' @return An integer matrix of dimension `MxK` that holding the optimal #' labeling. #' @export diff --git a/R/datamoments.R b/R/datamoments.R index f1ea0f5..37fc12a 100644 --- a/R/datamoments.R +++ b/R/datamoments.R @@ -25,14 +25,14 @@ #' @slot mean A numeric storing the mean of the slot `y` in the `fdata` object. #' @slot var A matrix storing the variance(s and covariances) of the `y` slot #' in the `fdata` object. -#' @slot VIRTUAL Virtual class containing further data moments. +#' @slot fdata An `fdata` object containing the observations and possible +#' indicators. #' @exportClass datamoments #' @rdname datamoments-class #' @seealso #' * [cdatamoments-class] for data moments of continuous data #' * [ddatamoments-class] for data moments of discrete data #' * [sdatamoments-class] for data moments of the indicators -#' .datamoments <- setClass( "datamoments", representation( diff --git a/R/mcmcestind.R b/R/mcmcestind.R index 0f6d59b..4806afc 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -215,7 +215,10 @@ setMethod( #' Note, this method is so far only implemented for mixtures of Poisson #' distributions. #' -#' @param object An `mcmcestind` object. +#' @param x An `mcmcestind` object. +#' @param ... (Not used) Further arguments to pass to called functions. +#' @param na.rm (Not used) A logical indicating, if `NA` values should be +#' removed in calculating statistics. #' @returns A console output listing the formatted slots and summary #' information about each of them. #' @exportMethod Summary diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index 4b97366..ce3dc93 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -684,7 +684,7 @@ setMethod( #' models as the last indicator of this observation. This slot is only #' available for models with unknown indicators. #' @slot Sperm An `array` of dimension `N x storeS` containing the last -#' `storeS` permuted indicators. `storeS` is defined in the slot `@@storeS` +#' `storeS` permuted indicators. `storeS` is defined in the slot `storeS` #' of the `mcmc` object passed into [mixturemcmc()]. This slot is only #' available for models with unknown indicators. #' @slot NKperm An `array` of dimension `Mperm x K` containing the numbers diff --git a/R/mcmcpermute.R b/R/mcmcpermute.R index 2407a53..e0c7048 100644 --- a/R/mcmcpermute.R +++ b/R/mcmcpermute.R @@ -45,6 +45,18 @@ #' `mcmcoutputperm` and carries the samples and statistics (like #' log-likelihood values) of the permuted samples. #' +#' @param mcmcout An `mcmcoutput` object containing the MCMC samples. +#' @param fdata An `fdata` object containing the observations and in case of +#' fixed indicator models the indicators. This argument is optional for +#' relabeling with the `"kmeans"` or `"Stephens1997a"` methods, but mandatory +#' for relabeling with `Stephens1997b"`. +#' @param method A character indicating which relabeling method should be used. +#' The relabeling method `"kmeans"` is the default. `"Stephens1997a"` and +#' `"Stephens1997b"` are only available for mixtures of Poisson or Binomial +#' distributions. +#' @param opt_ctrl (Deprecated) A list containing hyperparameters for +#' optimization with the `"Stephens1997a"` relabeling algorithm. +#' @return An `mcmcoutputperm` object containing the relabeld MCMC samples. #' @export mcmcpermute #' @import nloptr #' diff --git a/R/mincol.R b/R/mincol.R index c092f1e..3a164fd 100644 --- a/R/mincol.R +++ b/R/mincol.R @@ -50,7 +50,7 @@ #' form. If the covariance matrices are needed for calculations this function #' helps to restore these matrices from the storage vectors. #' -#' @param q A matrix or array of vectors of dimension `r(r+1)/2x1`. +#' @param m A matrix or array of vectors of dimension `r(r+1)/2x1`. #' @return An array of symmetric matrices, all of dimension `rxr`. #' @export #' @@ -82,7 +82,7 @@ #' calculations the functions [qinmatr()] and [qinmatrmult()] helps to restore #' these matrices from the storage vectors. #' -#' @param q A symmetric matrix or dimension `rxr`. +#' @param m A symmetric matrix or dimension `rxr`. #' @return A vector of length `r(r+1)/2`. #' @export #' @@ -117,13 +117,13 @@ #' `rxr` converts these matrices into an array of vectors with length #' `r(r+1)/2`. This function is used to handle the MCMC sampling output from #' multivariate finite mixture models. To save storage the symmetric -#' variance-covariance matrices of multivariate mixtures are stored vector +#' variance-covariance matrices of multivariate mixtures are stored in vector #' form. If the covariance matrices are needed for calculations the functions #' [qinmatr()] and [qinmatrmult()] helps to restore these matrices from the #' storage vectors. #' -#' @param q A symmetric matrix or dimension `rxr`. -#' @return A vector of length `r(r+1)/2`. +#' @param a An array of symmetric matrices or dimension `rxrxK`. +#' @return A matrix of dimension `r(r+1)/2xK`. #' @export #' #' @examples diff --git a/R/model.R b/R/model.R index 0716cde..ad36f73 100644 --- a/R/model.R +++ b/R/model.R @@ -279,7 +279,7 @@ setMethod( #' #' \code{hasPar} checks if the model has parameters defined. #' -#' @param model An S4 model object. +#' @param object An S4 model object. #' @param verbose A logical indicating, if the function should give a print out. #' @return A matrix with repetitions. Can be empty, if no repetitions are set. #' @exportMethod hasPar @@ -354,7 +354,9 @@ setMethod( #' @param x An S4 model object. Must have specified parameters and weights. #' @param y Unused. #' @param dev A logical indicating, if the plot should be shown in a graphical -#' device. Set to \code{FALSE}, if plotted to a file. +#' device. Set to \code{FALSE}, if plotted to a file. +#' @param ... Arguments to be passed to methods, such as graphical parameters +#' (see par). #' @return Density or barplot of the S4 model object. #' @exportMethod plot #' @@ -362,7 +364,9 @@ setMethod( #' plot(f_model) #' } #' -#' @seealso \code{model} +#' @seealso +#' * [model-class] for the class definition +#' * [model()] for the class constructor setMethod( "plot", "model", function(x, y, dev = TRUE, ...) { @@ -389,15 +393,16 @@ setMethod( } ) -#' Plots point process. +#' Plots the point process of a finite model #' #' \code{plotPointProc} plots the point process of an S4 model object that #' defines a finite mixture model. Only available for Poisson mixtures so far. #' -#' @param x An S4 model object with defined parameters and weigths. -#' @param y Unused. +#' @param x An S4 model object with defined parameters and weights. #' @param dev A logical indicating, if the plot should be shown in a graphical -#' device. Set to \code{FALSE}, if plotted to a file. +#' device. Set to \code{FALSE}, if plotted to a file. +#' @param ... Arguments to be passed to methods, such as graphical parameters +#' (see [par]). #' @return A scatter plot of weighted parameters. #' @exportMethod plotPointProc #' @@ -820,8 +825,10 @@ setReplaceMethod( #' @examples #' # Generate an default mixture model. #' f_model <- model() +#' # Set the number of components to two. +#' setK(f_model) <- 2 #' # Set the slot. -#' setPar(f_model) <- 2 +#' setPar(f_model) <- list(lambda=c(0.2, 0.7)) #' #' @seealso #' * [model-class] for the class definition @@ -900,7 +907,7 @@ setReplaceMethod( #' # Generate an default mixture model. #' f_model <- model() #' # Set the slot. -#' setT(f_model) <- matrix(4) +#' setT(f_model) <- as.integer(4) #' #' @seealso #' * [model-class] for the class definition diff --git a/R/prior.R b/R/prior.R index 82a80a6..a7122d1 100644 --- a/R/prior.R +++ b/R/prior.R @@ -79,17 +79,18 @@ #' that specifies a data dependent prior. See [priordefine()] for this advanced #' constructor. #' -#' @slot weight A matrix storing the prior parameters for the `weight` of a +#' @param weight A matrix storing the prior parameters for the `weight` of a #' finite mixture model. -#' @slot par A list storing the prior parameters for the parameters of a finite +#' @param par A list storing the prior parameters for the parameters of a finite #' mixture model. -#' @slot type A character specifying what type of prior should be used in +#' @param type A character specifying what type of prior should be used in #' Bayesian estimation. Either `"independent"` for an independent prior #' distribution or `"condconjugate"` for a conditionally conjugate prior #' distribution. -#' @slot hier A logical defining, if the used prior should be hierarchical. +#' @param hier A logical defining, if the used prior should be hierarchical. #' Hierarchical prior are often more robust, but need an additional layer in #' sampling, so computing costs increase. +#' @return A `prior` object with the specified slots. #' @export #' @name prior #' @@ -102,7 +103,8 @@ #' * [priordefine()] for the advanced constructor of this class #' #' @references -#' * Fr\"uhwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" +#' * Fr\"uhwirth-Schnatter, S (2006), +#' "Finite Mixture and Markov Switching Models" "prior" <- function(weight = matrix(), par = list(), type = c("independent", "condconjugate"), hier = TRUE) { diff --git a/R/studmultmodelmoments.R b/R/studmultmodelmoments.R index 6889b08..548f138 100644 --- a/R/studmultmodelmoments.R +++ b/R/studmultmodelmoments.R @@ -23,7 +23,11 @@ #' #' @slot B A numeric defining the between-group heterogeneity. #' @slot W A numeric defining the within-group heterogeneity. -#' @slot R A numeric defining the coefficient of determination. +#' @slot Rdet A numeric defining the coefficient of determination based on the +#' determinant of the covariance matrix. +#' @slot Rtr A numeric defining the coefficient of determination based on the +#' trace of the covariance matrix. +#' @slot corr A `matrix` storing the correlation matrix. #' @exportClass studmultmodelmoments #' @name studmultmodelmoments-class #' diff --git a/man/Summary-mcmcestfix-method.Rd b/man/Summary-mcmcestfix-method.Rd new file mode 100644 index 0000000..a16a745 --- /dev/null +++ b/man/Summary-mcmcestfix-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{Summary,mcmcestfix-method} +\alias{Summary,mcmcestfix-method} +\title{Shows an advanced summary of an \code{mcmcestfix} object.} +\usage{ +\S4method{Summary}{mcmcestfix}(x, ..., na.rm = FALSE) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +A console output listing the formatted slots and summary +information about each of them. +} +\description{ +Calling \code{\link[=Summary]{Summary()}} on an \code{mcmcestfix} object gives an advanced overview +of the \code{mcmcestfix} object. +} +\details{ +Note, this method is so far only implemented for mixtures of Poisson +distributions. +} +\keyword{internal} diff --git a/man/Summary-mcmcestind-method.Rd b/man/Summary-mcmcestind-method.Rd index 828e960..a9b76e4 100644 --- a/man/Summary-mcmcestind-method.Rd +++ b/man/Summary-mcmcestind-method.Rd @@ -7,7 +7,12 @@ \S4method{Summary}{mcmcestind}(x, ..., na.rm = FALSE) } \arguments{ -\item{object}{An \code{mcmcestind} object.} +\item{x}{An \code{mcmcestind} object.} + +\item{...}{(Not used) Further arguments to pass to called functions.} + +\item{na.rm}{(Not used) A logical indicating, if \code{NA} values should be +removed in calculating statistics.} } \value{ A console output listing the formatted slots and summary diff --git a/man/cdatamoments-class.Rd b/man/cdatamoments-class.Rd new file mode 100644 index 0000000..06ac587 --- /dev/null +++ b/man/cdatamoments-class.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\docType{class} +\name{cdatamoments-class} +\alias{cdatamoments-class} +\alias{.cdatamoments} +\title{Finmix \code{cdatamoments} class} +\description{ +Stores moments of an \linkS4class{fdata} object containing continuous data. +The \code{fdata} object is stored in the parent \linkS4class{datamoments} +class. +} +\section{Slots}{ + +\describe{ +\item{\code{higher}}{An array containing the four higher centralized moments of the +continuous data stored in the \code{fdata} object.} + +\item{\code{skewness}}{A vector storing the skewness of the continuous data in the +corresponding \code{fdata} object.} + +\item{\code{kurtosis}}{A vector storing the kurtosis of the continuous data in the +corresponding \code{fdata} object.} + +\item{\code{corr}}{A matrix containing the correlations between the data dimensions +in case of multivariate data (i.e. slot \code{r} in the \code{fdata} object is +larger than one).} + +\item{\code{smoments}}{A \code{csdatamoments} object, if the \code{fdata} object also holds +indicators. \code{NULL}, if no indicators are present in the \code{fdata} object.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the parent class +\item \linkS4class{ddatamoments} for the corresponding class for +discrete data +\item \linkS4class{csdatamoments} for the contained class if indicators +are present in the \code{fdata} object +} +} +\keyword{internal} diff --git a/man/cmodelmoments-class.Rd b/man/cmodelmoments-class.Rd new file mode 100644 index 0000000..7787e68 --- /dev/null +++ b/man/cmodelmoments-class.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmodelmoments.R +\docType{class} +\name{cmodelmoments-class} +\alias{cmodelmoments-class} +\alias{.cmodelmoments} +\title{Finmix \code{cmodelmoments} class} +\description{ +This class defines the general theoretical moments of a finite mixture model +with continuous data. +} +\section{Slots}{ + +\describe{ +\item{\code{higher}}{An array containing the four higher centralized moments of the +(in case of multivariate data marginal) finite mixture.} + +\item{\code{skewness}}{A vector containing the skewness(es) of the finite mixture +model.} + +\item{\code{kurtosis}}{A vector containing the kurtosis(es) of the finite mixture +model.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of any \code{modelmoments} inherited class +} +} diff --git a/man/csdatamomentsOrNULL-class.Rd b/man/csdatamomentsOrNULL-class.Rd new file mode 100644 index 0000000..8ba5e6b --- /dev/null +++ b/man/csdatamomentsOrNULL-class.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\docType{class} +\name{csdatamomentsOrNULL-class} +\alias{csdatamomentsOrNULL-class} +\title{Finmix class union of \code{csdatamoments} and \code{NULL}} +\description{ +Defines a class union such that the object held by a child class can also +be \code{NULL}. +} +\keyword{internal} diff --git a/man/dataclass-class.Rd b/man/dataclass-class.Rd new file mode 100644 index 0000000..8a03985 --- /dev/null +++ b/man/dataclass-class.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\docType{class} +\name{dataclass-class} +\alias{dataclass-class} +\alias{.dataclass} +\title{Finmix \code{dataclass} class} +\description{ +Stores objects to classify observations using a fully specified mixture +model. If the indicators are known a finite mixture model is fully specified +as then the likelihood can be calculated for each observation depending on +the component it stems from. +} +\section{Slots}{ + +\describe{ +\item{\code{logpy}}{An array containing the logarithmized} + +\item{\code{prob}}{An array storing the probability classification matrix that +defines for each observation the probability of belonging to component +\code{k}. Henceforth, each row sums to one. The dimension of this array is +\verb{N x K}.} + +\item{\code{mixlik}}{A numeric storing the logarithm of the mixture likelihood +evaluated at certain parameters \code{par} from a finmix \code{model} object and +corresponding \code{weights}.} + +\item{\code{entropy}}{A numeric storing the entropy of the classification.} + +\item{\code{loglikcd}}{An array storing the logarithm of the conditional likelihood +of each component parameter, if indicators have not been simulated. The +array has dimension \verb{1 x K}.} + +\item{\code{postS}}{A numeric storing the posterior probability of the indicators +\code{S} in the data, if indicators have been simulated.} +}} + +\references{ +Frühwirth-Schnatter, S. (2006), "Finite Mixture and Markov Switching Models" +} +\seealso{ +\itemize{ +\item \linkS4class{fdata} for the class holding the data +\item \linkS4class{model} for the class defining a finite mixture model +\item \code{\link[=dataclass]{dataclass()}} for the constructor of this class +} +} diff --git a/man/datamoments-class.Rd b/man/datamoments-class.Rd new file mode 100644 index 0000000..07c566d --- /dev/null +++ b/man/datamoments-class.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/datamoments.R +\docType{class} +\name{datamoments-class} +\alias{datamoments-class} +\alias{.datamoments} +\title{Finmix \code{datamoments} class} +\description{ +Stores moments of a corresponding \code{fdata} object. +} +\section{Slots}{ + +\describe{ +\item{\code{mean}}{A numeric storing the mean of the slot \code{y} in the \code{fdata} object.} + +\item{\code{var}}{A matrix storing the variance(s and covariances) of the \code{y} slot +in the \code{fdata} object.} + +\item{\code{fdata}}{An \code{fdata} object containing the observations and possible +indicators.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{cdatamoments} for data moments of continuous data +\item \linkS4class{ddatamoments} for data moments of discrete data +\item \linkS4class{sdatamoments} for data moments of the indicators +} +} diff --git a/man/ddatamoments-class.Rd b/man/ddatamoments-class.Rd new file mode 100644 index 0000000..6d1efc5 --- /dev/null +++ b/man/ddatamoments-class.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\docType{class} +\name{ddatamoments-class} +\alias{ddatamoments-class} +\alias{.ddatamoments} +\title{Finmix \code{ddatamoments} class} +\description{ +Stores moments of an \linkS4class{fdata} object containing discrete data. +The \code{fdata} object is stored in the parent \linkS4class{datamoments} +class. +} +\section{Slots}{ + +\describe{ +\item{\code{factorial}}{An array containing the first four factorial moments of the +discrete data stored in the \code{fdata} object.} + +\item{\code{over}}{A vector storing the overdispersion of the discrete data in the +corresponding \code{fdata} object.} + +\item{\code{zero}}{A vector storing the fractions of zeros in the observed data. <} + +\item{\code{smoments}}{An \code{sdatamoments} object, if the \code{fdata} object also holds +indicators. \code{NULL}, if no indicators are present in the \code{fdata} object.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the parent class +\item \linkS4class{ddatamoments} for the corresponding class for +continuous data +\item \linkS4class{sdatamoments} for the contained class if indicators +are present in the \code{fdata} object +} +} +\keyword{internal} diff --git a/man/dmodelmoments-class.Rd b/man/dmodelmoments-class.Rd new file mode 100644 index 0000000..4bf6998 --- /dev/null +++ b/man/dmodelmoments-class.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dmodelmoments.R +\docType{class} +\name{dmodelmoments-class} +\alias{dmodelmoments-class} +\alias{.dmodelmoments} +\title{Finmix \code{dmodelmoments} class} +\description{ +This class defines the general theoretical moments of a finite mixture model +with discrete data. +} +\section{Slots}{ + +\describe{ +\item{\code{over}}{A numeric containing the over-dispersion.} + +\item{\code{factorial}}{An array containing the first four factorial moments.} + +\item{\code{zero}}{An numeric cotaining the excess zeros.} +}} + +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of any \code{modelmoments} inherited class +} +} diff --git a/man/exponentialmodelmoments-class.Rd b/man/exponentialmodelmoments-class.Rd new file mode 100644 index 0000000..433a89e --- /dev/null +++ b/man/exponentialmodelmoments-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\docType{class} +\name{exponentialmodelmoments-class} +\alias{exponentialmodelmoments-class} +\alias{.exponentialmodelmoments} +\title{Finmix \code{exponentialmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of exponential +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/extract-mcmcoutputfix-numeric-method.Rd b/man/extract-mcmcoutputfix-numeric-method.Rd new file mode 100644 index 0000000..5229046 --- /dev/null +++ b/man/extract-mcmcoutputfix-numeric-method.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{extract,mcmcoutputfix,numeric-method} +\alias{extract,mcmcoutputfix,numeric-method} +\title{Extracts samples from \code{mcmcoutput} object of a multivariate Normal mixture} +\usage{ +\S4method{extract}{mcmcoutputfix,numeric}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object from MCMC sampling of a multivariate +Normal mixture model.} + +\item{index}{An numeric indicating which dimension of the multivariate +mixture should be extracted.} +} +\value{ +An object class \code{mcmcextract} containing all samples of an extracted +dimension. +} +\description{ +This function extracts samples from a multivariate Normal mixture output. +} +\keyword{internal} diff --git a/man/extract-method.Rd b/man/extract-method.Rd new file mode 100644 index 0000000..14bfacf --- /dev/null +++ b/man/extract-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{extract} +\alias{extract} +\title{Extracts single samples from a multivariate Normal mixture} +\arguments{ +\item{object}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing the MCMC +samples.} + +\item{index}{An \code{integer} specifying the dimension to extract.} +} +\value{ +An \code{mcmcextract} object containing the parameters, weights, and +metadata of the extracted dimension. +} +\description{ +Calling \code{\link[=extract]{extract()}} on an \code{mcmcoutput} object with a multivariate Normal +mixture model extracts single samples. +} +\details{ +This function simplifies the analysis of multivariate Normal mixtures that +come along with matrices instead of vectors for component parameters as it +extracts the mean matrix, the variance matrices and in addition the inverted +variance matrices with a single call. In additon, it enriches the output +object with metadata like the dimension of the data \code{r}, the number of +components \code{K}, and the distribution (in this case \verb{"normult}). +} +\examples{ +# Generate a multivariate Normal mixture model. +means <- matrix(c(1, 2, 2, 4), nrow = 2) +var1 <- matrix(c(1, 0.3, 0.3, 2), nrow=2) +var2 <- matrix(c(3, 0.3, 0.3, 6), nrow=2) +vars <- array(c(var1,var2), dim = c(2,2,2)) +f_model <- model(dist='normult', K = 2, r = 2, par = list(mu=means, sigma=vars)) +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Extract a single MCMC sample. +f_output1 <- extract(f_output, index = 1000) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the definition of the \code{mcmcoutput} class +\item \linkS4class{mcmcoutputperm} for the definition of the \code{mcmcoutputperm} class +\item \linkS4class{mcmcextract} for the output class +} +} diff --git a/man/extract.Rd b/man/extract.Rd new file mode 100644 index 0000000..61b4a2a --- /dev/null +++ b/man/extract.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{extract} +\alias{extract} +\title{Extracts the MCMC samples from a specific dimension of a multivariate model} +\usage{ +extract(object, index) +} +\description{ +Extracts the MCMC samples from a specific dimension of a multivariate model +} +\keyword{internal} diff --git a/man/fdata-class.Rd b/man/fdata-class.Rd new file mode 100644 index 0000000..d0be718 --- /dev/null +++ b/man/fdata-class.Rd @@ -0,0 +1,179 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\docType{class} +\name{fdata-class} +\alias{fdata-class} +\alias{.fdata} +\title{Finmix \code{fdata} class} +\description{ +The \code{fdata} class holds the data for finite mixture distributions. +} +\details{ +The \code{fdata} class defines an essential part of the \code{finmix} package and +MCMC sampling for finite mixture distributions. It stores the data for +finite mixture distributions which includes always the observations stored +in slot \code{y} and occasionally also known indicators in slot \code{S}. The latter +ones define either a so-called finite mixture model with \emph{fixed} indicators +or are used as starting indicators in MCMC sampling for a model with unknown +indicators. + +Observations can be stored in either in row or column format (default). In +the former case the slot \code{bycolumn} has to be set to \code{FALSE} to indicate the +safeguard functions in methods that the observations are stored in row +format. If indicators are stored in the \code{fdata} object they must be stored +in the same format as the observations. When using the setter \verb{setS()<-} +converting the repetitions to the right format is handled for the user. + +For discrete mixture models with Poisson or Exponential distributions +exposures can be added to the data (and model). Exposures scale the rate +parameters individually for each observation. Exposures get stored in the +slot \code{exp} and have to be either of dimension \code{Nx1} or of dimension \verb{1x1}. +Like observations and indicators, exposures also have to be provided in the +same data format, i.e. either row or column depending on the slot \code{bycolumn} +set to \code{FALSE} or \code{TRUE}. When using the setter \verb{setExp()<-} converting the +repetitions to the right format is handled for the user. + +For mixtures of binomial distributions it is possible to include repetitions +in the slot \code{T} of the \code{fdata} object. Repetitions can be constant or +varying. In the former case the dimension of slot \code{T} is \verb{1x1} and in the +latter one it is \code{Nx1}. Depending on the slot \code{bycolumn} the repetitions +have to be provided in row or column format. When using the setter +\verb{setT()<-} converting the repetitions to the right format is handled for the +user. + +For mixtures of multivariate data the slot \code{r} is larger than one. For all +other mixtures it is equal to one. Note that in case of multivariate mixture +models the data in slot \code{y} has to be of dimension \code{Nxr} or \code{rxN} depending +on the slot \code{bycolumn} set to \code{TRUE} or \code{FALSE}. +\subsection{Methods}{ + +There are a couple of methods that intend to simplify the handling of data +for the user. These methods are listed below. +\subsection{Show}{ +\itemize{ +\item \code{show()} gives a short summary of the object's slots. +} +} + +\subsection{Getters}{ +\itemize{ +\item \code{getY()} returns the \code{y} slot. +\item \code{getColY()} returns the \code{y} slot in column format independent of +\code{bycolumn}. +\item \code{getRowY()} returns the \code{y} slot in row format independent of \code{bycolumn}. +\item \code{getN()} returns the \code{N} slot. +\item \code{getr()} returns the \code{r} slot. +\item \code{getS()} returns the \code{S} slot. +\item \code{getColS()} returns the \code{S} slot in column format independent of +\code{bycolumn}. +\item \code{getRowS()} returns the \code{S} slot in row format independent of \code{bycolumn}. +\item \code{getBycolumn()} returns the \code{bycolumn} slot. +\item \code{getName()} returns the \code{name} slot. +\item \code{getType()} returns the \code{type} slot. +\item \code{getSim()} returns the \code{sim} slot. +\item \code{getExp()} returns the \code{exp} slot. +\item \code{getColExp()} returns the \code{y} slot in column format independent of +\code{bycolumn}. +\item \code{getRowExp()} returns the \code{y} slot in row format independent of \code{bycolumn}. +\item \code{getT()} returns the \code{T} slot. +\item \code{getColT()} returns the \code{T} slot in column format independent of +\code{bycolumn}. +\item \code{getRowT()} returns the \code{T} slot in row format independent of \code{bycolumn}. +} +} + +\subsection{Setters}{ + +All setters help the user to set the slots in the right format and with the +correct class (integer, matrix, etc.). It is internally checked, if the +new value fits the other slots of the object. +\itemize{ +\item \verb{setY()<-} sets the \code{y} slot. +\item \verb{setN()<-} sets the \code{N} slot. +\item \verb{setR()<-} sets the \code{r} slot. +\item \verb{setS()<-} sets the \code{S} slot. +\item \code{setBycolumn} sets the \code{bycolumn} slot. +\item \verb{setName()<-} sets the \code{name} slot. +\item \verb{setType()<-} sets the \code{type} slot. +\item \verb{setSim()<-} sets the \code{sim} slot. +\item \verb{setExp()<-} sets the \code{exp} slot. +\item \verb{setT()<-} sets the \code{T} slot. +} +} + +\subsection{Checking methods}{ + +The checking methods are provided to allow a user to integrate the \code{finmix} +classes more easily into a larger code basis. They check, if the slots are +available and return a \code{logical}. +\itemize{ +\item \code{hasY()} checks, if slot \code{y} is not empty. +\item \code{hasS()} checks, if slot \code{S} is not empty. +\item \code{hasExp()} checks, if the slot \code{exp} is not empty. +\item \code{hasT()} checks, if the slot \code{T} is not empty. +} +} + +\subsection{Plotting}{ + +The plotting function should help the user to get an impression of how the +data in the \code{fdata} object is distributed. This is important for evaluating +what kind of distribution to choose and how many mixture components to test +for. +\itemize{ +\item \code{plot(x, y, dev=TRUE, ...)} plots the observations in the \code{y} slot. If the +\code{type} is \code{"discrete"} a \code{\link[=barplot]{barplot()}} is shown. In the \code{"continuous"} case +the plot depends on the number of dimensions: if the dimension \code{r} of the +data is one, a \code{\link[=histogram]{histogram()}} shows the distribution of the observations. +In case of a two-dimensional data set, histograms of the marginal +distributions are plotted together with a scatter \code{\link[=plot]{plot()}} and a +two-dimensional kernel-density (see \code{\link[=bkde2D]{bkde2D()}}). In case of a multivariate +data set with more than two dimensions a \code{\link[=pairs]{pairs()}} plot is returned. The +argument \code{dev} should be put to \code{FALSE} if the output should be in a file. +\code{...} allows the user to pass further arguments to the internal functions. +} +} + +} +} +\section{Slots}{ + +\describe{ +\item{\code{y}}{A matrix containing the observations for finite mixture estimation. +Can be by column or row depending on the slot \code{bycolumn}.} + +\item{\code{N}}{An integer holding the number of observations.} + +\item{\code{r}}{An integer defining the dimension of the data. Only for multivariate +distributions like \code{normult} or \code{studmult} the dimension is +larger one.} + +\item{\code{S}}{A matrix containing the indicators of the data. If the \code{fdata} class +contains indicators estimation is performed with a fixed indicator +approach.} + +\item{\code{bycolumn}}{A logical indicating if the data in \code{y} and \code{S} is sorted by +by column (\code{TRUE}) or row (\code{FALSE}).} + +\item{\code{name}}{A character specifying a name for the data. Optional.} + +\item{\code{type}}{A character specifying the data type: either \code{discrete} for +discrete data or \code{continuous} for continuous data. The two data types are +treated differently when calculating data moments.} + +\item{\code{sim}}{A logical indicating, if the data was simulated.} + +\item{\code{exp}}{A matrix containing the \emph{exposures} of Poisson data.} + +\item{\code{T}}{A matrix containing the (optional) repetitions of binomial or Poisson +data. Must be of type integer.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=fdata]{fdata()}} for the class constructor +\item \linkS4class{model} for the class from which data can be simulated +\item \code{\link[=simulate]{simulate()}} for the method of the \code{model} class simulating data from a +finite mixture model +} +} diff --git a/man/generateMoments-binomialmodelmoments-method.Rd b/man/generateMoments-binomialmodelmoments-method.Rd new file mode 100644 index 0000000..ead76ee --- /dev/null +++ b/man/generateMoments-binomialmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/binomialmodelmoments.R +\name{generateMoments,binomialmodelmoments-method} +\alias{generateMoments,binomialmodelmoments-method} +\title{Generate moments for binomial mixture} +\usage{ +\S4method{generateMoments}{binomialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{binomialmodelmoments} object.} +} +\value{ +An \code{binomialmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +binomial mixture distribution. +} +\keyword{internal} diff --git a/man/generateMoments-cdatamoments-method.Rd b/man/generateMoments-cdatamoments-method.Rd new file mode 100644 index 0000000..4764640 --- /dev/null +++ b/man/generateMoments-cdatamoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{generateMoments,cdatamoments-method} +\alias{generateMoments,cdatamoments-method} +\title{Generate moments for continuous data.} +\usage{ +\S4method{generateMoments}{cdatamoments}(object) +} +\arguments{ +\item{object}{An \code{cdatamoments} object.} +} +\value{ +An \code{cdatamoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of a +finite mixture with continuous data. +} +\keyword{internal} diff --git a/man/generateMoments-csdatamoments-method.Rd b/man/generateMoments-csdatamoments-method.Rd new file mode 100644 index 0000000..25a5e6f --- /dev/null +++ b/man/generateMoments-csdatamoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{generateMoments,csdatamoments-method} +\alias{generateMoments,csdatamoments-method} +\title{Generate moments for indicators from a mixture with continuous data} +\usage{ +\S4method{generateMoments}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +An \code{csdatamoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of a +finite mixture with continuous data. +} +\keyword{internal} diff --git a/man/generateMoments-ddatamoments-method.Rd b/man/generateMoments-ddatamoments-method.Rd new file mode 100644 index 0000000..11922c7 --- /dev/null +++ b/man/generateMoments-ddatamoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{generateMoments,ddatamoments-method} +\alias{generateMoments,ddatamoments-method} +\title{Generate moments for continuous data.} +\usage{ +\S4method{generateMoments}{ddatamoments}(object) +} +\arguments{ +\item{object}{An \code{ddatamoments} object.} +} +\value{ +An \code{ddatamoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of a +finite mixture with continuous data. +} +\keyword{internal} diff --git a/man/generateMoments-exponentialmodelmoments-method.Rd b/man/generateMoments-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..0a061f1 --- /dev/null +++ b/man/generateMoments-exponentialmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{generateMoments,exponentialmodelmoments-method} +\alias{generateMoments,exponentialmodelmoments-method} +\title{Generate moments for exponential mixture} +\usage{ +\S4method{generateMoments}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +An \code{exponentialmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +exponential mixture distribution. +} +\keyword{internal} diff --git a/man/generateMoments-groupmoments-method.Rd b/man/generateMoments-groupmoments-method.Rd new file mode 100644 index 0000000..aa9f524 --- /dev/null +++ b/man/generateMoments-groupmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{generateMoments,groupmoments-method} +\alias{generateMoments,groupmoments-method} +\title{Generate moments} +\usage{ +\S4method{generateMoments}{groupmoments}(object) +} +\arguments{ +\item{object}{A \code{groupmoments} object.} +} +\value{ +An \code{groupmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of a +finite mixture with continuous data. +} +\keyword{internal} diff --git a/man/generateMoments-normultmodelmoments-method.Rd b/man/generateMoments-normultmodelmoments-method.Rd new file mode 100644 index 0000000..20ac5f4 --- /dev/null +++ b/man/generateMoments-normultmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{generateMoments,normultmodelmoments-method} +\alias{generateMoments,normultmodelmoments-method} +\title{Generate moments for normult mixture} +\usage{ +\S4method{generateMoments}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +An \code{normultmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +normult mixture distribution. +} +\keyword{internal} diff --git a/man/generateMoments-poissonmodelmoments-method.Rd b/man/generateMoments-poissonmodelmoments-method.Rd new file mode 100644 index 0000000..c6a7b70 --- /dev/null +++ b/man/generateMoments-poissonmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poissonmodelmoments.R +\name{generateMoments,poissonmodelmoments-method} +\alias{generateMoments,poissonmodelmoments-method} +\title{Generate moments for poisson mixture} +\usage{ +\S4method{generateMoments}{poissonmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{poissonmodelmoments} object.} +} +\value{ +An \code{poissonmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +poisson mixture distribution. +} +\keyword{internal} diff --git a/man/generateMoments-studentmodelmoments-method.Rd b/man/generateMoments-studentmodelmoments-method.Rd new file mode 100644 index 0000000..734128a --- /dev/null +++ b/man/generateMoments-studentmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{generateMoments,studentmodelmoments-method} +\alias{generateMoments,studentmodelmoments-method} +\title{Generate moments for student mixture} +\usage{ +\S4method{generateMoments}{studentmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studentmodelmoments} object.} +} +\value{ +An \code{studentmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +student mixture distribution. +} +\keyword{internal} diff --git a/man/generateMoments-studmultmodelmoments-method.Rd b/man/generateMoments-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..af9dcb6 --- /dev/null +++ b/man/generateMoments-studmultmodelmoments-method.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{generateMoments,studmultmodelmoments-method} +\alias{generateMoments,studmultmodelmoments-method} +\title{Generate moments for studmult mixture} +\usage{ +\S4method{generateMoments}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +An \code{studmultmodelmoments} object with calculated moments. +} +\description{ +Implicit method. Calling \code{\link[=generateMoments]{generateMoments()}} generates the moments of an +studmult mixture distribution. +} +\keyword{internal} diff --git a/man/generateMoments.Rd b/man/generateMoments.Rd new file mode 100644 index 0000000..85e182a --- /dev/null +++ b/man/generateMoments.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{generateMoments} +\alias{generateMoments} +\title{Generates the moments of a finite mixture model} +\usage{ +generateMoments(object) +} +\description{ +Generates the moments of a finite mixture model +} +\keyword{internal} diff --git a/man/generatePrior.Rd b/man/generatePrior.Rd new file mode 100644 index 0000000..551fa33 --- /dev/null +++ b/man/generatePrior.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/prior.R +\docType{methods} +\name{generatePrior} +\alias{generatePrior} +\alias{generatePrior,prior-method} +\title{Generates the prior for a specific \code{model}} +\usage{ +generatePrior(object, ...) + +\S4method{generatePrior}{prior}(object, fdata, model, varargin, prior.wagner, s) +} +\arguments{ +\item{object}{A \code{prior} object to store the prior parameters and weights.} + +\item{fdata}{An \code{fdata} object holding the data. Observations in slot \verb{@y} +must be existent.} + +\item{model}{A \code{model} object specifying the finite mixture model.} + +\item{varargin}{\code{NULL} or a \code{prior} object. This enables the user to pass in +an already constructed prior object that gets then completed.} + +\item{prior.wagner}{A logical indicating, if the prior from Wagner (2007) +should be used in case of an exponential mixture model.} + +\item{s}{A numeric specifying the standard deviation \code{s} for the +Metropolis-Hastings proposal.} +} +\description{ +Calling \code{generatePrior()} generates the \code{prior} object when \code{\link[=priordefine]{priordefine()}} +had been called. When this function is called all checks have been passed +and \code{prior} construction can take place. +} +\seealso{ +\itemize{ +\item \linkS4class{prior} for the class definition +\item \code{\link[=priordefine]{priordefine()}} for the advanced class constructor using this method +} +} +\keyword{internal} diff --git a/man/getB-csdatamoments-method.Rd b/man/getB-csdatamoments-method.Rd new file mode 100644 index 0000000..f04d28a --- /dev/null +++ b/man/getB-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getB,csdatamoments-method} +\alias{getB,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getB}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getB(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getB-exponentialmodelmoments-method.Rd b/man/getB-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..73e4a1e --- /dev/null +++ b/man/getB-exponentialmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{getB,exponentialmodelmoments-method} +\alias{getB,exponentialmodelmoments-method} +\title{Getter method of \code{exponentialmodelmoments} class.} +\usage{ +\S4method{getB}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getB(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getB-normalmodelmoments-method.Rd b/man/getB-normalmodelmoments-method.Rd new file mode 100644 index 0000000..e8cfe46 --- /dev/null +++ b/man/getB-normalmodelmoments-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{getB,normalmodelmoments-method} +\alias{getB,normalmodelmoments-method} +\title{Getter method of \code{normalmodelmoments} class.} +\usage{ +\S4method{getB}{normalmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\examples{ +f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +means <- c(-2, 2) +sigmas <- matrix(c(2, 4), nrow=1) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getB(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getB-normultmodelmoments-method.Rd b/man/getB-normultmodelmoments-method.Rd new file mode 100644 index 0000000..30f9855 --- /dev/null +++ b/man/getB-normultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{getB,normultmodelmoments-method} +\alias{getB,normultmodelmoments-method} +\title{Getter method of \code{normultmodelmoments} class.} +\usage{ +\S4method{getB}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\examples{ +f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getB(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getB-studentmodelmoments-method.Rd b/man/getB-studentmodelmoments-method.Rd new file mode 100644 index 0000000..e2b9678 --- /dev/null +++ b/man/getB-studentmodelmoments-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{getB,studentmodelmoments-method} +\alias{getB,studentmodelmoments-method} +\title{Getter method of \code{studentmodelmoments} class.} +\usage{ +\S4method{getB}{studentmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studentmodelmoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\examples{ +f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +means <- c(-2, 2) +sigmas <- matrix(c(2, 4), nrow=1) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(20, 40)) +f_moments <- modelmoments(f_model) +getB(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getB-studmultmodelmoments-method.Rd b/man/getB-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..5f7e659 --- /dev/null +++ b/man/getB-studmultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{getB,studmultmodelmoments-method} +\alias{getB,studmultmodelmoments-method} +\title{Getter method of \code{studmultmodelmoments} class.} +\usage{ +\S4method{getB}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +The \code{B} slot of the \code{object}. +} +\description{ +Returns the \code{B} slot. +} +\examples{ +f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +f_moments <- modelmoments(f_model) +getB(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getB.Rd b/man/getB.Rd new file mode 100644 index 0000000..dbd0138 --- /dev/null +++ b/man/getB.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getB} +\alias{getB} +\title{Getter for the \code{B} slot.} +\usage{ +getB(object) +} +\description{ +Getter for the \code{B} slot. +} +\keyword{internal} diff --git a/man/getBml-mcmcestfix-method.Rd b/man/getBml-mcmcestfix-method.Rd new file mode 100644 index 0000000..3433af3 --- /dev/null +++ b/man/getBml-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getBml,mcmcestfix-method} +\alias{getBml,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getBml}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{bml} slot of the \code{object}. +} +\description{ +Returns the \code{bml} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getBml(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getBml.Rd b/man/getBml.Rd new file mode 100644 index 0000000..55f78b0 --- /dev/null +++ b/man/getBml.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getBml} +\alias{getBml} +\title{Getter for the \code{bml} slot} +\usage{ +getBml(object) +} +\description{ +Getter for the \code{bml} slot +} +\keyword{internal} diff --git a/man/getBurnin-mcmc-method.Rd b/man/getBurnin-mcmc-method.Rd new file mode 100644 index 0000000..1b77419 --- /dev/null +++ b/man/getBurnin-mcmc-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{getBurnin,mcmc-method} +\alias{getBurnin,mcmc-method} +\title{Getter method of \code{mcmc} class.} +\usage{ +\S4method{getBurnin}{mcmc}(object) +} +\arguments{ +\item{object}{An \code{mcmc} object.} +} +\value{ +The \code{burnin} slot of the \code{object}. +} +\description{ +Returns the \code{burnin} slot. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Get the slot +getBurnin(f_mcmc) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/getBurnin-mcmcestfix-method.Rd b/man/getBurnin-mcmcestfix-method.Rd new file mode 100644 index 0000000..f21f9d3 --- /dev/null +++ b/man/getBurnin-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getBurnin,mcmcestfix-method} +\alias{getBurnin,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getBurnin}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{burnin} slot of the \code{object}. +} +\description{ +Returns the \code{burnin} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getBurnin(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getBurnin-mcmcoutputfix-method.Rd b/man/getBurnin-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..7965379 --- /dev/null +++ b/man/getBurnin-mcmcoutputfix-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getBurnin,mcmcoutputfix-method} +\alias{getBurnin,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getBurnin}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{burnin} slot of the \code{object}. +} +\description{ +Returns the \code{burnin} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getBurnin(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getBurnin.Rd b/man/getBurnin.Rd new file mode 100644 index 0000000..8ef0a96 --- /dev/null +++ b/man/getBurnin.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getBurnin} +\alias{getBurnin} +\title{Getter for the \code{burnin} slot} +\usage{ +getBurnin(object) +} +\description{ +Getter for the \code{burnin} slot +} +\keyword{internal} diff --git a/man/getBycolumn-fdata-method.Rd b/man/getBycolumn-fdata-method.Rd new file mode 100644 index 0000000..a725da3 --- /dev/null +++ b/man/getBycolumn-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getBycolumn,fdata-method} +\alias{getBycolumn,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getBycolumn}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{bycolumn} slot of the \code{object}. +} +\description{ +Returns the \code{bycolumn} slot of an \code{fdata} object. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getBycolumn(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getBycolumn.Rd b/man/getBycolumn.Rd new file mode 100644 index 0000000..88ca5dc --- /dev/null +++ b/man/getBycolumn.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getBycolumn} +\alias{getBycolumn} +\title{Getter for the \code{bycolumn} slot} +\usage{ +getBycolumn(object) +} +\description{ +Getter for the \code{bycolumn} slot +} +\keyword{internal} diff --git a/man/getClust-mcmcoutputbase-method.Rd b/man/getClust-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..2273bcb --- /dev/null +++ b/man/getClust-mcmcoutputbase-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{getClust,mcmcoutputbase-method} +\alias{getClust,mcmcoutputbase-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getClust}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{clust} slot of the \code{object}. +} +\description{ +Returns the \code{clust} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getClust(f_output) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputbase-class]{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getClust.Rd b/man/getClust.Rd new file mode 100644 index 0000000..4e9256e --- /dev/null +++ b/man/getClust.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getClust} +\alias{getClust} +\title{Getter for the \code{clust} slot} +\usage{ +getClust(object) +} +\description{ +Getter for the \code{clust} slot +} +\keyword{internal} diff --git a/man/getColExp-fdata-method.Rd b/man/getColExp-fdata-method.Rd new file mode 100644 index 0000000..b7d2fe9 --- /dev/null +++ b/man/getColExp-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getColExp,fdata-method} +\alias{getColExp,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getColExp}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{exp} slot of the \code{object} as a column-ordered matrix. +} +\description{ +Returns the \code{exp} slot as a column-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColExp(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getColExp.Rd b/man/getColExp.Rd new file mode 100644 index 0000000..abcc5f8 --- /dev/null +++ b/man/getColExp.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getColExp} +\alias{getColExp} +\title{Getter for the \code{exp} slot in column format} +\usage{ +getColExp(object) +} +\description{ +Getter for the \code{exp} slot in column format +} +\keyword{internal} diff --git a/man/getColS-fdata-method.Rd b/man/getColS-fdata-method.Rd new file mode 100644 index 0000000..d8cf954 --- /dev/null +++ b/man/getColS-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getColS,fdata-method} +\alias{getColS,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getColS}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{S} slot of the \code{object} as a column-ordered matrix. +} +\description{ +Returns the \code{S} slot as a column-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColS(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getColS.Rd b/man/getColS.Rd new file mode 100644 index 0000000..54689b3 --- /dev/null +++ b/man/getColS.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getColS} +\alias{getColS} +\title{Getter for the \code{S} slot in column format} +\usage{ +getColS(object) +} +\description{ +Getter for the \code{S} slot in column format +} +\keyword{internal} diff --git a/man/getColT-fdata-method.Rd b/man/getColT-fdata-method.Rd new file mode 100644 index 0000000..160b713 --- /dev/null +++ b/man/getColT-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getColT,fdata-method} +\alias{getColT,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getColT}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{T} slot of the \code{object} as a column-ordered matrix. +} +\description{ +Returns the \code{T} slot as a column-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColT(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getColT.Rd b/man/getColT.Rd new file mode 100644 index 0000000..dcafca2 --- /dev/null +++ b/man/getColT.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getColT} +\alias{getColT} +\title{Getter for the \code{T} slot in column format} +\usage{ +getColT(object) +} +\description{ +Getter for the \code{T} slot in column format +} +\keyword{internal} diff --git a/man/getColY-fdata-method.Rd b/man/getColY-fdata-method.Rd new file mode 100644 index 0000000..b457bfb --- /dev/null +++ b/man/getColY-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getColY,fdata-method} +\alias{getColY,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getColY}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{y} slot of the \code{object} as a column-ordered matrix. +} +\description{ +Returns the \code{y} slot as a column-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getColY(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getColY.Rd b/man/getColY.Rd new file mode 100644 index 0000000..3dee4cc --- /dev/null +++ b/man/getColY.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getColY} +\alias{getColY} +\title{Getter for the \code{y} slot in column format} +\usage{ +getColY(object) +} +\description{ +Getter for the \code{y} slot in column format +} +\keyword{internal} diff --git a/man/getCorr-cdatamoments-method.Rd b/man/getCorr-cdatamoments-method.Rd new file mode 100644 index 0000000..dbd05f1 --- /dev/null +++ b/man/getCorr-cdatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{getCorr,cdatamoments-method} +\alias{getCorr,cdatamoments-method} +\title{Getter method of \code{cdatamoments} class.} +\usage{ +\S4method{getCorr}{cdatamoments}(object) +} +\arguments{ +\item{object}{An \code{cdatamoments} object.} +} +\value{ +The \code{corr} slot of the \code{object}. +} +\description{ +Returns the \code{corr} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Use the getter. +getCorr(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getCorr-normultmodelmoments-method.Rd b/man/getCorr-normultmodelmoments-method.Rd new file mode 100644 index 0000000..08bc384 --- /dev/null +++ b/man/getCorr-normultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{getCorr,normultmodelmoments-method} +\alias{getCorr,normultmodelmoments-method} +\title{Getter method of \code{normultmodelmoments} class.} +\usage{ +\S4method{getCorr}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +The \code{Corr} slot of the \code{object}. +} +\description{ +Returns the \code{Corr} slot. +} +\examples{ +f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getCorr(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getCorr-studmultmodelmoments-method.Rd b/man/getCorr-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..e3373c1 --- /dev/null +++ b/man/getCorr-studmultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{getCorr,studmultmodelmoments-method} +\alias{getCorr,studmultmodelmoments-method} +\title{Getter method of \code{studmultmodelmoments} class.} +\usage{ +\S4method{getCorr}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +The \code{Corr} slot of the \code{object}. +} +\description{ +Returns the \code{Corr} slot. +} +\examples{ +f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +f_moments <- modelmoments(f_model) +getCorr(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getCorr.Rd b/man/getCorr.Rd new file mode 100644 index 0000000..7c10040 --- /dev/null +++ b/man/getCorr.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getCorr} +\alias{getCorr} +\title{Getter for the \code{corr} slot} +\usage{ +getCorr(object) +} +\description{ +Getter for the \code{corr} slot +} +\keyword{internal} diff --git a/man/getDist-mcmcestfix-method.Rd b/man/getDist-mcmcestfix-method.Rd new file mode 100644 index 0000000..26a7b69 --- /dev/null +++ b/man/getDist-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getDist,mcmcestfix-method} +\alias{getDist,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getDist}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{dist} slot of the \code{object}. +} +\description{ +Returns the \code{dist} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getDist(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getDist-model-method.Rd b/man/getDist-model-method.Rd new file mode 100644 index 0000000..b4f290f --- /dev/null +++ b/man/getDist-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getDist,model-method} +\alias{getDist,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getDist}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{dist} slot of the \code{object}. +} +\description{ +Returns the \code{dist} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getDist(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getDist.Rd b/man/getDist.Rd new file mode 100644 index 0000000..96d4ced --- /dev/null +++ b/man/getDist.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getDist} +\alias{getDist} +\title{Getter for the \code{dist} slot} +\usage{ +getDist(object) +} +\description{ +Getter for the \code{dist} slot +} +\keyword{internal} diff --git a/man/getEavg-mcmcestind-method.Rd b/man/getEavg-mcmcestind-method.Rd new file mode 100644 index 0000000..df02b8b --- /dev/null +++ b/man/getEavg-mcmcestind-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestind.R +\name{getEavg,mcmcestind-method} +\alias{getEavg,mcmcestind-method} +\title{Getter method of \code{mcmcestind} class.} +\usage{ +\S4method{getEavg}{mcmcestind}(object) +} +\arguments{ +\item{object}{An \code{mcmcestind} object.} +} +\value{ +The \code{eavg} slot of the \code{object}. +} +\description{ +Returns the \code{eavg} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getEavg(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestfix} for the parent class with fixed indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getEavg.Rd b/man/getEavg.Rd new file mode 100644 index 0000000..4ed9540 --- /dev/null +++ b/man/getEavg.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getEavg} +\alias{getEavg} +\title{Getter for the \code{eavg} slot} +\usage{ +getEavg(object) +} +\description{ +Getter for the \code{eavg} slot +} +\keyword{internal} diff --git a/man/getEntropy-dataclass-method.Rd b/man/getEntropy-dataclass-method.Rd new file mode 100644 index 0000000..0d69c15 --- /dev/null +++ b/man/getEntropy-dataclass-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{getEntropy,dataclass-method} +\alias{getEntropy,dataclass-method} +\title{Getter method of \code{dataclass} class.} +\usage{ +\S4method{getEntropy}{dataclass}(object) +} +\arguments{ +\item{object}{An \code{dataclass} object.} +} +\value{ +The \code{entropy} slot of the \code{object}. +} +\description{ +Returns the \code{entropy} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Classify observations +f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +getEntropy(f_dataclass) + +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the base class +\item \code{\link[=dataclass]{dataclass()}} for the constructor of the \code{dataclass} class +} +} +\keyword{internal} diff --git a/man/getEntropy-mcmcoutputbase-method.Rd b/man/getEntropy-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..e9a177c --- /dev/null +++ b/man/getEntropy-mcmcoutputbase-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{getEntropy,mcmcoutputbase-method} +\alias{getEntropy,mcmcoutputbase-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getEntropy}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{entropy} slot of the \code{object}. +} +\description{ +Returns the \code{entropy} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getEntropy(f_output) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputbase-class]{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getEntropy.Rd b/man/getEntropy.Rd new file mode 100644 index 0000000..062295c --- /dev/null +++ b/man/getEntropy.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getEntropy} +\alias{getEntropy} +\title{Getter for the \code{entropy} slot} +\usage{ +getEntropy(object) +} +\description{ +Getter for the \code{entropy} slot +} +\keyword{internal} diff --git a/man/getEntropyperm-mcmcpermind-method.Rd b/man/getEntropyperm-mcmcpermind-method.Rd new file mode 100644 index 0000000..9d47f36 --- /dev/null +++ b/man/getEntropyperm-mcmcpermind-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\name{getEntropyperm,mcmcpermind-method} +\alias{getEntropyperm,mcmcpermind-method} +\title{Getter method of \code{mcmcpermind} class.} +\usage{ +\S4method{getEntropyperm}{mcmcpermind}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermind} object.} +} +\value{ +The \code{entropyperm} slot of the \code{object}. +} +\description{ +Returns the \code{entropyperm} slot. +} +\examples{ +\dontrun{getEntropyperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermbase} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getEntropyperm.Rd b/man/getEntropyperm.Rd new file mode 100644 index 0000000..4806384 --- /dev/null +++ b/man/getEntropyperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getEntropyperm} +\alias{getEntropyperm} +\title{Getter for the \code{entropyperm} slot} +\usage{ +getEntropyperm(object) +} +\description{ +Getter for the \code{entropyperm} slot +} +\keyword{internal} diff --git a/man/getExp-fdata-method.Rd b/man/getExp-fdata-method.Rd new file mode 100644 index 0000000..8bc1274 --- /dev/null +++ b/man/getExp-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getExp,fdata-method} +\alias{getExp,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getExp}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{exp} slot of the \code{object} in the order defined \code{bycolumn}. +} +\description{ +Returns the \code{exp} slot in the order defined by the slot \code{bycolumn}. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getExp(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getExp.Rd b/man/getExp.Rd new file mode 100644 index 0000000..0a5f17d --- /dev/null +++ b/man/getExp.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getExp} +\alias{getExp} +\title{Getter for the \code{exp} format} +\usage{ +getExp(object) +} +\description{ +Getter for the \code{exp} format +} +\keyword{internal} diff --git a/man/getExtrabinvar-binomialmodelmoments-method.Rd b/man/getExtrabinvar-binomialmodelmoments-method.Rd new file mode 100644 index 0000000..0dbfb47 --- /dev/null +++ b/man/getExtrabinvar-binomialmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/binomialmodelmoments.R +\name{getExtrabinvar,binomialmodelmoments-method} +\alias{getExtrabinvar,binomialmodelmoments-method} +\title{Getter method of \code{binomialmodelmoments} class.} +\usage{ +\S4method{getExtrabinvar}{binomialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{binomialmodelmoments} object.} +} +\value{ +The \code{extrabinvar} slot of the \code{object}. +} +\description{ +Returns the \code{extrabinvar} slot. +} +\examples{ +f_model <- model("binomial", par=list(p=c(0.3, 0.5)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getExtrabinvar(f_moments) + +} +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getExtrabinvar.Rd b/man/getExtrabinvar.Rd new file mode 100644 index 0000000..516b367 --- /dev/null +++ b/man/getExtrabinvar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getExtrabinvar} +\alias{getExtrabinvar} +\title{Getter for the \code{extrabinvar} slot} +\usage{ +getExtrabinvar(object) +} +\description{ +Getter for the \code{extrabinvar} slot +} +\keyword{internal} diff --git a/man/getFactorial-ddatamoments-method.Rd b/man/getFactorial-ddatamoments-method.Rd new file mode 100644 index 0000000..43006ce --- /dev/null +++ b/man/getFactorial-ddatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{getFactorial,ddatamoments-method} +\alias{getFactorial,ddatamoments-method} +\title{Getter method of \code{ddatamoments} class.} +\usage{ +\S4method{getFactorial}{ddatamoments}(object) +} +\arguments{ +\item{object}{An \code{ddatamoments} object.} +} +\value{ +The \code{factorial} slot of the \code{object}. +} +\description{ +Returns the \code{factorial} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Get the moments for the included indicators of the data. +getFactorial(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getFactorial-dmodelmoments-method.Rd b/man/getFactorial-dmodelmoments-method.Rd new file mode 100644 index 0000000..1e46b34 --- /dev/null +++ b/man/getFactorial-dmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dmodelmoments.R +\name{getFactorial,dmodelmoments-method} +\alias{getFactorial,dmodelmoments-method} +\title{Getter method of \code{dmodelmoments} class.} +\usage{ +\S4method{getFactorial}{dmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{dmodelmoments} object.} +} +\value{ +The \code{skewness} slot of the \code{object}. +} +\description{ +Returns the \code{skewness} slot. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getFactorial(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getFactorial.Rd b/man/getFactorial.Rd new file mode 100644 index 0000000..1105707 --- /dev/null +++ b/man/getFactorial.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getFactorial} +\alias{getFactorial} +\title{Getter for the \code{factorial} slot} +\usage{ +getFactorial(object) +} +\description{ +Getter for the \code{factorial} slot +} +\keyword{internal} diff --git a/man/getFdata-csdatamoments-method.Rd b/man/getFdata-csdatamoments-method.Rd new file mode 100644 index 0000000..60b1445 --- /dev/null +++ b/man/getFdata-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getFdata,csdatamoments-method} +\alias{getFdata,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getFdata}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{fdata} slot of the \code{object}. +} +\description{ +Returns the \code{fdata} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getFdata(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getFdata-groupmoments-method.Rd b/man/getFdata-groupmoments-method.Rd new file mode 100644 index 0000000..946a6ec --- /dev/null +++ b/man/getFdata-groupmoments-method.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{getFdata,groupmoments-method} +\alias{getFdata,groupmoments-method} +\title{Getter method of \code{groupmoments} class.} +\usage{ +\S4method{getFdata}{groupmoments}(object) +} +\arguments{ +\item{object}{An \code{groupmoments} object.} +} +\value{ +The \code{fdata} slot of the \code{object}. +} +\description{ +Returns the \code{fdata} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_gmoments <- groupmoments(f_data) +# Get the data< +getFdata(f_gmoments) + +} +\seealso{ +\itemize{ +\item \linkS4class{groupmoments} for the definition of the \code{groupmoments} +class +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/getFdata-sdatamoments-method.Rd b/man/getFdata-sdatamoments-method.Rd new file mode 100644 index 0000000..f4546e9 --- /dev/null +++ b/man/getFdata-sdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\name{getFdata,sdatamoments-method} +\alias{getFdata,sdatamoments-method} +\title{Getter method of \code{sdatamoments} class.} +\usage{ +\S4method{getFdata}{sdatamoments}(object) +} +\arguments{ +\item{object}{An \code{sdatamoments} object.} +} +\value{ +The \code{fdata} slot of the \code{object}. +} +\description{ +Returns the \code{fdata} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getFdata(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{sdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getFdata.Rd b/man/getFdata.Rd new file mode 100644 index 0000000..85f3486 --- /dev/null +++ b/man/getFdata.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getFdata} +\alias{getFdata} +\title{Getter for the \code{fdata} slot} +\usage{ +getFdata(object) +} +\description{ +Getter for the \code{fdata} slot +} +\keyword{internal} diff --git a/man/getGmoments-csdatamoments-method.Rd b/man/getGmoments-csdatamoments-method.Rd new file mode 100644 index 0000000..877f615 --- /dev/null +++ b/man/getGmoments-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getGmoments,csdatamoments-method} +\alias{getGmoments,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getGmoments}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{gmoments} slot of the \code{object}. +} +\description{ +Returns the \code{gmoments} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getGmoments(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getGmoments-sdatamoments-method.Rd b/man/getGmoments-sdatamoments-method.Rd new file mode 100644 index 0000000..badd1e8 --- /dev/null +++ b/man/getGmoments-sdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\name{getGmoments,sdatamoments-method} +\alias{getGmoments,sdatamoments-method} +\title{Getter method of \code{sdatamoments} class.} +\usage{ +\S4method{getGmoments}{sdatamoments}(object) +} +\arguments{ +\item{object}{An \code{sdatamoments} object.} +} +\value{ +The \code{gmoments} slot of the \code{object}. +} +\description{ +Returns the \code{gmoments} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getGmoments(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{sdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getGmoments.Rd b/man/getGmoments.Rd new file mode 100644 index 0000000..8e7c91a --- /dev/null +++ b/man/getGmoments.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getGmoments} +\alias{getGmoments} +\title{Getter for the \code{gmoments} slot} +\usage{ +getGmoments(object) +} +\description{ +Getter for the \code{gmoments} slot +} +\keyword{internal} diff --git a/man/getHier-prior-method.Rd b/man/getHier-prior-method.Rd new file mode 100644 index 0000000..8baee59 --- /dev/null +++ b/man/getHier-prior-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{getHier,prior-method} +\alias{getHier,prior-method} +\title{Getter method of \code{prior} class.} +\usage{ +\S4method{getHier}{prior}(object) +} +\arguments{ +\item{object}{An \code{prior} object.} +} +\value{ +The \code{hier} slot of the \code{object}. +} +\description{ +Returns the \code{hier} slot. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Get the slot. +getHier(f_prior) +} +\keyword{internal} diff --git a/man/getHier.Rd b/man/getHier.Rd new file mode 100644 index 0000000..d2cfd82 --- /dev/null +++ b/man/getHier.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getHier} +\alias{getHier} +\title{Getter for the \code{hier} slot} +\usage{ +getHier(object) +} +\description{ +Getter for the \code{hier} slot +} +\keyword{internal} diff --git a/man/getHigher-cdatamoments-method.Rd b/man/getHigher-cdatamoments-method.Rd new file mode 100644 index 0000000..a4dfc4f --- /dev/null +++ b/man/getHigher-cdatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{getHigher,cdatamoments-method} +\alias{getHigher,cdatamoments-method} +\title{Getter method of \code{cdatamoments} class.} +\usage{ +\S4method{getHigher}{cdatamoments}(object) +} +\arguments{ +\item{object}{An \code{cdatamoments} object.} +} +\value{ +The \code{higher} slot of the \code{object}. +} +\description{ +Returns the \code{higher} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Use the getter. +getHigher(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getHigher-cmodelmoments-method.Rd b/man/getHigher-cmodelmoments-method.Rd new file mode 100644 index 0000000..f9f85d7 --- /dev/null +++ b/man/getHigher-cmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmodelmoments.R +\name{getHigher,cmodelmoments-method} +\alias{getHigher,cmodelmoments-method} +\title{Getter method of \code{cmodelmoments} class.} +\usage{ +\S4method{getHigher}{cmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{cmodelmoments} object.} +} +\value{ +The \code{higher} slot of the \code{object}. +} +\description{ +Returns the \code{higher} slot. +} +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getHigher(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getHigher.Rd b/man/getHigher.Rd new file mode 100644 index 0000000..8efbba4 --- /dev/null +++ b/man/getHigher.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getHigher} +\alias{getHigher} +\title{Getter for the \code{higher} slot} +\usage{ +getHigher(object) +} +\description{ +Getter for the \code{higher} slot +} +\keyword{internal} diff --git a/man/getHyper-mcmcoutputfixhier-method.Rd b/man/getHyper-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..ee74d38 --- /dev/null +++ b/man/getHyper-mcmcoutputfixhier-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{getHyper,mcmcoutputfixhier-method} +\alias{getHyper,mcmcoutputfixhier-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getHyper}{mcmcoutputfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{hyper} slot of the \code{object}. +} +\description{ +Returns the \code{hyper} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getHyper(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getHyper-mcmcoutputhier-method.Rd b/man/getHyper-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..1e94677 --- /dev/null +++ b/man/getHyper-mcmcoutputhier-method.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{getHyper,mcmcoutputhier-method} +\alias{getHyper,mcmcoutputhier-method} +\title{Getter method of \code{mcmcoutputhier} class.} +\usage{ +\S4method{getHyper}{mcmcoutputhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputhier} object.} +} +\value{ +The \code{hyper} slot of the \code{object}. +} +\description{ +Returns the \code{hyper} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getHyper(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputhier} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getHyper.Rd b/man/getHyper.Rd new file mode 100644 index 0000000..b5c10e4 --- /dev/null +++ b/man/getHyper.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getHyper} +\alias{getHyper} +\title{Getter for the \code{hyper} slot} +\usage{ +getHyper(object) +} +\description{ +Getter for the \code{hyper} slot +} +\keyword{internal} diff --git a/man/getHyperperm-mcmcpermfixhier-method.Rd b/man/getHyperperm-mcmcpermfixhier-method.Rd new file mode 100644 index 0000000..8a17842 --- /dev/null +++ b/man/getHyperperm-mcmcpermfixhier-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfixhier.R +\name{getHyperperm,mcmcpermfixhier-method} +\alias{getHyperperm,mcmcpermfixhier-method} +\title{Getter method of \code{mcmcpermfixhier} class.} +\usage{ +\S4method{getHyperperm}{mcmcpermfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfixhier} object.} +} +\value{ +The \code{hyperperm} slot of the \code{object}. +} +\description{ +Returns the \code{hyperperm} slot. +} +\examples{ +\dontrun{getHyperpem(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcpermfixhier} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getHyperperm-mcmcpermfixpost-method.Rd b/man/getHyperperm-mcmcpermfixpost-method.Rd new file mode 100644 index 0000000..e9a0bc2 --- /dev/null +++ b/man/getHyperperm-mcmcpermfixpost-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermindhier.R +\name{getHyperperm,mcmcpermfixpost-method} +\alias{getHyperperm,mcmcpermfixpost-method} +\title{Getter method of \code{mcmcperminfhier} class.} +\usage{ +\S4method{getHyperperm}{mcmcpermfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermindhier} object.} +} +\value{ +The \code{hyperperm} slot of the \code{object}. +} +\description{ +Returns the \code{hyperperm} slot. +} +\examples{ +\dontrun{getHyperpem(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermhier} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getHyperperm.Rd b/man/getHyperperm.Rd new file mode 100644 index 0000000..9ec96a0 --- /dev/null +++ b/man/getHyperperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getHyperperm} +\alias{getHyperperm} +\title{Getter for the \code{hyperperm} slot} +\usage{ +getHyperperm(object) +} +\description{ +Getter for the \code{hyperperm} slot +} +\keyword{internal} diff --git a/man/getIeavg-mcmcestfix-method.Rd b/man/getIeavg-mcmcestfix-method.Rd new file mode 100644 index 0000000..3829283 --- /dev/null +++ b/man/getIeavg-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getIeavg,mcmcestfix-method} +\alias{getIeavg,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getIeavg}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{ieavg} slot of the \code{object}. +} +\description{ +Returns the \code{ieavg} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getIeavg(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getIeavg.Rd b/man/getIeavg.Rd new file mode 100644 index 0000000..e91a541 --- /dev/null +++ b/man/getIeavg.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getIeavg} +\alias{getIeavg} +\title{Getter for the \code{ieavg} slot} +\usage{ +getIeavg(object) +} +\description{ +Getter for the \code{ieavg} slot +} +\keyword{internal} diff --git a/man/getIndicfix-model-method.Rd b/man/getIndicfix-model-method.Rd new file mode 100644 index 0000000..b4da292 --- /dev/null +++ b/man/getIndicfix-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getIndicfix,model-method} +\alias{getIndicfix,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getIndicfix}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{indicfix} slot of the \code{object}. +} +\description{ +Returns the \code{indicfix} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getIndicfix(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getIndicfix.Rd b/man/getIndicfix.Rd new file mode 100644 index 0000000..8ed4c76 --- /dev/null +++ b/man/getIndicfix.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getIndicfix} +\alias{getIndicfix} +\title{Getter for the \code{indicfix} slot} +\usage{ +getIndicfix(object) +} +\description{ +Getter for the \code{indicfix} slot +} +\keyword{internal} diff --git a/man/getIndicmod-mcmcestfix-method.Rd b/man/getIndicmod-mcmcestfix-method.Rd new file mode 100644 index 0000000..29b878f --- /dev/null +++ b/man/getIndicmod-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getIndicmod,mcmcestfix-method} +\alias{getIndicmod,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getIndicmod}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{indicmod} slot of the \code{object}. +} +\description{ +Returns the \code{indicmod} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getIndicmod(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getIndicmod-model-method.Rd b/man/getIndicmod-model-method.Rd new file mode 100644 index 0000000..b06514d --- /dev/null +++ b/man/getIndicmod-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getIndicmod,model-method} +\alias{getIndicmod,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getIndicmod}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{indicmod} slot of the \code{object}. +} +\description{ +Returns the \code{indicmod} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getIndicmod(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getIndicmod.Rd b/man/getIndicmod.Rd new file mode 100644 index 0000000..26b9371 --- /dev/null +++ b/man/getIndicmod.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getIndicmod} +\alias{getIndicmod} +\title{Getter for the \code{indicmod} slot} +\usage{ +getIndicmod(object) +} +\description{ +Getter for the \code{indicmod} slot +} +\keyword{internal} diff --git a/man/getK-mcmcestfix-method.Rd b/man/getK-mcmcestfix-method.Rd new file mode 100644 index 0000000..a5c708d --- /dev/null +++ b/man/getK-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getK,mcmcestfix-method} +\alias{getK,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getK}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{K} slot of the \code{object}. +} +\description{ +Returns the \code{K} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getK(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getK-model-method.Rd b/man/getK-model-method.Rd new file mode 100644 index 0000000..0b9606b --- /dev/null +++ b/man/getK-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getK,model-method} +\alias{getK,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getK}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{K} slot of the \code{object}. +} +\description{ +Returns the \code{K} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getK(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getK.Rd b/man/getK.Rd new file mode 100644 index 0000000..27a814d --- /dev/null +++ b/man/getK.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getK} +\alias{getK} +\title{Getter for the \code{K} slot} +\usage{ +getK(object) +} +\description{ +Getter for the \code{K} slot +} +\keyword{internal} diff --git a/man/getKurtosis-cdatamoments-method.Rd b/man/getKurtosis-cdatamoments-method.Rd new file mode 100644 index 0000000..54c77ae --- /dev/null +++ b/man/getKurtosis-cdatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{getKurtosis,cdatamoments-method} +\alias{getKurtosis,cdatamoments-method} +\title{Getter method of \code{cdatamoments} class.} +\usage{ +\S4method{getKurtosis}{cdatamoments}(object) +} +\arguments{ +\item{object}{An \code{cdatamoments} object.} +} +\value{ +The \code{kurtosis} slot of the \code{object}. +} +\description{ +Returns the \code{kurtosis} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Use the getter. +getKurtosis(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getKurtosis-cmodelmoments-method.Rd b/man/getKurtosis-cmodelmoments-method.Rd new file mode 100644 index 0000000..4d92fa1 --- /dev/null +++ b/man/getKurtosis-cmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmodelmoments.R +\name{getKurtosis,cmodelmoments-method} +\alias{getKurtosis,cmodelmoments-method} +\title{Getter method of \code{cmodelmoments} class.} +\usage{ +\S4method{getKurtosis}{cmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{cmodelmoments} object.} +} +\value{ +The \code{kurtosis} slot of the \code{object}. +} +\description{ +Returns the \code{kurtosis} slot. +} +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getKurtosis(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getKurtosis.Rd b/man/getKurtosis.Rd new file mode 100644 index 0000000..f7d6cad --- /dev/null +++ b/man/getKurtosis.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getKurtosis} +\alias{getKurtosis} +\title{Getter for the \code{kurtosis} slot} +\usage{ +getKurtosis(object) +} +\description{ +Getter for the \code{kurtosis} slot +} +\keyword{internal} diff --git a/man/getLog-mcmcoutputfix-method.Rd b/man/getLog-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..2c576f7 --- /dev/null +++ b/man/getLog-mcmcoutputfix-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getLog,mcmcoutputfix-method} +\alias{getLog,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getLog}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{log} slot of the \code{object}. +} +\description{ +Returns the \code{log} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getLog(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getLog.Rd b/man/getLog.Rd new file mode 100644 index 0000000..33d785d --- /dev/null +++ b/man/getLog.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getLog} +\alias{getLog} +\title{Getter for the \code{log} slot} +\usage{ +getLog(object) +} +\description{ +Getter for the \code{log} slot +} +\keyword{internal} diff --git a/man/getLoglikcd-dataclass-method.Rd b/man/getLoglikcd-dataclass-method.Rd new file mode 100644 index 0000000..081f05b --- /dev/null +++ b/man/getLoglikcd-dataclass-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{getLoglikcd,dataclass-method} +\alias{getLoglikcd,dataclass-method} +\title{Getter method of \code{dataclass} class.} +\usage{ +\S4method{getLoglikcd}{dataclass}(object) +} +\arguments{ +\item{object}{An \code{dataclass} object.} +} +\value{ +The \code{loglikcd} slot of the \code{object}. +} +\description{ +Returns the \code{loglikcd} slot. Note that this slot is only non-null, if the +indicators have not been simulated. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Classify observations +f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +getLoglikcd(f_dataclass) + +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the base class +\item \code{\link[=dataclass]{dataclass()}} for the constructor of the \code{dataclass} class +} +} +\keyword{internal} diff --git a/man/getLoglikcd.Rd b/man/getLoglikcd.Rd new file mode 100644 index 0000000..70a85a1 --- /dev/null +++ b/man/getLoglikcd.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getLoglikcd} +\alias{getLoglikcd} +\title{Getter for the \code{loglikcd} slot} +\usage{ +getLoglikcd(object) +} +\description{ +Getter for the \code{loglikcd} slot +} +\keyword{internal} diff --git a/man/getLogperm-mcmcpermfix-method.Rd b/man/getLogperm-mcmcpermfix-method.Rd new file mode 100644 index 0000000..5a5220a --- /dev/null +++ b/man/getLogperm-mcmcpermfix-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfix.R +\name{getLogperm,mcmcpermfix-method} +\alias{getLogperm,mcmcpermfix-method} +\title{Getter method of \code{mcmcpermfix} class.} +\usage{ +\S4method{getLogperm}{mcmcpermfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfix} object.} +} +\value{ +The \code{logperm} slot of the \code{object}. +} +\description{ +Returns the \code{logperm} slot. +} +\examples{ +\dontrun{getLogperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getLogperm.Rd b/man/getLogperm.Rd new file mode 100644 index 0000000..81de78e --- /dev/null +++ b/man/getLogperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getLogperm} +\alias{getLogperm} +\title{Getter for the \code{logperm} slot} +\usage{ +getLogperm(object) +} +\description{ +Getter for the \code{logperm} slot +} +\keyword{internal} diff --git a/man/getLogpy-dataclass-method.Rd b/man/getLogpy-dataclass-method.Rd new file mode 100644 index 0000000..626a4cb --- /dev/null +++ b/man/getLogpy-dataclass-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{getLogpy,dataclass-method} +\alias{getLogpy,dataclass-method} +\title{Getter method of \code{dataclass} class.} +\usage{ +\S4method{getLogpy}{dataclass}(object) +} +\arguments{ +\item{object}{An \code{dataclass} object.} +} +\value{ +The \code{logpy} slot of the \code{object}. +} +\description{ +Returns the \code{logpy} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Classify observations +f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +getLogpy(f_dataclass) + +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the base class +\item \code{\link[=dataclass]{dataclass()}} for the constructor of the \code{dataclass} class +} +} +\keyword{internal} diff --git a/man/getLogpy.Rd b/man/getLogpy.Rd new file mode 100644 index 0000000..f90f534 --- /dev/null +++ b/man/getLogpy.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getLogpy} +\alias{getLogpy} +\title{Getter for the \code{logpy} slot} +\usage{ +getLogpy(object) +} +\description{ +Getter for the \code{logpy} slot +} +\keyword{internal} diff --git a/man/getM-mcmc-method.Rd b/man/getM-mcmc-method.Rd new file mode 100644 index 0000000..c6c02dd --- /dev/null +++ b/man/getM-mcmc-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{getM,mcmc-method} +\alias{getM,mcmc-method} +\title{Getter method of \code{mcmc} class.} +\usage{ +\S4method{getM}{mcmc}(object) +} +\arguments{ +\item{object}{An \code{mcmc} object.} +} +\value{ +The \code{M} slot of the \code{object}. +} +\description{ +Returns the \code{M} slot. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Get the slot +getM(f_mcmc) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/getM-mcmcestfix-method.Rd b/man/getM-mcmcestfix-method.Rd new file mode 100644 index 0000000..25498eb --- /dev/null +++ b/man/getM-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getM,mcmcestfix-method} +\alias{getM,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getM}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{M} slot of the \code{object}. +} +\description{ +Returns the \code{M} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getM(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getM-mcmcoutputfix-method.Rd b/man/getM-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..1024990 --- /dev/null +++ b/man/getM-mcmcoutputfix-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getM,mcmcoutputfix-method} +\alias{getM,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getM}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{M} slot of the \code{object}. +} +\description{ +Returns the \code{M} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getM(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getM.Rd b/man/getM.Rd new file mode 100644 index 0000000..106e0ff --- /dev/null +++ b/man/getM.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getM} +\alias{getM} +\title{Getter for the \code{M} slot} +\usage{ +getM(object) +} +\description{ +Getter for the \code{M} slot +} +\keyword{internal} diff --git a/man/getMap-mcmcestfix-method.Rd b/man/getMap-mcmcestfix-method.Rd new file mode 100644 index 0000000..04946df --- /dev/null +++ b/man/getMap-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getMap,mcmcestfix-method} +\alias{getMap,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getMap}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{map} slot of the \code{object}. +} +\description{ +Returns the \code{map} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getMap(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getMap.Rd b/man/getMap.Rd new file mode 100644 index 0000000..18ba8ba --- /dev/null +++ b/man/getMap.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getMap} +\alias{getMap} +\title{Getter for the \code{map} slot} +\usage{ +getMap(object) +} +\description{ +Getter for the \code{map} slot +} +\keyword{internal} diff --git a/man/getMean-groupmoments-method.Rd b/man/getMean-groupmoments-method.Rd new file mode 100644 index 0000000..72e1d22 --- /dev/null +++ b/man/getMean-groupmoments-method.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{getMean,groupmoments-method} +\alias{getMean,groupmoments-method} +\title{Getter method of \code{groupmoments} class.} +\usage{ +\S4method{getMean}{groupmoments}(object) +} +\arguments{ +\item{object}{An \code{groupmoments} object.} +} +\value{ +The \code{mean} slot of the \code{object}. +} +\description{ +Returns the \code{mean} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_gmoments <- groupmoments(f_data) +# Get the moments for the included indicators of the data. +getMean(f_gmoments) + +} +\seealso{ +\itemize{ +\item \linkS4class{groupmoments} for the definition of the \code{groupmoments} +class +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/getMean-modelmoments-method.Rd b/man/getMean-modelmoments-method.Rd new file mode 100644 index 0000000..387c5da --- /dev/null +++ b/man/getMean-modelmoments-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelmoments.R +\name{getMean,modelmoments-method} +\alias{getMean,modelmoments-method} +\title{Getter method of \code{modelmoments} class.} +\usage{ +\S4method{getMean}{modelmoments}(object) +} +\arguments{ +\item{object}{A \code{modelmoments} object.} +} +\value{ +The \code{mean} slot of the \code{object}. +} +\description{ +Returns the \code{mean} slot of a \code{modelmoments} object. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getMean(f_moments) + +} +\seealso{ +\linkS4class{modelmoments} for all slots of the \code{modelmoments} class +} +\keyword{internal} diff --git a/man/getMean.Rd b/man/getMean.Rd new file mode 100644 index 0000000..cfdef0a --- /dev/null +++ b/man/getMean.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getMean} +\alias{getMean} +\title{Getter for the \code{mean} slot} +\usage{ +getMean(object) +} +\description{ +Getter for the \code{mean} slot +} +\keyword{internal} diff --git a/man/getMixlik-dataclass-method.Rd b/man/getMixlik-dataclass-method.Rd new file mode 100644 index 0000000..22e9879 --- /dev/null +++ b/man/getMixlik-dataclass-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{getMixlik,dataclass-method} +\alias{getMixlik,dataclass-method} +\title{Getter method of \code{dataclass} class.} +\usage{ +\S4method{getMixlik}{dataclass}(object) +} +\arguments{ +\item{object}{An \code{dataclass} object.} +} +\value{ +The \code{mixlik} slot of the \code{object}. +} +\description{ +Returns the \code{mixlik} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Classify observations +f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +getMixlik(f_dataclass) + +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the base class +\item \code{\link[=dataclass]{dataclass()}} for the constructor of the \code{dataclass} class< +} +} +\keyword{internal} diff --git a/man/getMixlik.Rd b/man/getMixlik.Rd new file mode 100644 index 0000000..1aabab5 --- /dev/null +++ b/man/getMixlik.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getMixlik} +\alias{getMixlik} +\title{Getter for the mixlik slot} +\usage{ +getMixlik(object) +} +\description{ +Getter for the mixlik slot +} +\keyword{internal} diff --git a/man/getModel-mcmcoutputfix-method.Rd b/man/getModel-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..4cdbf28 --- /dev/null +++ b/man/getModel-mcmcoutputfix-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getModel,mcmcoutputfix-method} +\alias{getModel,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getModel}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{model} slot of the \code{object}. +} +\description{ +Returns the \code{model} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getModel(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getModel-modelmoments-method.Rd b/man/getModel-modelmoments-method.Rd new file mode 100644 index 0000000..7c65590 --- /dev/null +++ b/man/getModel-modelmoments-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelmoments.R +\name{getModel,modelmoments-method} +\alias{getModel,modelmoments-method} +\title{Getter method of \code{modelmoments} class.} +\usage{ +\S4method{getModel}{modelmoments}(object) +} +\arguments{ +\item{object}{A \code{modelmoments} object.} +} +\value{ +The \code{model} slot of the \code{object}. +} +\description{ +Returns the \code{model} slot of a \code{modelmoments} object. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getModel(f_moments) + +} +\seealso{ +\linkS4class{modelmoments} for all slots of the \code{modelmoments} class +} +\keyword{internal} diff --git a/man/getModel.Rd b/man/getModel.Rd new file mode 100644 index 0000000..faaa958 --- /dev/null +++ b/man/getModel.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getModel} +\alias{getModel} +\title{Getter for the \code{model} slot} +\usage{ +getModel(object) +} +\description{ +Getter for the \code{model} slot +} +\keyword{internal} diff --git a/man/getMperm-mcmcpermfix-method.Rd b/man/getMperm-mcmcpermfix-method.Rd new file mode 100644 index 0000000..0892769 --- /dev/null +++ b/man/getMperm-mcmcpermfix-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfix.R +\name{getMperm,mcmcpermfix-method} +\alias{getMperm,mcmcpermfix-method} +\title{Getter method of \code{mcmcpermfix} class.} +\usage{ +\S4method{getMperm}{mcmcpermfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfix} object.} +} +\value{ +The \code{Mperm} slot of the \code{object}. +} +\description{ +Returns the \code{Mperm} slot. +} +\examples{ +\dontrun{getMperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermfix} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getMperm.Rd b/man/getMperm.Rd new file mode 100644 index 0000000..d2b1b9c --- /dev/null +++ b/man/getMperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getMperm} +\alias{getMperm} +\title{Getter for the \code{Mperm} slot} +\usage{ +getMperm(object) +} +\description{ +Getter for the \code{Mperm} slot +} +\keyword{internal} diff --git a/man/getN-fdata-method.Rd b/man/getN-fdata-method.Rd new file mode 100644 index 0000000..31e5191 --- /dev/null +++ b/man/getN-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getN,fdata-method} +\alias{getN,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getN}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{N} slot of the \code{object}. +} +\description{ +Returns the \code{N} slot of an \code{fdata} object. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getN(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getN.Rd b/man/getN.Rd new file mode 100644 index 0000000..10012df --- /dev/null +++ b/man/getN.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getN} +\alias{getN} +\title{Getter for the \code{N} slot} +\usage{ +getN(object) +} +\description{ +Getter for the \code{N} slot +} +\keyword{internal} diff --git a/man/getNK-groupmoments-method.Rd b/man/getNK-groupmoments-method.Rd new file mode 100644 index 0000000..09c02a0 --- /dev/null +++ b/man/getNK-groupmoments-method.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{getNK,groupmoments-method} +\alias{getNK,groupmoments-method} +\title{Getter method of \code{groupmoments} class.} +\usage{ +\S4method{getNK}{groupmoments}(object) +} +\arguments{ +\item{object}{An \code{groupmoments} object.} +} +\value{ +The \code{NK} slot of the \code{object}. +} +\description{ +Returns the \code{NK} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_gmoments <- groupmoments(f_data) +# Get the moments for the included indicators of the data. +getNK(f_gmoments) + +} +\seealso{ +\itemize{ +\item \linkS4class{groupmoments} for the definition of the \code{groupmoments} +class +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/getNK-mcmcoutputbase-method.Rd b/man/getNK-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..f956675 --- /dev/null +++ b/man/getNK-mcmcoutputbase-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{getNK,mcmcoutputbase-method} +\alias{getNK,mcmcoutputbase-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getNK}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{NK} slot of the \code{object}. +} +\description{ +Returns the \code{NK} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getNK(f_output) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputbase-class]{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getNK.Rd b/man/getNK.Rd new file mode 100644 index 0000000..e93438f --- /dev/null +++ b/man/getNK.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getNK} +\alias{getNK} +\title{Getter for the \code{NK} slot} +\usage{ +getNK(object) +} +\description{ +Getter for the \code{NK} slot +} +\keyword{internal} diff --git a/man/getNKperm-mcmcpermind-method.Rd b/man/getNKperm-mcmcpermind-method.Rd new file mode 100644 index 0000000..f067852 --- /dev/null +++ b/man/getNKperm-mcmcpermind-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\name{getNKperm,mcmcpermind-method} +\alias{getNKperm,mcmcpermind-method} +\title{Getter method of \code{mcmcpermind} class.} +\usage{ +\S4method{getNKperm}{mcmcpermind}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermind} object.} +} +\value{ +The \code{NKperm} slot of the \code{object}. +} +\description{ +Returns the \code{NKperm} slot. +} +\examples{ +\dontrun{getNKperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermbase} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getNKperm.Rd b/man/getNKperm.Rd new file mode 100644 index 0000000..dd142de --- /dev/null +++ b/man/getNKperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getNKperm} +\alias{getNKperm} +\title{Getter for the \code{NKperm} slot} +\usage{ +getNKperm(object) +} +\description{ +Getter for the \code{NKperm} slot +} +\keyword{internal} diff --git a/man/getName-fdata-method.Rd b/man/getName-fdata-method.Rd new file mode 100644 index 0000000..6360fab --- /dev/null +++ b/man/getName-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getName,fdata-method} +\alias{getName,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getName}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{name} slot of the \code{object}. +} +\description{ +Returns the \code{name} slot of an \code{fdata} object. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getName(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getName.Rd b/man/getName.Rd new file mode 100644 index 0000000..a49db4f --- /dev/null +++ b/man/getName.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getName} +\alias{getName} +\title{Getter for the \code{name} slot} +\usage{ +getName(object) +} +\description{ +Getter for the \code{name} slot +} +\keyword{internal} diff --git a/man/getOver-ddatamoments-method.Rd b/man/getOver-ddatamoments-method.Rd new file mode 100644 index 0000000..d095c2c --- /dev/null +++ b/man/getOver-ddatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{getOver,ddatamoments-method} +\alias{getOver,ddatamoments-method} +\title{Getter method of \code{ddatamoments} class.} +\usage{ +\S4method{getOver}{ddatamoments}(object) +} +\arguments{ +\item{object}{An \code{ddatamoments} object.} +} +\value{ +The \code{over} slot of the \code{object}. +} +\description{ +Returns the \code{over} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Get the moments for the included indicators of the data. +getOver(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getOver-dmodelmoments-method.Rd b/man/getOver-dmodelmoments-method.Rd new file mode 100644 index 0000000..51a9b24 --- /dev/null +++ b/man/getOver-dmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dmodelmoments.R +\name{getOver,dmodelmoments-method} +\alias{getOver,dmodelmoments-method} +\title{Getter method of \code{dmodelmoments} class.} +\usage{ +\S4method{getOver}{dmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{dmodelmoments} object.} +} +\value{ +The \code{higher} slot of the \code{object}. +} +\description{ +Returns the \code{higher} slot. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getOver(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getOver.Rd b/man/getOver.Rd new file mode 100644 index 0000000..c2afd28 --- /dev/null +++ b/man/getOver.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getOver} +\alias{getOver} +\title{Getter for the \code{over} slot} +\usage{ +getOver(object) +} +\description{ +Getter for the \code{over} slot +} +\keyword{internal} diff --git a/man/getPar-mcmcoutputfix-method.Rd b/man/getPar-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..add3fd6 --- /dev/null +++ b/man/getPar-mcmcoutputfix-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getPar,mcmcoutputfix-method} +\alias{getPar,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getPar}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{par} slot of the \code{object}. +} +\description{ +Returns the \code{par} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getPar(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getPar-model-method.Rd b/man/getPar-model-method.Rd new file mode 100644 index 0000000..3b4dd8f --- /dev/null +++ b/man/getPar-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getPar,model-method} +\alias{getPar,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getPar}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{par} slot of the \code{object}. +} +\description{ +Returns the \code{par} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getPar(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getPar-prior-method.Rd b/man/getPar-prior-method.Rd new file mode 100644 index 0000000..6e2e8fc --- /dev/null +++ b/man/getPar-prior-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{getPar,prior-method} +\alias{getPar,prior-method} +\title{Getter method of \code{prior} class.} +\usage{ +\S4method{getPar}{prior}(object) +} +\arguments{ +\item{object}{An \code{prior} object.} +} +\value{ +The \code{par} slot of the \code{object}. +} +\description{ +Returns the \code{par} slot. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Get the slot. +getPar(f_prior) +} +\keyword{internal} diff --git a/man/getPar.Rd b/man/getPar.Rd new file mode 100644 index 0000000..17c97a8 --- /dev/null +++ b/man/getPar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getPar} +\alias{getPar} +\title{Getter for the \code{par} slot} +\usage{ +getPar(object) +} +\description{ +Getter for the \code{par} slot +} +\keyword{internal} diff --git a/man/getParperm-mcmcpermfix-method.Rd b/man/getParperm-mcmcpermfix-method.Rd new file mode 100644 index 0000000..eb16d7e --- /dev/null +++ b/man/getParperm-mcmcpermfix-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfix.R +\name{getParperm,mcmcpermfix-method} +\alias{getParperm,mcmcpermfix-method} +\title{Getter method of \code{mcmcpermfix} class.} +\usage{ +\S4method{getParperm}{mcmcpermfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfix} object.} +} +\value{ +The \code{parperm} slot of the \code{object}. +} +\description{ +Returns the \code{parperm} slot. +} +\examples{ +\dontrun{getParperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getParperm.Rd b/man/getParperm.Rd new file mode 100644 index 0000000..ea30679 --- /dev/null +++ b/man/getParperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getParperm} +\alias{getParperm} +\title{Getter for the \code{parperm} slot} +\usage{ +getParperm(object) +} +\description{ +Getter for the \code{parperm} slot +} +\keyword{internal} diff --git a/man/getPost-mcmcoutputfixhierpost-method.Rd b/man/getPost-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..29237a6 --- /dev/null +++ b/man/getPost-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{getPost,mcmcoutputfixhierpost-method} +\alias{getPost,mcmcoutputfixhierpost-method} +\title{Getter method of \code{mcmcoutputfixpost} class.} +\usage{ +\S4method{getPost}{mcmcoutputfixhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixpost} object.} +} +\value{ +The \code{post} slot of the \code{object}. +} +\description{ +Returns the \code{post} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use hierarchical sampling +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getPost(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getPost-mcmcoutputfixpost-method.Rd b/man/getPost-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..6493c38 --- /dev/null +++ b/man/getPost-mcmcoutputfixpost-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{getPost,mcmcoutputfixpost-method} +\alias{getPost,mcmcoutputfixpost-method} +\title{Getter method of \code{mcmcoutputfixpost} class.} +\usage{ +\S4method{getPost}{mcmcoutputfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixpost} object.} +} +\value{ +The \code{post} slot of the \code{object}. +} +\description{ +Returns the \code{post} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use hierarchical sampling +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getPost(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getPost-mcmcoutputhierpost-method.Rd b/man/getPost-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..fd8b3c2 --- /dev/null +++ b/man/getPost-mcmcoutputhierpost-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{getPost,mcmcoutputhierpost-method} +\alias{getPost,mcmcoutputhierpost-method} +\title{Getter method of \code{mcmcoutputhierpost} class.} +\usage{ +\S4method{getPost}{mcmcoutputhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputhierpost} object.} +} +\value{ +The \code{post} slot of the \code{object}. +} +\description{ +Returns the \code{post} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getPost(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} diff --git a/man/getPost-mcmcoutputpost-method.Rd b/man/getPost-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..22c9aa9 --- /dev/null +++ b/man/getPost-mcmcoutputpost-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{getPost,mcmcoutputpost-method} +\alias{getPost,mcmcoutputpost-method} +\title{Getter method of \code{mcmcoutputpost} class.} +\usage{ +\S4method{getPost}{mcmcoutputpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpost} object.} +} +\value{ +The \code{post} slot of the \code{object}. +} +\description{ +Returns the \code{post} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getPost(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpost} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getPost.Rd b/man/getPost.Rd new file mode 100644 index 0000000..f084e30 --- /dev/null +++ b/man/getPost.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getPost} +\alias{getPost} +\title{Getter for the \code{post} slot} +\usage{ +getPost(object) +} +\description{ +Getter for the \code{post} slot +} +\keyword{internal} diff --git a/man/getPostS-dataclass-method.Rd b/man/getPostS-dataclass-method.Rd new file mode 100644 index 0000000..ddd9f71 --- /dev/null +++ b/man/getPostS-dataclass-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{getPostS,dataclass-method} +\alias{getPostS,dataclass-method} +\title{Getter method of \code{dataclass} class.} +\usage{ +\S4method{getPostS}{dataclass}(object) +} +\arguments{ +\item{object}{An \code{dataclass} object.} +} +\value{ +The \code{postS} slot of the \code{object}. +} +\description{ +Returns the \code{postS} slot. Note that this slot is only non-null, if the +indicators have been simulated. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Classify observations +f_dataclass <- dataclass(f_data, f_model, simS = TRUE)[[1]] +getPostS(f_dataclass) + +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the base class +\item \code{\link[=dataclass]{dataclass()}} for the constructor of the \code{dataclass} class +} +} +\keyword{internal} diff --git a/man/getPostS.Rd b/man/getPostS.Rd new file mode 100644 index 0000000..7002868 --- /dev/null +++ b/man/getPostS.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getPostS} +\alias{getPostS} +\title{Getter for the \code{postS} slot} +\usage{ +getPostS(object) +} +\description{ +Getter for the \code{postS} slot +} +\keyword{internal} diff --git a/man/getPostperm-mcmcpermfixpost-method.Rd b/man/getPostperm-mcmcpermfixpost-method.Rd new file mode 100644 index 0000000..ba6cffe --- /dev/null +++ b/man/getPostperm-mcmcpermfixpost-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfixpost.R +\name{getPostperm,mcmcpermfixpost-method} +\alias{getPostperm,mcmcpermfixpost-method} +\title{Getter method of \code{mcmcpermfixpost} class.} +\usage{ +\S4method{getPostperm}{mcmcpermfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermfixpost} object.} +} +\value{ +The \code{postperm} slot of the \code{object}. +} +\description{ +Returns the \code{postperm} slot. +} +\examples{ +\dontrun{getMperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermfix} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getPostperm-mcmcpermindpost-method.Rd b/man/getPostperm-mcmcpermindpost-method.Rd new file mode 100644 index 0000000..e00dbca --- /dev/null +++ b/man/getPostperm-mcmcpermindpost-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermindpost.R +\name{getPostperm,mcmcpermindpost-method} +\alias{getPostperm,mcmcpermindpost-method} +\title{Getter method of \code{mcmcpermindpost} class.} +\usage{ +\S4method{getPostperm}{mcmcpermindpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermindpost} object.} +} +\value{ +The \code{postperm} slot of the \code{object}. +} +\description{ +Returns the \code{postperm} slot. +} +\examples{ +\dontrun{getPostperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermpost} for the inheriting class +\item \linkS4class{mcmcoutputpermhierpost} for the inheriting class with +hierarchical prior +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getPostperm.Rd b/man/getPostperm.Rd new file mode 100644 index 0000000..8a73df2 --- /dev/null +++ b/man/getPostperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getPostperm} +\alias{getPostperm} +\title{Getter for the \code{postperm} slot} +\usage{ +getPostperm(object) +} +\description{ +Getter for the \code{postperm} slot +} +\keyword{internal} diff --git a/man/getPrior-mcmcoutputfix-method.Rd b/man/getPrior-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..40b8d77 --- /dev/null +++ b/man/getPrior-mcmcoutputfix-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getPrior,mcmcoutputfix-method} +\alias{getPrior,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getPrior}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{prior} slot of the \code{object}. +} +\description{ +Returns the \code{prior} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getPrior(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getPrior.Rd b/man/getPrior.Rd new file mode 100644 index 0000000..79f62b8 --- /dev/null +++ b/man/getPrior.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getPrior} +\alias{getPrior} +\title{Getter for the \code{prior} slot} +\usage{ +getPrior(object) +} +\description{ +Getter for the \code{prior} slot +} +\keyword{internal} diff --git a/man/getProb-dataclass-method.Rd b/man/getProb-dataclass-method.Rd new file mode 100644 index 0000000..3597329 --- /dev/null +++ b/man/getProb-dataclass-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{getProb,dataclass-method} +\alias{getProb,dataclass-method} +\title{Getter method of \code{dataclass} class.} +\usage{ +\S4method{getProb}{dataclass}(object) +} +\arguments{ +\item{object}{An \code{dataclass} object.} +} +\value{ +The \code{prob} slot of the \code{object}. +} +\description{ +Returns the \code{prob} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Classify observations +f_dataclass <- dataclass(f_data, f_model, simS = FALSE) +getProb(f_dataclass) + +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the base class +\item \code{\link[=dataclass]{dataclass()}} for the constructor of the \code{dataclass} class +} +} +\keyword{internal} diff --git a/man/getProb.Rd b/man/getProb.Rd new file mode 100644 index 0000000..508d0af --- /dev/null +++ b/man/getProb.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getProb} +\alias{getProb} +\title{Getter for the \code{prob} slot} +\usage{ +getProb(object) +} +\description{ +Getter for the \code{prob} slot +} +\keyword{internal} diff --git a/man/getR-csdatamoments-method.Rd b/man/getR-csdatamoments-method.Rd new file mode 100644 index 0000000..f13e1fd --- /dev/null +++ b/man/getR-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getR,csdatamoments-method} +\alias{getR,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getR}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{R} slot of the \code{object}. +} +\description{ +Returns the \code{R} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getR(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getR-exponentialmodelmoments-method.Rd b/man/getR-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..02114b6 --- /dev/null +++ b/man/getR-exponentialmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{getR,exponentialmodelmoments-method} +\alias{getR,exponentialmodelmoments-method} +\title{Getter method of \code{exponentialmodelmoments} class.} +\usage{ +\S4method{getR}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +The \code{R} slot of the \code{object}. +} +\description{ +Returns the \code{R} slot. +} +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getR(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getR-fdata-method.Rd b/man/getR-fdata-method.Rd new file mode 100644 index 0000000..3e3effe --- /dev/null +++ b/man/getR-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getR,fdata-method} +\alias{getR,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getR}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{r} slot of the \code{object}. +} +\description{ +Returns the \code{r} slot of an \code{fdata} object. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getR(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getR-model-method.Rd b/man/getR-model-method.Rd new file mode 100644 index 0000000..8d39f77 --- /dev/null +++ b/man/getR-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getR,model-method} +\alias{getR,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getR}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{r} slot of the \code{object}. +} +\description{ +Returns the \code{r} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getR(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getR-normalmodelmoments-method.Rd b/man/getR-normalmodelmoments-method.Rd new file mode 100644 index 0000000..5f1b276 --- /dev/null +++ b/man/getR-normalmodelmoments-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{getR,normalmodelmoments-method} +\alias{getR,normalmodelmoments-method} +\title{Getter method of \code{normalmodelmoments} class.} +\usage{ +\S4method{getR}{normalmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object.} +} +\value{ +The \code{R} slot of the \code{object}. +} +\description{ +Returns the \code{R} slot. +} +\examples{ +f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +means <- c(-2, 2) +sigmas <- matrix(c(2, 4), nrow=1) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getR(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getR-studentmodelmoments-method.Rd b/man/getR-studentmodelmoments-method.Rd new file mode 100644 index 0000000..029c8d0 --- /dev/null +++ b/man/getR-studentmodelmoments-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{getR,studentmodelmoments-method} +\alias{getR,studentmodelmoments-method} +\title{Getter method of \code{studentmodelmoments} class.} +\usage{ +\S4method{getR}{studentmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studentmodelmoments} object.} +} +\value{ +The \code{R} slot of the \code{object}. +} +\description{ +Returns the \code{R} slot. +} +\examples{ +f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +means <- c(-2, 2) +sigmas <- matrix(c(2, 4), nrow=1) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(20, 40)) +f_moments <- modelmoments(f_model) +getR(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getR.Rd b/man/getR.Rd new file mode 100644 index 0000000..15af8a7 --- /dev/null +++ b/man/getR.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getR} +\alias{getR} +\title{Getter for the \code{r} slot} +\usage{ +getR(object) +} +\description{ +Getter for the \code{r} slot +} +\keyword{internal} diff --git a/man/getRanperm-mcmc-method.Rd b/man/getRanperm-mcmc-method.Rd new file mode 100644 index 0000000..9a7609e --- /dev/null +++ b/man/getRanperm-mcmc-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{getRanperm,mcmc-method} +\alias{getRanperm,mcmc-method} +\title{Getter method of \code{mcmc} class.} +\usage{ +\S4method{getRanperm}{mcmc}(object) +} +\arguments{ +\item{object}{An \code{mcmc} object.} +} +\value{ +The \code{ranperm} slot of the \code{object}. +} +\description{ +Returns the \code{ranperm} slot. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Get the slot +getRanperm(f_mcmc) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/getRanperm-mcmcestfix-method.Rd b/man/getRanperm-mcmcestfix-method.Rd new file mode 100644 index 0000000..6d5da73 --- /dev/null +++ b/man/getRanperm-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getRanperm,mcmcestfix-method} +\alias{getRanperm,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getRanperm}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{ranperm} slot of the \code{object}. +} +\description{ +Returns the \code{ranperm} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getRanperm(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getRanperm-mcmcoutputfix-method.Rd b/man/getRanperm-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..4d50145 --- /dev/null +++ b/man/getRanperm-mcmcoutputfix-method.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{getRanperm,mcmcoutputfix-method} +\alias{getRanperm,mcmcoutputfix-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getRanperm}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{ranperm} slot of the \code{object}. +} +\description{ +Returns the \code{ranperm} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getRanperm(f_output) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getRanperm.Rd b/man/getRanperm.Rd new file mode 100644 index 0000000..7948f0d --- /dev/null +++ b/man/getRanperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRanperm} +\alias{getRanperm} +\title{Getter for the \code{ranperm} slot} +\usage{ +getRanperm(object) +} +\description{ +Getter for the \code{ranperm} slot +} +\keyword{internal} diff --git a/man/getRdet-csdatamoments-method.Rd b/man/getRdet-csdatamoments-method.Rd new file mode 100644 index 0000000..ba670f3 --- /dev/null +++ b/man/getRdet-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getRdet,csdatamoments-method} +\alias{getRdet,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getRdet}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{Rdet} slot of the \code{object}. +} +\description{ +Returns the \code{Rdet} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getRdet(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getRdet-normultmodelmoments-method.Rd b/man/getRdet-normultmodelmoments-method.Rd new file mode 100644 index 0000000..8629d6b --- /dev/null +++ b/man/getRdet-normultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{getRdet,normultmodelmoments-method} +\alias{getRdet,normultmodelmoments-method} +\title{Getter method of \code{normultmodelmoments} class.} +\usage{ +\S4method{getRdet}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +The \code{Rdet} slot of the \code{object}. +} +\description{ +Returns the \code{Rdet} slot. +} +\examples{ +f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getRdet(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getRdet-studmultmodelmoments-method.Rd b/man/getRdet-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..22fa017 --- /dev/null +++ b/man/getRdet-studmultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{getRdet,studmultmodelmoments-method} +\alias{getRdet,studmultmodelmoments-method} +\title{Getter method of \code{studmultmodelmoments} class.} +\usage{ +\S4method{getRdet}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +The \code{Rdet} slot of the \code{object}. +} +\description{ +Returns the \code{Rdet} slot. +} +\examples{ +f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +f_moments <- modelmoments(f_model) +getRdet(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getRdet.Rd b/man/getRdet.Rd new file mode 100644 index 0000000..d084337 --- /dev/null +++ b/man/getRdet.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRdet} +\alias{getRdet} +\title{Getter for the \code{Rdet} slot} +\usage{ +getRdet(object) +} +\description{ +Getter for the \code{Rdet} slot +} +\keyword{internal} diff --git a/man/getRelabel-mcmcestfix-method.Rd b/man/getRelabel-mcmcestfix-method.Rd new file mode 100644 index 0000000..8baac4d --- /dev/null +++ b/man/getRelabel-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getRelabel,mcmcestfix-method} +\alias{getRelabel,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getRelabel}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{relabel} slot of the \code{object}. +} +\description{ +Returns the \code{relabel} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getRelabel(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getRelabel-mcmcpermind-method.Rd b/man/getRelabel-mcmcpermind-method.Rd new file mode 100644 index 0000000..e030c65 --- /dev/null +++ b/man/getRelabel-mcmcpermind-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\name{getRelabel,mcmcpermind-method} +\alias{getRelabel,mcmcpermind-method} +\title{Getter method of \code{mcmcpermind} class.} +\usage{ +\S4method{getRelabel}{mcmcpermind}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermind} object.} +} +\value{ +The \code{relabel} slot of the \code{object}. +} +\description{ +Returns the \code{relabel} slot. +} +\examples{ +\dontrun{getRelabel(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermbase} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getRelabel.Rd b/man/getRelabel.Rd new file mode 100644 index 0000000..12cf2ee --- /dev/null +++ b/man/getRelabel.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRelabel} +\alias{getRelabel} +\title{Getter for the \code{relabel} slot} +\usage{ +getRelabel(object) +} +\description{ +Getter for the \code{relabel} slot +} +\keyword{internal} diff --git a/man/getRowExp-fdata-method.Rd b/man/getRowExp-fdata-method.Rd new file mode 100644 index 0000000..f6df800 --- /dev/null +++ b/man/getRowExp-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getRowExp,fdata-method} +\alias{getRowExp,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getRowExp}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{exp} slot of the \code{object} as a row-ordered matrix. +} +\description{ +Returns the \code{exp} slot as a row-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowExp(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getRowExp.Rd b/man/getRowExp.Rd new file mode 100644 index 0000000..8312b99 --- /dev/null +++ b/man/getRowExp.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRowExp} +\alias{getRowExp} +\title{Getter for the \code{exp} slot in row format} +\usage{ +getRowExp(object) +} +\description{ +Getter for the \code{exp} slot in row format +} +\keyword{internal} diff --git a/man/getRowS-fdata-method.Rd b/man/getRowS-fdata-method.Rd new file mode 100644 index 0000000..ae1cf7b --- /dev/null +++ b/man/getRowS-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getRowS,fdata-method} +\alias{getRowS,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getRowS}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{S} slot of the \code{object} as a row-ordered matrix. +} +\description{ +Returns the \code{S} slot as a row-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowS(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getRowS.Rd b/man/getRowS.Rd new file mode 100644 index 0000000..f07f095 --- /dev/null +++ b/man/getRowS.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRowS} +\alias{getRowS} +\title{Getter for the \code{S} slot in row format} +\usage{ +getRowS(object) +} +\description{ +Getter for the \code{S} slot in row format +} +\keyword{internal} diff --git a/man/getRowT-fdata-method.Rd b/man/getRowT-fdata-method.Rd new file mode 100644 index 0000000..b040255 --- /dev/null +++ b/man/getRowT-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getRowT,fdata-method} +\alias{getRowT,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getRowT}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{T} slot of the \code{object} as a row-ordered matrix. +} +\description{ +Returns the \code{T} slot as a row-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowT(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getRowT.Rd b/man/getRowT.Rd new file mode 100644 index 0000000..935fc44 --- /dev/null +++ b/man/getRowT.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRowT} +\alias{getRowT} +\title{Getter for the \code{T} slot in row format} +\usage{ +getRowT(object) +} +\description{ +Getter for the \code{T} slot in row format +} +\keyword{internal} diff --git a/man/getRowY-fdata-method.Rd b/man/getRowY-fdata-method.Rd new file mode 100644 index 0000000..ce06c83 --- /dev/null +++ b/man/getRowY-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getRowY,fdata-method} +\alias{getRowY,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getRowY}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{y} slot of the \code{object} as a row-ordered matrix. +} +\description{ +Returns the \code{y} slot as a row-ordered matrix. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getRowY(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getRowY.Rd b/man/getRowY.Rd new file mode 100644 index 0000000..7c6a855 --- /dev/null +++ b/man/getRowY.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRowY} +\alias{getRowY} +\title{Getter for the \code{y} slot in row format} +\usage{ +getRowY(object) +} +\description{ +Getter for the \code{y} slot in row format +} +\keyword{internal} diff --git a/man/getRtr-csdatamoments-method.Rd b/man/getRtr-csdatamoments-method.Rd new file mode 100644 index 0000000..e5e9ac7 --- /dev/null +++ b/man/getRtr-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getRtr,csdatamoments-method} +\alias{getRtr,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getRtr}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{Rtr} slot of the \code{object}. +} +\description{ +Returns the \code{Rtr} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getRtr(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getRtr-normultmodelmoments-method.Rd b/man/getRtr-normultmodelmoments-method.Rd new file mode 100644 index 0000000..ec94246 --- /dev/null +++ b/man/getRtr-normultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{getRtr,normultmodelmoments-method} +\alias{getRtr,normultmodelmoments-method} +\title{Getter method of \code{normultmodelmoments} class.} +\usage{ +\S4method{getRtr}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +The \code{Rtr} slot of the \code{object}. +} +\description{ +Returns the \code{Rtr} slot. +} +\examples{ +f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getRtr(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getRtr-studmultmodelmoments-method.Rd b/man/getRtr-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..7d73b6a --- /dev/null +++ b/man/getRtr-studmultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{getRtr,studmultmodelmoments-method} +\alias{getRtr,studmultmodelmoments-method} +\title{Getter method of \code{studmultmodelmoments} class.} +\usage{ +\S4method{getRtr}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +The \code{Rtr} slot of the \code{object}. +} +\description{ +Returns the \code{Rtr} slot. +} +\examples{ +f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +f_moments <- modelmoments(f_model) +getRtr(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getRtr.Rd b/man/getRtr.Rd new file mode 100644 index 0000000..b0a0d81 --- /dev/null +++ b/man/getRtr.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getRtr} +\alias{getRtr} +\title{Getter for the \code{Rtr} slot} +\usage{ +getRtr(object) +} +\description{ +Getter for the \code{Rtr} slot +} +\keyword{internal} diff --git a/man/getS-fdata-method.Rd b/man/getS-fdata-method.Rd new file mode 100644 index 0000000..31de6e8 --- /dev/null +++ b/man/getS-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getS,fdata-method} +\alias{getS,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getS}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{S} slot of the \code{object} in the order defined \code{bycolumn}. +} +\description{ +Returns the \code{S} slot in the order defined by the slot \code{bycolumn}. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getS(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getS-mcmcoutputbase-method.Rd b/man/getS-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..d4e3da0 --- /dev/null +++ b/man/getS-mcmcoutputbase-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{getS,mcmcoutputbase-method} +\alias{getS,mcmcoutputbase-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getS}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{S} slot of the \code{object}. +} +\description{ +Returns the \code{S} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getS(f_output) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputbase-class]{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getS.Rd b/man/getS.Rd new file mode 100644 index 0000000..f67d97a --- /dev/null +++ b/man/getS.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getS} +\alias{getS} +\title{Getter for the \code{S} slot} +\usage{ +getS(object) +} +\description{ +Getter for the \code{S} slot +} +\keyword{internal} diff --git a/man/getST-mcmcoutputbase-method.Rd b/man/getST-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..1103dd8 --- /dev/null +++ b/man/getST-mcmcoutputbase-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{getST,mcmcoutputbase-method} +\alias{getST,mcmcoutputbase-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getST}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{ST} slot of the \code{object}. +} +\description{ +Returns the \code{ST} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getST(f_output) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputbase-class]{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getST.Rd b/man/getST.Rd new file mode 100644 index 0000000..73dfb2e --- /dev/null +++ b/man/getST.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getST} +\alias{getST} +\title{Getter for the \code{ST} slot} +\usage{ +getST(object) +} +\description{ +Getter for the \code{ST} slot +} +\keyword{internal} diff --git a/man/getSTperm-mcmcpermind-method.Rd b/man/getSTperm-mcmcpermind-method.Rd new file mode 100644 index 0000000..97c4a4f --- /dev/null +++ b/man/getSTperm-mcmcpermind-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\name{getSTperm,mcmcpermind-method} +\alias{getSTperm,mcmcpermind-method} +\title{Getter method of \code{mcmcpermind} class.} +\usage{ +\S4method{getSTperm}{mcmcpermind}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermind} object.} +} +\value{ +The \code{STperm} slot of the \code{object}. +} +\description{ +Returns the \code{STperm} slot. +} +\examples{ +\dontrun{getSTperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermbase} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getSTperm.Rd b/man/getSTperm.Rd new file mode 100644 index 0000000..36fc6dc --- /dev/null +++ b/man/getSTperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getSTperm} +\alias{getSTperm} +\title{Getter for the \code{STperm} slot} +\usage{ +getSTperm(object) +} +\description{ +Getter for the \code{STperm} slot +} +\keyword{internal} diff --git a/man/getSdpost-mcmcestfix-method.Rd b/man/getSdpost-mcmcestfix-method.Rd new file mode 100644 index 0000000..aad6425 --- /dev/null +++ b/man/getSdpost-mcmcestfix-method.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{getSdpost,mcmcestfix-method} +\alias{getSdpost,mcmcestfix-method} +\title{Getter method of \code{mcmcestfix} class.} +\usage{ +\S4method{getSdpost}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +The \code{sdpost} slot of the \code{object}. +} +\description{ +Returns the \code{sdpost} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_est <- mcmcestimate(f_output) +# Get the slot. +getIeavg(f_est) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the corresponding class for models +with unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} for calculating point estimates from MCMC samples +} +} +\keyword{internal} diff --git a/man/getSdpost.Rd b/man/getSdpost.Rd new file mode 100644 index 0000000..08a200b --- /dev/null +++ b/man/getSdpost.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getSdpost} +\alias{getSdpost} +\title{Getter for the \code{sdpost} slot} +\usage{ +getSdpost(object) +} +\description{ +Getter for the \code{sdpost} slot +} +\keyword{internal} diff --git a/man/getSim-fdata-method.Rd b/man/getSim-fdata-method.Rd new file mode 100644 index 0000000..9fd11aa --- /dev/null +++ b/man/getSim-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getSim,fdata-method} +\alias{getSim,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getSim}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{sim} slot of the \code{object}. +} +\description{ +Returns the \code{sim} slot of an \code{fdata} object. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getSim(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getSim.Rd b/man/getSim.Rd new file mode 100644 index 0000000..60cd12d --- /dev/null +++ b/man/getSim.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getSim} +\alias{getSim} +\title{Getter for the \code{sim} format} +\usage{ +getSim(object) +} +\description{ +Getter for the \code{sim} format +} +\keyword{internal} diff --git a/man/getSkewness-cdatamoments-method.Rd b/man/getSkewness-cdatamoments-method.Rd new file mode 100644 index 0000000..56f10bb --- /dev/null +++ b/man/getSkewness-cdatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{getSkewness,cdatamoments-method} +\alias{getSkewness,cdatamoments-method} +\title{Getter method of \code{cdatamoments} class.} +\usage{ +\S4method{getSkewness}{cdatamoments}(object) +} +\arguments{ +\item{object}{An \code{cdatamoments} object.} +} +\value{ +The \code{skewness} slot of the \code{object}. +} +\description{ +Returns the \code{skewness} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Use the getter. +getSkewness(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getSkewness-cmodelmoments-method.Rd b/man/getSkewness-cmodelmoments-method.Rd new file mode 100644 index 0000000..e3f93ed --- /dev/null +++ b/man/getSkewness-cmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmodelmoments.R +\name{getSkewness,cmodelmoments-method} +\alias{getSkewness,cmodelmoments-method} +\title{Getter method of \code{cmodelmoments} class.} +\usage{ +\S4method{getSkewness}{cmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{cmodelmoments} object.} +} +\value{ +The \code{skewness} slot of the \code{object}. +} +\description{ +Returns the \code{skewness} slot. +} +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getSkewness(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getSkewness.Rd b/man/getSkewness.Rd new file mode 100644 index 0000000..b5c8860 --- /dev/null +++ b/man/getSkewness.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getSkewness} +\alias{getSkewness} +\title{Getter for the \code{skewness} slot} +\usage{ +getSkewness(object) +} +\description{ +Getter for the \code{skewness} slot +} +\keyword{internal} diff --git a/man/getSmoments-cdatamoments-method.Rd b/man/getSmoments-cdatamoments-method.Rd new file mode 100644 index 0000000..b8c1f75 --- /dev/null +++ b/man/getSmoments-cdatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{getSmoments,cdatamoments-method} +\alias{getSmoments,cdatamoments-method} +\title{Getter method of \code{cdatamoments} class.} +\usage{ +\S4method{getSmoments}{cdatamoments}(object) +} +\arguments{ +\item{object}{An \code{cdatamoments} object.} +} +\value{ +The \code{smoments} slot of the \code{object}. +} +\description{ +Returns the \code{smoments} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Get the moments for the included indicators of the data. +getSmoments(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getSmoments-ddatamoments-method.Rd b/man/getSmoments-ddatamoments-method.Rd new file mode 100644 index 0000000..bd10b07 --- /dev/null +++ b/man/getSmoments-ddatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{getSmoments,ddatamoments-method} +\alias{getSmoments,ddatamoments-method} +\title{Getter method of \code{ddatamoments} class.} +\usage{ +\S4method{getSmoments}{ddatamoments}(object) +} +\arguments{ +\item{object}{An \code{ddatamoments} object.} +} +\value{ +The \code{smoments} slot of the \code{object}. +} +\description{ +Returns the \code{smoments} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Get the moments for the included indicators of the data. +getSmoments(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getSmoments.Rd b/man/getSmoments.Rd new file mode 100644 index 0000000..772f35d --- /dev/null +++ b/man/getSmoments.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getSmoments} +\alias{getSmoments} +\title{Getter for the \code{smoments} slot} +\usage{ +getSmoments(object) +} +\description{ +Getter for the \code{smoments} slot +} +\keyword{internal} diff --git a/man/getSperm-mcmcpermind-method.Rd b/man/getSperm-mcmcpermind-method.Rd new file mode 100644 index 0000000..fa66b63 --- /dev/null +++ b/man/getSperm-mcmcpermind-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\name{getSperm,mcmcpermind-method} +\alias{getSperm,mcmcpermind-method} +\title{Getter method of \code{mcmcpermind} class.} +\usage{ +\S4method{getSperm}{mcmcpermind}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermind} object.} +} +\value{ +The \code{Sperm} slot of the \code{object}. +} +\description{ +Returns the \code{Sperm} slot. +} +\examples{ +\dontrun{getSperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermbase} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getSperm.Rd b/man/getSperm.Rd new file mode 100644 index 0000000..a9e3f01 --- /dev/null +++ b/man/getSperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getSperm} +\alias{getSperm} +\title{Getter for the \code{Sperm} slot} +\usage{ +getSperm(object) +} +\description{ +Getter for the \code{Sperm} slot +} +\keyword{internal} diff --git a/man/getStartpar-mcmc-method.Rd b/man/getStartpar-mcmc-method.Rd new file mode 100644 index 0000000..e9f49f0 --- /dev/null +++ b/man/getStartpar-mcmc-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{getStartpar,mcmc-method} +\alias{getStartpar,mcmc-method} +\title{Getter method of \code{mcmc} class.} +\usage{ +\S4method{getStartpar}{mcmc}(object) +} +\arguments{ +\item{object}{An \code{mcmc} object.} +} +\value{ +The \code{startpar} slot of the \code{object}. +} +\description{ +Returns the \code{startpar} slot. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Get the slot +getStartpar(f_mcmc) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/getStartpar.Rd b/man/getStartpar.Rd new file mode 100644 index 0000000..a1131b5 --- /dev/null +++ b/man/getStartpar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getStartpar} +\alias{getStartpar} +\title{Getter for the \code{startpar} slot} +\usage{ +getStartpar(object) +} +\description{ +Getter for the \code{startpar} slot +} +\keyword{internal} diff --git a/man/getStoreS-mcmc-method.Rd b/man/getStoreS-mcmc-method.Rd new file mode 100644 index 0000000..c397cbf --- /dev/null +++ b/man/getStoreS-mcmc-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{getStoreS,mcmc-method} +\alias{getStoreS,mcmc-method} +\title{Getter method of \code{mcmc} class.} +\usage{ +\S4method{getStoreS}{mcmc}(object) +} +\arguments{ +\item{object}{An \code{mcmc} object.} +} +\value{ +The \code{storeS} slot of the \code{object}. +} +\description{ +Returns the \code{storeS} slot. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Get the slot +getStoreS(f_mcmc) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/getStoreS.Rd b/man/getStoreS.Rd new file mode 100644 index 0000000..19f1cf9 --- /dev/null +++ b/man/getStoreS.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getStoreS} +\alias{getStoreS} +\title{Getter for the \code{storeS} slot} +\usage{ +getStoreS(object) +} +\description{ +Getter for the \code{storeS} slot +} +\keyword{internal} diff --git a/man/getStorepost-mcmc-method.Rd b/man/getStorepost-mcmc-method.Rd new file mode 100644 index 0000000..64834aa --- /dev/null +++ b/man/getStorepost-mcmc-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{getStorepost,mcmc-method} +\alias{getStorepost,mcmc-method} +\title{Getter method of \code{mcmc} class.} +\usage{ +\S4method{getStorepost}{mcmc}(object) +} +\arguments{ +\item{object}{An \code{mcmc} object.} +} +\value{ +The \code{storepost} slot of the \code{object}. +} +\description{ +Returns the \code{storepost} slot. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Get the slot +getStorepost(f_mcmc) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/getStorepost.Rd b/man/getStorepost.Rd new file mode 100644 index 0000000..74f85f9 --- /dev/null +++ b/man/getStorepost.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getStorepost} +\alias{getStorepost} +\title{Getter for the \code{storepost} slot} +\usage{ +getStorepost(object) +} +\description{ +Getter for the \code{storepost} slot +} +\keyword{internal} diff --git a/man/getT-csdatamoments-method.Rd b/man/getT-csdatamoments-method.Rd new file mode 100644 index 0000000..fd621c0 --- /dev/null +++ b/man/getT-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getT,csdatamoments-method} +\alias{getT,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getT}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{T} slot of the \code{object}. +} +\description{ +Returns the \code{T} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getT(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getT-fdata-method.Rd b/man/getT-fdata-method.Rd new file mode 100644 index 0000000..9655355 --- /dev/null +++ b/man/getT-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getT,fdata-method} +\alias{getT,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getT}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{T} slot of the \code{object} in the order defined \code{bycolumn}. +} +\description{ +Returns the \code{T} slot in the order defined by the slot \code{bycolumn}. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getT(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getT-model-method.Rd b/man/getT-model-method.Rd new file mode 100644 index 0000000..60868a3 --- /dev/null +++ b/man/getT-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getT,model-method} +\alias{getT,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getT}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{T} slot of the \code{object}. +} +\description{ +Returns the \code{T} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getT(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getT.Rd b/man/getT.Rd new file mode 100644 index 0000000..da1a630 --- /dev/null +++ b/man/getT.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getT} +\alias{getT} +\title{Getter for the \code{T} slot} +\usage{ +getT(object) +} +\description{ +Getter for the \code{T} slot +} +\keyword{internal} diff --git a/man/getType-fdata-method.Rd b/man/getType-fdata-method.Rd new file mode 100644 index 0000000..fa90466 --- /dev/null +++ b/man/getType-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getType,fdata-method} +\alias{getType,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getType}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{type} slot of the \code{object}. +} +\description{ +Returns the \code{type} slot of an \code{fdata} object. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getType(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getType-prior-method.Rd b/man/getType-prior-method.Rd new file mode 100644 index 0000000..b97240c --- /dev/null +++ b/man/getType-prior-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{getType,prior-method} +\alias{getType,prior-method} +\title{Getter method of \code{prior} class.} +\usage{ +\S4method{getType}{prior}(object) +} +\arguments{ +\item{object}{An \code{prior} object.} +} +\value{ +The \code{type} slot of the \code{object}. +} +\description{ +Returns the \code{type} slot. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Get the slot. +getType(f_prior) +} +\keyword{internal} diff --git a/man/getType.Rd b/man/getType.Rd new file mode 100644 index 0000000..fbd608b --- /dev/null +++ b/man/getType.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getType} +\alias{getType} +\title{Getter for the \code{type} format} +\usage{ +getType(object) +} +\description{ +Getter for the \code{type} format +} +\keyword{internal} diff --git a/man/getVar-groupmoments-method.Rd b/man/getVar-groupmoments-method.Rd new file mode 100644 index 0000000..6b599e6 --- /dev/null +++ b/man/getVar-groupmoments-method.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{getVar,groupmoments-method} +\alias{getVar,groupmoments-method} +\title{Getter method of \code{groupmoments} class.} +\usage{ +\S4method{getVar}{groupmoments}(object) +} +\arguments{ +\item{object}{An \code{groupmoments} object.} +} +\value{ +The \code{Var} slot of the \code{object}. +} +\description{ +Returns the \code{Var} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_gmoments <- groupmoments(f_data) +# Get the moments for the included indicators of the data. +getVar(f_gmoments) + +} +\seealso{ +\itemize{ +\item \linkS4class{groupmoments} for the definition of the \code{groupmoments} +class +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/getVar-modelmoments-method.Rd b/man/getVar-modelmoments-method.Rd new file mode 100644 index 0000000..6ee2385 --- /dev/null +++ b/man/getVar-modelmoments-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelmoments.R +\name{getVar,modelmoments-method} +\alias{getVar,modelmoments-method} +\title{Getter method of \code{modelmoments} class.} +\usage{ +\S4method{getVar}{modelmoments}(object) +} +\arguments{ +\item{object}{A \code{modelmoments} object.} +} +\value{ +The \code{var} slot of the \code{object}. +} +\description{ +Returns the \code{var} slot of a \code{modelmoments} object. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getVar(f_moments) + +} +\seealso{ +\linkS4class{modelmoments} for all slots of the \code{modelmoments} class +} +\keyword{internal} diff --git a/man/getVar.Rd b/man/getVar.Rd new file mode 100644 index 0000000..0b151a3 --- /dev/null +++ b/man/getVar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getVar} +\alias{getVar} +\title{Getter for the \code{var} slot} +\usage{ +getVar(object) +} +\description{ +Getter for the \code{var} slot +} +\keyword{internal} diff --git a/man/getW-csdatamoments-method.Rd b/man/getW-csdatamoments-method.Rd new file mode 100644 index 0000000..11189d1 --- /dev/null +++ b/man/getW-csdatamoments-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{getW,csdatamoments-method} +\alias{getW,csdatamoments-method} +\title{Getter method of \code{csdatamoments} class.} +\usage{ +\S4method{getW}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +The \code{W} slot of the \code{object}. +} +\description{ +Returns the \code{W} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_sdatamoms <- sdatamoments(f_data) +# Get the moments for the included indicators of the data. +getW(f_sdatamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} +class family +\item \linkS4class{csdatamoments} for the class definition +\item \code{\link[=sdatamoments]{sdatamoments()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/getW-exponentialmodelmoments-method.Rd b/man/getW-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..6883e15 --- /dev/null +++ b/man/getW-exponentialmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{getW,exponentialmodelmoments-method} +\alias{getW,exponentialmodelmoments-method} +\title{Getter method of \code{exponentialmodelmoments} class.} +\usage{ +\S4method{getW}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +The \code{W} slot of the \code{object}. +} +\description{ +Returns the \code{W} slot. +} +\examples{ +f_model <- model("exponential", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getW(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getW-normalmodelmoments-method.Rd b/man/getW-normalmodelmoments-method.Rd new file mode 100644 index 0000000..49a8014 --- /dev/null +++ b/man/getW-normalmodelmoments-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{getW,normalmodelmoments-method} +\alias{getW,normalmodelmoments-method} +\title{Getter method of \code{normalmodelmoments} class.} +\usage{ +\S4method{getW}{normalmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object.} +} +\value{ +The \code{W} slot of the \code{object}. +} +\description{ +Returns the \code{W} slot. +} +\examples{ +f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +means <- c(-2, 2) +sigmas <- matrix(c(2, 4), nrow=1) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getW(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getW-normultmodelmoments-method.Rd b/man/getW-normultmodelmoments-method.Rd new file mode 100644 index 0000000..ef67721 --- /dev/null +++ b/man/getW-normultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{getW,normultmodelmoments-method} +\alias{getW,normultmodelmoments-method} +\title{Getter method of \code{normultmodelmoments} class.} +\usage{ +\S4method{getW}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +The \code{W} slot of the \code{object}. +} +\description{ +Returns the \code{W} slot. +} +\examples{ +f_model <- model("normult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas) +f_moments <- modelmoments(f_model) +getW(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getW-studentmodelmoments-method.Rd b/man/getW-studentmodelmoments-method.Rd new file mode 100644 index 0000000..a825140 --- /dev/null +++ b/man/getW-studentmodelmoments-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{getW,studentmodelmoments-method} +\alias{getW,studentmodelmoments-method} +\title{Getter method of \code{studentmodelmoments} class.} +\usage{ +\S4method{getW}{studentmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studentmodelmoments} object.} +} +\value{ +The \code{W} slot of the \code{object}. +} +\description{ +Returns the \code{W} slot. +} +\examples{ +f_model <- model("normal", weight = matrix(c(.3, .7), nrow = 1)) +means <- c(-2, 2) +sigmas <- matrix(c(2, 4), nrow=1) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(20, 40)) +f_moments <- modelmoments(f_model) +getW(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getW-studmultmodelmoments-method.Rd b/man/getW-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..0c82822 --- /dev/null +++ b/man/getW-studmultmodelmoments-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{getW,studmultmodelmoments-method} +\alias{getW,studmultmodelmoments-method} +\title{Getter method of \code{studmultmodelmoments} class.} +\usage{ +\S4method{getW}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +The \code{W} slot of the \code{object}. +} +\description{ +Returns the \code{W} slot. +} +\examples{ +f_model <- model("studmult", weight = matrix(c(.3, .7), nrow = 1)) +means <- matrix(c(-2, -2, 2, 2),nrow = 2) +covar <- matrix(c(1, 1.2, 1.2, 4), nrow = 2) +sigmas <- array(c(covar, 2*covar), dim = c(2, 2, 2)) +setPar(f_model) <- list(mu = means, sigma = sigmas, df = c(10, 20)) +f_moments <- modelmoments(f_model) +getW(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getW.Rd b/man/getW.Rd new file mode 100644 index 0000000..e4423a4 --- /dev/null +++ b/man/getW.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getW} +\alias{getW} +\title{Getter for the \code{W} slot} +\usage{ +getW(object) +} +\description{ +Getter for the \code{W} slot +} +\keyword{internal} diff --git a/man/getWK-groupmoments-method.Rd b/man/getWK-groupmoments-method.Rd new file mode 100644 index 0000000..8120730 --- /dev/null +++ b/man/getWK-groupmoments-method.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{getWK,groupmoments-method} +\alias{getWK,groupmoments-method} +\title{Getter method of \code{groupmoments} class.} +\usage{ +\S4method{getWK}{groupmoments}(object) +} +\arguments{ +\item{object}{An \code{groupmoments} object.} +} +\value{ +The \code{WK} slot of the \code{object}. +} +\description{ +Returns the \code{WK} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_gmoments <- groupmoments(f_data) +# Get the moments for the included indicators of the data. +getWK(f_gmoments) + +} +\seealso{ +\itemize{ +\item \linkS4class{groupmoments} for the definition of the \code{groupmoments} +class +\item \code{\link[=groupmoments]{groupmoments()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/getWK.Rd b/man/getWK.Rd new file mode 100644 index 0000000..cdaad8e --- /dev/null +++ b/man/getWK.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getWK} +\alias{getWK} +\title{Setter for the \code{WK} slot} +\usage{ +getWK(object) +} +\description{ +Setter for the \code{WK} slot +} +\keyword{internal} diff --git a/man/getWeight-mcmcoutputbase-method.Rd b/man/getWeight-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..3377776 --- /dev/null +++ b/man/getWeight-mcmcoutputbase-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{getWeight,mcmcoutputbase-method} +\alias{getWeight,mcmcoutputbase-method} +\title{Getter method of \code{mcmcoutput} class.} +\usage{ +\S4method{getWeight}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object.} +} +\value{ +The \code{weight} slot of the \code{object}. +} +\description{ +Returns the \code{weight} slot. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Get the slot. +getWeight(f_output) + +} +\seealso{ +\itemize{ +\item \link[=mcmcoutputbase-class]{mcmcoutput} for the class definition +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +} +} +\keyword{internal} diff --git a/man/getWeight-model-method.Rd b/man/getWeight-model-method.Rd new file mode 100644 index 0000000..1a6376c --- /dev/null +++ b/man/getWeight-model-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{getWeight,model-method} +\alias{getWeight,model-method} +\title{Getter method of \code{model} class.} +\usage{ +\S4method{getWeight}{model}(object) +} +\arguments{ +\item{object}{An \code{model} object.} +} +\value{ +The \code{weight} slot of the \code{object}. +} +\description{ +Returns the \code{weight} slot. +} +\examples{ +# Generate an exponential mixture model with two components. +f_model <- model("exponential", par = list(lambda = c(0.3, 0.7)), K = 2) +# Get the slot +getWeight(f_model) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/getWeight-prior-method.Rd b/man/getWeight-prior-method.Rd new file mode 100644 index 0000000..94e56c8 --- /dev/null +++ b/man/getWeight-prior-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{getWeight,prior-method} +\alias{getWeight,prior-method} +\title{Getter method of \code{prior} class.} +\usage{ +\S4method{getWeight}{prior}(object) +} +\arguments{ +\item{object}{An \code{prior} object.} +} +\value{ +The \code{weight} slot of the \code{object}. +} +\description{ +Returns the \code{weight} slot. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Get the slot. +getWeight(f_prior) +} +\keyword{internal} diff --git a/man/getWeight.Rd b/man/getWeight.Rd new file mode 100644 index 0000000..4688a50 --- /dev/null +++ b/man/getWeight.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getWeight} +\alias{getWeight} +\title{Getter for the \code{weight} slot} +\usage{ +getWeight(object) +} +\description{ +Getter for the \code{weight} slot +} +\keyword{internal} diff --git a/man/getWeightperm-mcmcpermind-method.Rd b/man/getWeightperm-mcmcpermind-method.Rd new file mode 100644 index 0000000..2209ebd --- /dev/null +++ b/man/getWeightperm-mcmcpermind-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\name{getWeightperm,mcmcpermind-method} +\alias{getWeightperm,mcmcpermind-method} +\title{Getter method of \code{mcmcpermind} class.} +\usage{ +\S4method{getWeightperm}{mcmcpermind}(object) +} +\arguments{ +\item{object}{An \code{mcmcpermind} object.} +} +\value{ +The \code{weightperm} slot of the \code{object}. +} +\description{ +Returns the \code{weightperm} slot. +} +\examples{ +\dontrun{getWeightperm(mcmcperm)} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermbase} for the inheriting class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for function permuting MCMC samples +} +} +\keyword{internal} diff --git a/man/getWeightperm.Rd b/man/getWeightperm.Rd new file mode 100644 index 0000000..383f637 --- /dev/null +++ b/man/getWeightperm.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getWeightperm} +\alias{getWeightperm} +\title{Getter for the \code{weightperm} slot} +\usage{ +getWeightperm(object) +} +\description{ +Getter for the \code{weightperm} slot +} +\keyword{internal} diff --git a/man/getY-fdata-method.Rd b/man/getY-fdata-method.Rd new file mode 100644 index 0000000..b9f43da --- /dev/null +++ b/man/getY-fdata-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{getY,fdata-method} +\alias{getY,fdata-method} +\title{Getter method of \code{fdata} class.} +\usage{ +\S4method{getY}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +The \code{y} slot of the \code{object} in the order defined \code{bycolumn}. +} +\description{ +Returns the \code{y} slot in the order defined by the slot \code{bycolumn}. +} +\examples{ +# Create an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +getY(f_data) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/getY.Rd b/man/getY.Rd new file mode 100644 index 0000000..060ef86 --- /dev/null +++ b/man/getY.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getY} +\alias{getY} +\title{Getter for the \code{y} slot in stored format} +\usage{ +getY(object) +} +\description{ +Getter for the \code{y} slot in stored format +} +\keyword{internal} diff --git a/man/getZero-ddatamoments-method.Rd b/man/getZero-ddatamoments-method.Rd new file mode 100644 index 0000000..d294366 --- /dev/null +++ b/man/getZero-ddatamoments-method.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{getZero,ddatamoments-method} +\alias{getZero,ddatamoments-method} +\title{Getter method of \code{ddatamoments} class.} +\usage{ +\S4method{getZero}{ddatamoments}(object) +} +\arguments{ +\item{object}{An \code{ddatamoments} object.} +} +\value{ +The \code{zero} slot of the \code{object}. +} +\description{ +Returns the \code{zero} slot. +} +\examples{ +# Generate a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Calculate the mixture moments. +f_datamoms <- datamoments(f_data) +# Get the moments for the included indicators of the data. +getZero(f_datamoms) + +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for model moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of the \code{datamoments} class family +} +} +\keyword{internal} diff --git a/man/getZero-dmodelmoments-method.Rd b/man/getZero-dmodelmoments-method.Rd new file mode 100644 index 0000000..8b7df5e --- /dev/null +++ b/man/getZero-dmodelmoments-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dmodelmoments.R +\name{getZero,dmodelmoments-method} +\alias{getZero,dmodelmoments-method} +\title{Getter method of \code{dmodelmoments} class.} +\usage{ +\S4method{getZero}{dmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{dmodelmoments} object.} +} +\value{ +The \code{kurtosis} slot of the \code{object}. +} +\description{ +Returns the \code{kurtosis} slot. +} +\examples{ +f_model <- model("poisson", par=list(lambda=c(0.3, 0.1)), + weight=matrix(c(0.3, 0.7), nrow=1)) +f_moments <- modelmoments(f_model) +getZero(f_moments) + +} +\seealso{ +\itemize{ +\item \link{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of the \code{modelmoments} class family +} +} +\keyword{internal} diff --git a/man/getZero.Rd b/man/getZero.Rd new file mode 100644 index 0000000..642ea8d --- /dev/null +++ b/man/getZero.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{getZero} +\alias{getZero} +\title{Getter for \code{zero} slot} +\usage{ +getZero(object) +} +\description{ +Getter for \code{zero} slot +} +\keyword{internal} diff --git a/man/graphic_func.Rd b/man/graphic_func.Rd new file mode 100644 index 0000000..7b69627 --- /dev/null +++ b/man/graphic_func.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/graphic_func.R +\name{graphic_func} +\alias{graphic_func} +\alias{.check.grDevice} +\title{Checks if graphical device has \code{title} option} +\usage{ +.check.grDevice() +} +\value{ +\code{TRUE} if \code{title} option exists. +} +\description{ +For internal use only. +} +\keyword{internal} diff --git a/man/hasExp-fdata-method.Rd b/man/hasExp-fdata-method.Rd new file mode 100644 index 0000000..17785d5 --- /dev/null +++ b/man/hasExp-fdata-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{hasExp,fdata-method} +\alias{hasExp,fdata-method} +\title{Checker method for \code{exp} slot of an \code{fdata} object.} +\usage{ +\S4method{hasExp}{fdata}(object, verbose = FALSE) +} +\arguments{ +\item{object}{An \code{fdata} object.} + +\item{verbose}{A logical indicating, if the function should print out +messages.} +} +\value{ +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{exp} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. +} +\description{ +\code{hasExp()} checks, if the object contains \code{exp} data. +} +\examples{ +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasExp(f_data) + +} +\seealso{ +\itemize{ +\item \linkS4class{fdata} for the class definition +} +} +\keyword{internal} diff --git a/man/hasExp.Rd b/man/hasExp.Rd new file mode 100644 index 0000000..a66a070 --- /dev/null +++ b/man/hasExp.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasExp} +\alias{hasExp} +\title{Checks for the \code{exp} slot of an \code{fdata} object} +\usage{ +hasExp(object, verbose = FALSE) +} +\description{ +Checks for the \code{exp} slot of an \code{fdata} object +} +\keyword{internal} diff --git a/man/hasPar-model-method.Rd b/man/hasPar-model-method.Rd index 64d00f8..ca1bf8a 100644 --- a/man/hasPar-model-method.Rd +++ b/man/hasPar-model-method.Rd @@ -7,9 +7,9 @@ \S4method{hasPar}{model}(object, verbose = FALSE) } \arguments{ -\item{verbose}{A logical indicating, if the function should give a print out.} +\item{object}{An S4 model object.} -\item{model}{An S4 model object.} +\item{verbose}{A logical indicating, if the function should give a print out.} } \value{ A matrix with repetitions. Can be empty, if no repetitions are set. diff --git a/man/hasPar.Rd b/man/hasPar.Rd new file mode 100644 index 0000000..ba6fdab --- /dev/null +++ b/man/hasPar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasPar} +\alias{hasPar} +\title{Checks a finite mixture model for the parameters} +\usage{ +hasPar(object, verbose = FALSE) +} +\description{ +Checks a finite mixture model for the parameters +} +\keyword{internal} diff --git a/man/hasPriorPar-prior-model-method.Rd b/man/hasPriorPar-prior-model-method.Rd new file mode 100644 index 0000000..3f706aa --- /dev/null +++ b/man/hasPriorPar-prior-model-method.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{hasPriorPar,prior,model-method} +\alias{hasPriorPar,prior,model-method} +\title{Checks for parameters in a \code{prior} object} +\usage{ +\S4method{hasPriorPar}{prior,model}(object, model, verbose = FALSE) +} +\arguments{ +\item{object}{A \code{prior} object containing the specifications for the prior.} + +\item{model}{A \code{model} object containing the specifications for the model.} + +\item{verbose}{A logical indicating, if the output should be verbose.} +} +\description{ +Calling \code{hasPriorPar()} checks if \code{model}-appropriate parameters are stored +in the \code{prior} object. +} +\examples{ +# Define a Poisson mixture model. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Call the default constructor. +f_prior <- prior() +# Check if the prior has appropriate parameters defined. +hasPriorPar(f_prior, f_model) +\dontrun{hasPriorPar(f_prior, f_model, TRUE)} + +} +\seealso{ +\itemize{ +\item \linkS4class{prior} for the definition of the \code{prior} class +\item \linkS4class{model} for the definition of the \code{model} class +} +} +\keyword{internal} diff --git a/man/hasPriorPar.Rd b/man/hasPriorPar.Rd new file mode 100644 index 0000000..9db012d --- /dev/null +++ b/man/hasPriorPar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasPriorPar} +\alias{hasPriorPar} +\title{Checks for the \code{par} slot in the \code{prior} class} +\usage{ +hasPriorPar(object, model, verbose = FALSE) +} +\description{ +Checks for the \code{par} slot in the \code{prior} class +} +\keyword{internal} diff --git a/man/hasPriorWeight.Rd b/man/hasPriorWeight.Rd new file mode 100644 index 0000000..07f105c --- /dev/null +++ b/man/hasPriorWeight.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/prior.R +\docType{methods} +\name{hasPriorWeight} +\alias{hasPriorWeight} +\alias{hasPriorWeight,prior,model-method} +\title{Checks for the \code{weight} slot in the \code{prior} class} +\usage{ +hasPriorWeight(object, model, verbose = FALSE) + +\S4method{hasPriorWeight}{prior,model}(object, model, verbose = FALSE) +} +\arguments{ +\item{object}{A \code{prior} object containing the specifications for the prior.} + +\item{model}{A \code{model} object containing the specifications for the model.} + +\item{verbose}{A logical indicating, if the output should be verbose.} +} +\description{ +Calling \code{hasPriorWeight()} checks if \code{model}-appropriate weight parameters +are stored in the \code{prior} object. +} +\examples{ +# Define a Poisson mixture model. +f_model <- model("poisson", par = list(lambda = c(0.3, 0.7)), K = 2) +# Call the default constructor. +f_prior <- prior() +# Check if the prior has appropriate parameters defined. +hasPriorWeight(f_prior, f_model) +\dontrun{hasPriorWeight(f_prior, f_model, TRUE)} + +} +\seealso{ +\itemize{ +\item \linkS4class{prior} for the definition of the \code{prior} class +\item \linkS4class{model} for the definition of the \code{model} class +} +} +\keyword{internal} diff --git a/man/hasS.Rd b/man/hasS.Rd new file mode 100644 index 0000000..c6a463f --- /dev/null +++ b/man/hasS.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasS} +\alias{hasS} +\title{Checks for the \code{S} slot of an \code{fdata} object} +\usage{ +hasS(object, verbose = FALSE) +} +\description{ +Checks for the \code{S} slot of an \code{fdata} object +} +\keyword{internal} diff --git a/man/hasT-fdata-method.Rd b/man/hasT-fdata-method.Rd new file mode 100644 index 0000000..598bbc4 --- /dev/null +++ b/man/hasT-fdata-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{hasT,fdata-method} +\alias{hasT,fdata-method} +\title{Checker method for \code{T} slot of an \code{fdata} object.} +\usage{ +\S4method{hasT}{fdata}(object, verbose = FALSE) +} +\arguments{ +\item{object}{An \code{fdata} object.} + +\item{verbose}{A logical indicating, if the function should print out +messages.} +} +\value{ +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{T} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. +} +\description{ +\code{hasY()} checks, if the object contains \code{T} data. +} +\examples{ +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasT(f_data) + +} +\seealso{ +\itemize{ +\item \linkS4class{fdata} for the class defintion +} +} +\keyword{internal} diff --git a/man/hasT.Rd b/man/hasT.Rd new file mode 100644 index 0000000..eb88049 --- /dev/null +++ b/man/hasT.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasT} +\alias{hasT} +\title{Checks a finite mixture model for repetitions} +\usage{ +hasT(object, verbose = FALSE) + +hasT(object, verbose = FALSE) +} +\description{ +Checks a finite mixture model for repetitions + +Checks for the \code{T} slot of an \code{fdata} object +} +\keyword{internal} diff --git a/man/hasWeight-model-method.Rd b/man/hasWeight-model-method.Rd new file mode 100644 index 0000000..b4644d3 --- /dev/null +++ b/man/hasWeight-model-method.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{hasWeight,model-method} +\alias{hasWeight,model-method} +\title{Getter for weights} +\usage{ +\S4method{hasWeight}{model}(object, verbose = FALSE) +} +\arguments{ +\item{verbose}{A logical indicating, if the function should give a print out.} + +\item{model}{An S4 model object.} +} +\value{ +Matrix of weights. +} +\description{ +\code{hasWeight} returns the weight matrix. +} +\examples{ +\dontrun{ +weight <- hasWeight(model) +} +} +\keyword{internal} diff --git a/man/hasWeight.Rd b/man/hasWeight.Rd new file mode 100644 index 0000000..7c6b017 --- /dev/null +++ b/man/hasWeight.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasWeight} +\alias{hasWeight} +\title{Checks a finite mixture model for the weight} +\usage{ +hasWeight(object, verbose = FALSE) +} +\description{ +Checks a finite mixture model for the weight +} +\keyword{internal} diff --git a/man/hasY-fdata-method.Rd b/man/hasY-fdata-method.Rd new file mode 100644 index 0000000..a397bb5 --- /dev/null +++ b/man/hasY-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{hasY,fdata-method} +\alias{hasY,fdata-method} +\title{Checker method for \code{y} slot of an \code{fdata} object.} +\usage{ +\S4method{hasY}{fdata}(object, verbose = FALSE) +} +\arguments{ +\item{object}{An \code{fdata} object.} + +\item{verbose}{A logical indicating, if the function should print out +messages.} +} +\value{ +Either \code{FALSE}/\code{TRUE}, if \code{verbose} is \code{FALSE} and the \code{y} slot is +empty or filled or a message, if \code{verbose} is \code{TRUE}. +} +\description{ +\code{hasY()} checks, if the object contains \code{y} data. +} +\examples{ +# Generate an fdata object with Poisson data +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +hasY(f_data) + +} +\seealso{ +\link{fdata} class for an overview of its slots +} +\keyword{internal} diff --git a/man/hasY.Rd b/man/hasY.Rd new file mode 100644 index 0000000..95a2dee --- /dev/null +++ b/man/hasY.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{hasY} +\alias{hasY} +\title{Checks for the \code{y} slot of an \code{fdata} object} +\usage{ +hasY(object, verbose = FALSE) +} +\description{ +Checks for the \code{y} slot of an \code{fdata} object +} +\keyword{internal} diff --git a/man/initialize-binomialmodelmoments-method.Rd b/man/initialize-binomialmodelmoments-method.Rd new file mode 100644 index 0000000..5462f89 --- /dev/null +++ b/man/initialize-binomialmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/binomialmodelmoments.R +\name{initialize,binomialmodelmoments-method} +\alias{initialize,binomialmodelmoments-method} +\title{Initializer of the \code{binomialmoments} class} +\usage{ +\S4method{initialize}{binomialmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object_ see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-cdatamoments-method.Rd b/man/initialize-cdatamoments-method.Rd new file mode 100644 index 0000000..4d52e66 --- /dev/null +++ b/man/initialize-cdatamoments-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{initialize,cdatamoments-method} +\alias{initialize,cdatamoments-method} +\title{Initializer of the \code{cdatamoments} class} +\usage{ +\S4method{initialize}{cdatamoments}(.Object, ..., value = fdata()) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{fdata} object containing the observations.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step the moments for a passed-in \code{fdata} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-csdatamoments-method.Rd b/man/initialize-csdatamoments-method.Rd new file mode 100644 index 0000000..b9bd394 --- /dev/null +++ b/man/initialize-csdatamoments-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{initialize,csdatamoments-method} +\alias{initialize,csdatamoments-method} +\title{Initializer of the \code{csdatamoments} class} +\usage{ +\S4method{initialize}{csdatamoments}(.Object, ..., value = fdata()) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \linkS4class{fdata} object containing the observations.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step the moments for a passed-in \code{fdata} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-ddatamoments-method.Rd b/man/initialize-ddatamoments-method.Rd new file mode 100644 index 0000000..0283b8c --- /dev/null +++ b/man/initialize-ddatamoments-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{initialize,ddatamoments-method} +\alias{initialize,ddatamoments-method} +\title{Initializer of the \code{ddatamoments} class} +\usage{ +\S4method{initialize}{ddatamoments}(.Object, ..., value = fdata()) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{fdata} object containing the observations.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step the moments for a passed-in \code{fdata} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-exponentialmodelmoments-method.Rd b/man/initialize-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..46262bf --- /dev/null +++ b/man/initialize-exponentialmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{initialize,exponentialmodelmoments-method} +\alias{initialize,exponentialmodelmoments-method} +\title{Initializer of the \code{exponentialmoments} class} +\usage{ +\S4method{initialize}{exponentialmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object_ see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-groupmoments-method.Rd b/man/initialize-groupmoments-method.Rd new file mode 100644 index 0000000..7c775b7 --- /dev/null +++ b/man/initialize-groupmoments-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{initialize,groupmoments-method} +\alias{initialize,groupmoments-method} +\title{Initializer of the \code{groupmoments} class} +\usage{ +\S4method{initialize}{groupmoments}(.Object, ..., value) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \linkS4class{fdata} object containing the observations.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +object. to generate in the initialization step the moments for a passed-in +\code{fdata} object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-normultmodelmoments-method.Rd b/man/initialize-normultmodelmoments-method.Rd new file mode 100644 index 0000000..d0d0386 --- /dev/null +++ b/man/initialize-normultmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{initialize,normultmodelmoments-method} +\alias{initialize,normultmodelmoments-method} +\title{Initializer of the \code{normultmoments} class} +\usage{ +\S4method{initialize}{normultmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object_ see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-poissonmodelmoments-method.Rd b/man/initialize-poissonmodelmoments-method.Rd new file mode 100644 index 0000000..54a16b5 --- /dev/null +++ b/man/initialize-poissonmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poissonmodelmoments.R +\name{initialize,poissonmodelmoments-method} +\alias{initialize,poissonmodelmoments-method} +\title{Initializer of the \code{poissonmoments} class} +\usage{ +\S4method{initialize}{poissonmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object_ see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-studentmodelmoments-method.Rd b/man/initialize-studentmodelmoments-method.Rd new file mode 100644 index 0000000..dade02a --- /dev/null +++ b/man/initialize-studentmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{initialize,studentmodelmoments-method} +\alias{initialize,studentmodelmoments-method} +\title{Initializer of the \code{studentmodelmoments} class} +\usage{ +\S4method{initialize}{studentmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object: see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/initialize-studmultmodelmoments-method.Rd b/man/initialize-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..4e88f38 --- /dev/null +++ b/man/initialize-studmultmodelmoments-method.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{initialize,studmultmodelmoments-method} +\alias{initialize,studmultmodelmoments-method} +\title{Initializer of the \code{studmultmoments} class} +\usage{ +\S4method{initialize}{studmultmodelmoments}(.Object, ..., model) +} +\arguments{ +\item{.Object}{An object_ see the "initialize Methods" section in +\link{initialize}.} + +\item{...}{Arguments to specify properties of the new object, to be passed +to \code{initialize()}.} + +\item{model}{A finmix \code{model} object containing the definition of the +finite mixture distribution.} +} +\description{ +Only used implicitly. The initializer calls a function \code{generateMoments()} +to generate in the initialization step also the moments for a passed \code{model} +object. +} +\seealso{ +\itemize{ +\item \link{Classes_Details} for details of class definitions, and +\item \link{setOldClass} for the relation to S3 classes +} +} +\keyword{internal} diff --git a/man/mcmc-class.Rd b/man/mcmc-class.Rd new file mode 100644 index 0000000..45f3dcc --- /dev/null +++ b/man/mcmc-class.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\docType{class} +\name{mcmc-class} +\alias{mcmc-class} +\alias{.mcmc} +\title{Finmix \code{mcmc} class} +\description{ +This class defines hyper-parameters for the MCMC procedure. This is a main +class of the \code{finmix} package that must be defined for estimating a finite +mixture model. +} +\section{Slots}{ + +\describe{ +\item{\code{burnin}}{An integer defining the number of steps in the burn-in phase of +Gibbs-sampling.} + +\item{\code{M}}{An integer defining the number of steps in Gibbs-sampling to be +stored.} + +\item{\code{startpar}}{A logical indicating, if starting by sampling the +parameters. If \code{FALSE} sampling starts by sampling the indicators \code{S}.} + +\item{\code{storeS}}{An integer specifying how many of the last sampled indicators +should be stored in the output.} + +\item{\code{storepost}}{A logical indicating if the posterior probabilities should +be stored. This becomes for example important for specific relabeling +algorithms, but also for analysis.} + +\item{\code{ranperm}}{A logical indicating, if random permutation should be used. If +\code{TRUE} the parameters are permutated randomly between the number of +components after each sampling step in MCMC.} + +\item{\code{storeinv}}{A logical indicating if the inverse variance-covariance +matrices for multivariate normal or Student-t mixtures should be stored.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmc]{mcmc()}} for the class constructor +\item \code{\link[=mcmcstart]{mcmcstart()}} for completion of slots +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for further information about the MCMC sampling +} +} diff --git a/man/mcmc_binomial_cc.Rd b/man/mcmc_binomial_cc.Rd index 71141fe..4677df7 100644 --- a/man/mcmc_binomial_cc.Rd +++ b/man/mcmc_binomial_cc.Rd @@ -7,6 +7,8 @@ mcmc_binomial_cc(fdata_S4, model_S4, prior_S4, mcmc_S4, mcmcoutput_S4) } \arguments{ +\item{fdata_S4}{An \code{fdata} object storing the observations and indicators.} + \item{model_S4}{A \code{model} object specifying the Binomial finite mixture model.} @@ -18,8 +20,6 @@ sampling.} \item{mcmcoutput_S4}{An \code{mcmcoutput} object storing the outcomes from MCMC sampling using R memory.} - -\item{data_S4}{An \code{fdata} object storing the observations and indicators.} } \value{ An \code{mcmcoutput} object containing the results from MCMC sampling diff --git a/man/mcmcest-class.Rd b/man/mcmcest-class.Rd new file mode 100644 index 0000000..2d4a4ec --- /dev/null +++ b/man/mcmcest-class.Rd @@ -0,0 +1,127 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestind.R +\docType{class} +\name{mcmcest-class} +\alias{mcmcest-class} +\title{Finmix \code{mcmcest} class} +\description{ +This class stores Bayesian parameter estimates from MCMC samples and +corresponding metadata. Calling \code{\link[=mcmcestimate]{mcmcestimate()}} returns an object of this +class. +} +\details{ +Calling \code{\link[=mcmcestimate]{mcmcestimate()}} on an object of class \code{mcmcoutput} or +\code{mcmcoutputperm} returns an object of class \code{mcmcest} that contains all +Bayesian estimates together with corresponding metadata. Three Bayesian +point estimates are constructed: +\itemize{ +\item \strong{BML}: The Bayesian Maximum Likelihood, which is the parameter sample +from MCMC sampling that maximizes the mixture likelihood. +\item \strong{MAP}: The Bayesian Maximum A Posterior, which is the parameter sample +from MCMC sampling that maximizes the the posterior maximum likelihood. +\item \strong{EAVG}: The Ergodic Average over the MCMC samples without identification. +\item \strong{IEAVG}: The Identified Ergodic Average over the MCMC samples with +identification. +} + +Note that a model with fixed indicators (i.e. slot \code{indicfix=TRUE}) has +always an identified ergodic average, because in each MCMC sample the +component labels are the same and therefore identified. In contrast, a +model with unknown indicators (i.e. \code{indicfix=FALSE}) suffers usually under +random label switching during sampling and therefore the ergodic average +over all MCMC samples is usually not identified as it averages over +parameters from different components thereby pulling the component +parameters together (sometimes you get the same average for all components). +The \code{ieavg} is calculated for a model with unknown indicators by relabeling +the component parameter samples. Re-labeling reassigns component parameters +to the most likely label of the mixture in regard to the observations. As a +result the \code{mcmcest} object of a model with unknown indicators will have +both, an \code{eavg} and an \code{ieavg} slot containing the ergodic average over +samples before and after re-labeling. The \code{relabel} slot indicates which +re-labeling algorithm had been chosen. + +The uncertainty of parameter estimates is measured by the standard deviation +over parameters from MCMC sampling and stored in the \code{sdpost} slot. It is +an estimate of the standard deviation of the true posterior parameter +distribution. + +The class \code{mcmcest} is a class union and includes all classes that define +objects for Bayesian estimates of MCMC samples and is used to dispatch +methods for \code{mcmcest} objects. For the user this detail is not important, +especially as this class has no exported constructor. Objects are solely +constructed internally within the function \code{\link[=mcmcestimate]{mcmcestimate()}}. +\subsection{Class Methods}{ + +Similar to the contained classes \link[=mcmcoutput-class]{mcmcoutput} this class comes +along with a couple of methods that should give the user some comfort in +handling the permuted sampling results. There are no setters for this class +as the slots are only set internally. +\subsection{Show and Summary}{ +\itemize{ +\item \code{show()} gives a short summary of the object's slots. +\item \code{Summary()} prints out a summary of estimation results. +} +} + +\subsection{Getters}{ +\itemize{ +\item \code{getDist()} returns the \code{dist} slot. +\item \code{getK()} returns the \code{K} slot. +\item \code{getIndicmod()} returns the \code{indicmod} slot. +\item \code{getBurnin()} returns the \code{burnin} slot. +\item \code{getM()} returns the \code{M} slot. +\item \code{getRanperm()} returns the \code{ranperm} slot. +\item \code{getRelabel()} returns the \code{relabel} slot. +\item \code{getMap()} returns the MAP estimates. +\item \code{getBml()} returns the BML estimates. +\item \code{getEavg()} returns the EAVG estimates. +\item \code{getIeavg()} returns the identified EAVG estimates. +\item \code{getSdpost()} returns the \code{sdpost}. +} +} + +} +} +\section{Slots}{ + +\describe{ +\item{\code{dist}}{A character specifying the distribution family of the mixture +model used in MCMC sampling.} + +\item{\code{K}}{An integer specifying the number of components in the mixture model.} + +\item{\code{indicmod}}{A character specifying the indicator model. At this moment +only a multinomial model can be chosen.} + +\item{\code{burnin}}{An integer specifying the number of iterations in the burn-in +phase of MCMC sampling.} + +\item{\code{M}}{An integer specifying the number of iterations to store in MCMC +sampling.} + +\item{\code{ranperm}}{A logical specifying, if random permutation has been used +during MCMC sampling.} + +\item{\code{relabel}}{A character specifying the re-labeling algorithm used during +parameter estimation for the identified ergodic average.} + +\item{\code{map}}{A named list containing the parameter estimates of the MAP. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{bml}}{A named list containing the parameter estimates of the BML. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{eavg}}{A named list containing the parameter estimates of the +unidentified EAVG. Note that this is only the case for a model with +unknown indicators.} + +\item{\code{ieavg}}{A named list containing the parameter estimates of the IEAVG. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{sdpost}}{A named list containing the standard deviations of the +parameter estimates from the posterior distributions.} +}} + diff --git a/man/mcmcestfix-class.Rd b/man/mcmcestfix-class.Rd new file mode 100644 index 0000000..0c7ba91 --- /dev/null +++ b/man/mcmcestfix-class.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\docType{class} +\name{mcmcestfix-class} +\alias{mcmcestfix-class} +\alias{.mcmcestfix} +\title{Finmix \code{mcmcestfix} class} +\description{ +This class stores the point estimators for component parameters and weights +as well as corresponding information from MCMC sampling. Three point +estimators are calculated: the maximum a posterior (MAP), the Bayesian +maximum likelihood (BML) and the Identified ergodic average (IEAVG). See +Fr\"uhwirth-Schnatter (2006) for detailed information about how these +estimators are defined. +} +\section{Slots}{ + +\describe{ +\item{\code{dist}}{A character specifying the distribution family of the mixture +model used in MCMC sampling.} + +\item{\code{K}}{An integer specifying the number of components in the mixture model.} + +\item{\code{indicmod}}{A character specifying the indicator model. At this moment +only a multinomial model can be chosen.} + +\item{\code{burnin}}{An integer specifying the number of iterations in the burn-in +phase of MCMC sampling.} + +\item{\code{M}}{An integer specifying the number of iterations to store in MCMC +sampling.} + +\item{\code{ranperm}}{A logical specifying, if random permutation has been used +during MCMC sampling.} + +\item{\code{relabel}}{A character specifying the re-labeling algorithm used during +parameter estimation for the identified ergodic average.} + +\item{\code{map}}{A named list containing the parameter estimates of the MAP. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{bml}}{A named list containing the parameter estimates of the BML. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{ieavg}}{A named list containing the parameter estimates of the IEAVG. The +element \code{par} is a named list and contains the component parameters and +the element \code{weight} contains the weights.} + +\item{\code{sdpost}}{A named list containing the standard deviations of the +parameter estimates from the posterior distributions.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcestind} for the equivalent class for models with +unknown indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} to calculate point estimates +} +} +\keyword{internal} diff --git a/man/mcmcestind-class.Rd b/man/mcmcestind-class.Rd new file mode 100644 index 0000000..e50c667 --- /dev/null +++ b/man/mcmcestind-class.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestind.R +\docType{class} +\name{mcmcestind-class} +\alias{mcmcestind-class} +\alias{.mcmcestind} +\title{Finmix \code{mcmcestfix} class} +\description{ +This class stores the point estimators for component parameters and weights +as well as corresponding information from MCMC sampling. Three point +estimators are calculated: the maximum a posterior (MAP), the Bayesian +maximum likelihood (BML) and the Identified ergodic average (IEAVG). See +Fr\"uhwirth-Schnatter (2006) for detailed information about how these +estimators are defined. + +Note that this class inherits almost all of its slots from the \code{mcmcestfix} +class, the corresponding class for fixed indicators. +} +\section{Slots}{ + +\describe{ +\item{\code{eavg}}{A named list containing the estimates of the ergodic average. The +element \code{par} is a list and contains the component parameter estimates and +\code{weight} contains the weight estimates. The difference between the EAVG +and the IEAVG is that the IEAVG is based on re-labeled samples.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcestfix} for the parent class with fixed indicators +\item \code{\link[=mcmcestimate]{mcmcestimate()}} to calculate point estimates +} +} +\keyword{internal} diff --git a/man/mcmcextract-class.Rd b/man/mcmcextract-class.Rd new file mode 100644 index 0000000..f9dfd37 --- /dev/null +++ b/man/mcmcextract-class.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcextract.R +\docType{class} +\name{mcmcextract-class} +\alias{mcmcextract-class} +\alias{.mcmcextract} +\title{Finmix \code{mcmcextract} class} +\description{ +This is a leight-weighted class containing the major results from MCMC +sampling to calculate model moments from MCMC samples. Note that momentarily +only methods for the multivariate Normal mixture are implemented. +} +\section{Slots}{ + +\describe{ +\item{\code{dist}}{A character defining the finite mixture model that has been used +in MCMC sampling.} + +\item{\code{K}}{An integer specifying the number of components of the mixture model.} + +\item{\code{r}}{An integer specifying the number of dimensions of the mixture model.} + +\item{\code{par}}{A list storing the sample component parameters from MCMC sampling.} + +\item{\code{weight}}{A n array storing the sample weight parameters from MCMC +sampling.} +}} + +\keyword{internal} diff --git a/man/mcmcoutputfix-class.Rd b/man/mcmcoutputfix-class.Rd new file mode 100644 index 0000000..98d2a47 --- /dev/null +++ b/man/mcmcoutputfix-class.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\docType{class} +\name{mcmcoutputfix-class} +\alias{mcmcoutputfix-class} +\alias{.mcmcoutputfix} +\title{Finmix \code{mcmcoutputfix} class} +\description{ +This class defines the basic slots for the MCMC sampling output for a +fixed indicator model. +} +\section{Slots}{ + +\describe{ +\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} + +\item{\code{burnin}}{An integer defining the number of iterations in the burn-in +phase of MCMC sampling. These number of sampling steps are not stored +in the output.} + +\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed +with random permutations of components.} + +\item{\code{par}}{A named list containing the sampled component parameters.} + +\item{\code{log}}{A named list containing the values of the mixture log-likelihood, +mixture prior log-likelihood, and the complete data posterior +log-likelihood.} + +\item{\code{model}}{The \code{model} object that specifies the finite mixture model for +whcih MCMC sampling has been performed.} + +\item{\code{prior}}{The \code{prior} object defining the prior distributions for the +component parameters that has been used in MCMC sampling.} +}} + +\keyword{internal} diff --git a/man/mcmcoutputfixhier-class.Rd b/man/mcmcoutputfixhier-class.Rd new file mode 100644 index 0000000..90bbbff --- /dev/null +++ b/man/mcmcoutputfixhier-class.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\docType{class} +\name{mcmcoutputfixhier-class} +\alias{mcmcoutputfixhier-class} +\alias{.mcmcoutputfixhier} +\title{Finmix \code{mcmcoutput} class for hierarchical priors} +\description{ +This class stores in addition to the information from its parent class +\code{mcmcoutputfix} also the sampled parameters from the hierarchical prior. +} +\section{Slots}{ + +\describe{ +\item{\code{hyper}}{A list storing the sampled parameters from the hierarchical +prior.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputfix} for the parent class`` +} +} diff --git a/man/mcmcoutputfixhierpost-class.Rd b/man/mcmcoutputfixhierpost-class.Rd new file mode 100644 index 0000000..53e3f65 --- /dev/null +++ b/man/mcmcoutputfixhierpost-class.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\docType{class} +\name{mcmcoutputfixhierpost-class} +\alias{mcmcoutputfixhierpost-class} +\alias{.mcmcoutputfixhierpost} +\title{Finmix \code{mcmcoutputfixhierpost} class} +\description{ +This class inherits from the \code{mcmcoutputfixhier} class and adds posterior +density parameters to the MCMC sampling output. The storage of posterior +parameters is controlled by the slot \code{storepost} in the \linkS4class{mcmc} +class. If set to \code{TRUE} posterior parameters are stored in the output of the +MCMC sampling. +} +\section{Slots}{ + +\describe{ +\item{\code{post}}{A named list containing a named list \code{par} with arrays for the +posterior density parameters.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputfixhier} for the parent class +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \linkS4class{mcmc} for the class defining the MCMC hyper-parameters +\item \code{\link[=mcmc]{mcmc()}} for the \code{mcmc} class constructor +} +} diff --git a/man/mcmcoutputfixpost-class.Rd b/man/mcmcoutputfixpost-class.Rd new file mode 100644 index 0000000..46920cd --- /dev/null +++ b/man/mcmcoutputfixpost-class.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\docType{class} +\name{mcmcoutputfixpost-class} +\alias{mcmcoutputfixpost-class} +\alias{.mcmcoutputfixpost} +\title{Finmix \code{mcmcoutput} class for fixed indicators and posterior parameters} +\description{ +The \code{mcmcoutputfixpost} class inherits from the \code{mcmcoutputfix} class and +adds a slot to store the parameters of the posterior distribution from which +the component parameters are drawn. The storage of posterior parameters is +controlled by the slot \code{storepost} in the \linkS4class{mcmc} class. If set +to \code{TRUE} posterior parameters are stored in the output of the MCMC sampling. +} +\section{Slots}{ + +\describe{ +\item{\code{post}}{A named list containing a list \code{par} that contains the posterior +parameters as named arrays.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputfix} for the parent class +\item \linkS4class{mcmcoutputpost} for the corresponding class for unknown +indicators. +\item \linkS4class{mcmc} for the class defining the MCMC hyper-parameters +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \linkS4class{mcmc} class +} +} +\keyword{internal} diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd index acea480..352a3fb 100644 --- a/man/mcmcoutputperm-class.Rd +++ b/man/mcmcoutputperm-class.Rd @@ -113,7 +113,7 @@ models as the last indicator of this observation. This slot is only available for models with unknown indicators.} \item{\code{Sperm}}{An \code{array} of dimension \verb{N x storeS} containing the last -\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \code{storeS} of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}. This slot is only available for models with unknown indicators.} diff --git a/man/mcmcoutputpermhierpost-class.Rd b/man/mcmcoutputpermhierpost-class.Rd new file mode 100644 index 0000000..682d454 --- /dev/null +++ b/man/mcmcoutputpermhierpost-class.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\docType{class} +\name{mcmcoutputpermhierpost-class} +\alias{mcmcoutputpermhierpost-class} +\alias{.mcmcoutputpermhierpost} +\title{Finmix \code{mcmcoutputpermhierpost} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. + +Note that this class inherits all of its slots from the parent classes. +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputbase} for the parent class +\item \linkS4class{mcmcpermind} for the parent class +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for performing permutation of MCMC samples +} +} +\keyword{internal} diff --git a/man/mcmcpermfixpost-class.Rd b/man/mcmcpermfixpost-class.Rd new file mode 100644 index 0000000..0003b5b --- /dev/null +++ b/man/mcmcpermfixpost-class.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermfixpost.R +\docType{class} +\name{mcmcpermfixpost-class} +\alias{mcmcpermfixpost-class} +\alias{.mcmcpermfixpost} +\title{Finmix \code{mcmcpermfixpost} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the posterior densities. + +Note that for models with fixed indicators \code{weight}s do not get permuted. +} +\section{Slots}{ + +\describe{ +\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \linkS4class{mcmcpermfix} for the parent class definition +\item \linkS4class{mcmcpermindpost}for the corresponding class for models with +unknown indicators +} +} diff --git a/man/mcmcpermind-class.Rd b/man/mcmcpermind-class.Rd new file mode 100644 index 0000000..b780df8 --- /dev/null +++ b/man/mcmcpermind-class.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermind.R +\docType{class} +\name{mcmcpermind-class} +\alias{mcmcpermind-class} +\alias{.mcmcpermind} +\title{Finmix \code{mcmcpermind} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class stores the permuted parameters together with the new MCMC sample +size and the mixture log-likelihood, the prior log-likelihood, and the +complete data posterior log-likelihood. All this slots are inherited from +the parent class \code{mcmcpermfix}. In addition to these slots this class adds +permuted weights, permuted indicators as well as the entropies and number +of assigned observations per component. +} +\section{Slots}{ + +\describe{ +\item{\code{relabel}}{A character defining the used algorithm for relabeling.} + +\item{\code{weightperm}}{An array of dimension \verb{Mperm x K} containing the +relabeled weight parameters.} + +\item{\code{entropyperm}}{An \code{array} of dimension \verb{Mperm x 1} containing the +entropy for each MCMC permuted draw.} + +\item{\code{STperm}}{An \code{array} of dimension \verb{Mperm x 1} containing all permuted +MCMC states, for the last observation in slot \verb{@y} of the \code{fdata} object +passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov +models as the last indicator of this observation.} + +\item{\code{Sperm}}{An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} permuted indicators. \code{storeS} is defined in the slot \verb{@storeS} +of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} + +\item{\code{NKperm}}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +of observations assigned to each component.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \linkS4class{mcmcpermfix} for the corresponding class for models with +fixed indicators +} +} +\keyword{internal} diff --git a/man/mcmcpermindhier-class.Rd b/man/mcmcpermindhier-class.Rd new file mode 100644 index 0000000..49150ac --- /dev/null +++ b/man/mcmcpermindhier-class.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermindhier.R +\docType{class} +\name{mcmcpermindhier-class} +\alias{mcmcpermindhier-class} +\alias{.mcmcpermindhier} +\title{Finmix \code{mcmcpermindhier} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the hierarchical prior. + +Note that for models with fixed indicators \code{weight}s do not get permuted. +} +\section{Slots}{ + +\describe{ +\item{\code{hyperperm}}{A named list containing the (permuted) parameters of the +hierarchical prior.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \linkS4class{mcmcpermind} for the parent class definition +\item \linkS4class{mcmcpermfixhier} for the corresponding class for models with +fixed indicators +} +} +\keyword{internal} diff --git a/man/mcmcpermindpost-class.Rd b/man/mcmcpermindpost-class.Rd new file mode 100644 index 0000000..b8ffcd0 --- /dev/null +++ b/man/mcmcpermindpost-class.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcpermindpost.R +\docType{class} +\name{mcmcpermindpost-class} +\alias{mcmcpermindpost-class} +\alias{.mcmcpermindpost} +\title{Finmix \code{mcmcpermindpost} class} +\description{ +This class defines objects to store the outputs from permuting the MCMC +samples. Due to label switching the sampled component parameters are usually +not assigned to the same component in each iteration. To overcome this issue +the samples are permuted by using a relabeling algorithm (usually K-means) +to reassign parameters. Note that due to assignment of parameters from the +same iteration to the same component, the sample size could shrink. + +This class is supplementing the parent class by adding a slot to store the +permuted parameter samples of the posterior densities. +} +\section{Slots}{ + +\describe{ +\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of +parameters from the posterior density.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for the calling function +\item \linkS4class{mcmcpermind} for the parent class definition +\item \linkS4class{mcmcpermfixpost} for the corresponding class for models +with fixed indicators +} +} +\keyword{internal} diff --git a/man/mcmcpermute.Rd b/man/mcmcpermute.Rd index 197c3e5..d1bfc3b 100644 --- a/man/mcmcpermute.Rd +++ b/man/mcmcpermute.Rd @@ -11,6 +11,25 @@ mcmcpermute( opt_ctrl = list(max_iter = 200L) ) } +\arguments{ +\item{mcmcout}{An \code{mcmcoutput} object containing the MCMC samples.} + +\item{fdata}{An \code{fdata} object containing the observations and in case of +fixed indicator models the indicators. This argument is optional for +relabeling with the \code{"kmeans"} or \code{"Stephens1997a"} methods, but mandatory +for relabeling with \verb{Stephens1997b"}.} + +\item{method}{A character indicating which relabeling method should be used. +The relabeling method \code{"kmeans"} is the default. \code{"Stephens1997a"} and +\code{"Stephens1997b"} are only available for mixtures of Poisson or Binomial +distributions.} + +\item{opt_ctrl}{(Deprecated) A list containing hyperparameters for +optimization with the \code{"Stephens1997a"} relabeling algorithm.} +} +\value{ +An \code{mcmcoutputperm} object containing the relabeld MCMC samples. +} \description{ Calling \code{mcmcpermute()} on an \code{mcmcoutput} object relabels the MCMC samples by using a relabeling algorithm. \code{"kmeans"} is the standard relabeling diff --git a/man/mixturemar.Rd b/man/mixturemar.Rd new file mode 100644 index 0000000..ef2085e --- /dev/null +++ b/man/mixturemar.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{mixturemar} +\alias{mixturemar} +\title{Extracts the marginal distribution from a finite mixture model} +\usage{ +mixturemar(object, J) +} +\description{ +Extracts the marginal distribution from a finite mixture model +} +\keyword{internal} diff --git a/man/model-class.Rd b/man/model-class.Rd new file mode 100644 index 0000000..1eadbad --- /dev/null +++ b/man/model-class.Rd @@ -0,0 +1,81 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\docType{class} +\name{model-class} +\alias{model-class} +\alias{.model} +\title{Finmix \code{model} class} +\description{ +This class specifies a finite mixture model. Entities are created from it by +calling its constructor \code{\link[=model]{model()}}. +} +\details{ +A finite mixture model in the \code{ finmix} package is defined by its number of +components \code{K}, the component distributions \code{dist}, the data dimension \code{r} +and an indicator defining, if the model has fixed or unknown indicators. +Finite mixture models for the following distributions can be constructed: +\itemize{ +\item Poisson, +\item Conditional Poisson, +\item Exponential, +\item Binomial, +\item Normal, +\item Multivariate Normal, +\item Student-t, +\item Multivariate Student-t. +} + +Using the constructor \code{\link[=model]{model()}} a finite mixture model can be created, the +default being a mixture model of Poisson distributions. +\subsection{Fully defined finite mixture models}{ + +A fully defined finite mixture model contains next to the distribution and +the components also weights and parameters. The weights are defined in slot +\code{weight} and must be of class \code{ matrix} with as many weights as there are +components in the mixture model (dimension \code{Kx1}). Parameters are defined in +a \code{ list} named \code{par}. The elements of this list depend on the chosen +distribution in slot \code{dist}: +\itemize{ +\item Poisson: A \code{matrix} named \code{lambda} of dimension \code{Kx1} holding the rate +parameters. +\item Exponential: A \code{matrix} named \code{lambda} of dimension \code{Kx1} holding the rate +parameters. +\item Binomial: A \code{matrix} of dimension \code{Kx1} named \code{p} storing the +probabilities. +} +} +} +\section{Slots}{ + +\describe{ +\item{\code{dist}}{A character, defining the distribution family. Possible choices +are binomial, exponential, normal, normult, poisson, student, and studmult.} + +\item{\code{r}}{An integer. Defines the vector dimension of a model. Is one for all +univariate distributions and larger than one for normult and studmult.} + +\item{\code{K}}{An integer, defining the number of components in the finite mixture.} + +\item{\code{weight}}{A matrix, containing the weights of the finite mixture model. +The matrix must have dimension \code{1 x K} and weights must add to one +must all be larger or equal to zero.} + +\item{\code{par}}{A list containing the parameter vectors for the finite mixture +distribution. The list can contain more than one named parameter vector.} + +\item{\code{indicmod}}{A character defining the indicator model. So far only +multinomial indicator models are possible.} + +\item{\code{indicfix}}{A logical. If \code{TRUE} the indicators are given and +therefore fixed.} + +\item{\code{T}}{A matrix containing the repetitions in case of a \code{"binomial"} or +\code{"poisson"} model.} +}} + +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling with a mixture model +\item \code{\link[=modelmoments]{modelmoments()}} for compute theoretical moments of a finite mixture model +} +} diff --git a/man/moments-mcmcextract-method.Rd b/man/moments-mcmcextract-method.Rd new file mode 100644 index 0000000..664e1fc --- /dev/null +++ b/man/moments-mcmcextract-method.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcextract.R +\name{moments,mcmcextract-method} +\alias{moments,mcmcextract-method} +\title{Calculate the model moments of MCMC samples} +\usage{ +\S4method{moments}{mcmcextract}(object) +} +\arguments{ +\item{obj}{An \code{mcmcextract} object containing the parameters and weights +from MCMC sampling.} +} +\value{ +A list containing the model moments calculated from MCMC samples. +} +\description{ +For internal usage only. This function calculates the finite mixture moments +of a mixture model from the MCMC samples. Note that this function is +momentarily only implemented for a mixture of multivariate Normal +distributions. +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the results from MCMC sampling +\item \code{\link[=extract]{extract()}} for the calling method +} +} +\keyword{internal} diff --git a/man/moments-mcmcoutputfix-method.Rd b/man/moments-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..89b09ef --- /dev/null +++ b/man/moments-mcmcoutputfix-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{moments,mcmcoutputfix-method} +\alias{moments,mcmcoutputfix-method} +\title{Computes multivariate Normal sample moments} +\usage{ +\S4method{moments}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfix} object containing all data from MCMC +sampling.} +} +\value{ +The moments on the samples of a multivariate Normal mixture. +} +\description{ +Calling \code{moments()} calculates the sample moments for the samples of a +multivariate Normal mixture model. +} +\keyword{internal} diff --git a/man/moments.Rd b/man/moments.Rd new file mode 100644 index 0000000..51f8d06 --- /dev/null +++ b/man/moments.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{moments} +\alias{moments} +\title{Computes the model moments from MCMC samples} +\usage{ +moments(object) +} +\description{ +Computes the model moments from MCMC samples +} +\keyword{internal} diff --git a/man/normultmodelmoments-class.Rd b/man/normultmodelmoments-class.Rd new file mode 100644 index 0000000..d33fcc5 --- /dev/null +++ b/man/normultmodelmoments-class.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\docType{class} +\name{normultmodelmoments-class} +\alias{normultmodelmoments-class} +\alias{.normultmodelmoments} +\title{Finmix \code{normultmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of normult +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{Rdet}}{A numeric defining the coefficient of determination based on the +determinant of the covariance matrix.} + +\item{\code{Rtr}}{A numeric defining the coefficient of determination based on the +trace of the covariance matrix.} + +\item{\code{corr}}{A \code{matrix} storing the correlation matrix.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/plot-fdata-missing-method.Rd b/man/plot-fdata-missing-method.Rd new file mode 100644 index 0000000..113141a --- /dev/null +++ b/man/plot-fdata-missing-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{plot,fdata,missing-method} +\alias{plot,fdata,missing-method} +\title{Plots the data} +\usage{ +\S4method{plot}{fdata,missing}(x, y, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{fdata} object. Cannot be empty.} + +\item{y}{Unused.} + +\item{dev}{A logical indicating if the plot should be output via a graphical +device.} + +\item{...}{Further arguments passed to the plotting functions \code{hist} or +\code{barplot}.} +} +\description{ +\code{\link[=plot]{plot()}} plots the data in an \link{fdata} object by either a histogram in case of +continuous data or a barplot in case of discrete data. +} +\examples{ +# Generate Poisson data and plot it. +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +plot(f_data) + +} +\seealso{ +\link{fdata} class +} diff --git a/man/plot-model-ANY-method.Rd b/man/plot-model-ANY-method.Rd index 629d041..19588b1 100644 --- a/man/plot-model-ANY-method.Rd +++ b/man/plot-model-ANY-method.Rd @@ -13,6 +13,9 @@ \item{dev}{A logical indicating, if the plot should be shown in a graphical device. Set to \code{FALSE}, if plotted to a file.} + +\item{...}{Arguments to be passed to methods, such as graphical parameters +(see par).} } \value{ Density or barplot of the S4 model object. @@ -28,5 +31,8 @@ plot(f_model) } \seealso{ -\code{model} +\itemize{ +\item \linkS4class{model} for the class definition +\item \code{\link[=model]{model()}} for the class constructor +} } diff --git a/man/plotDens-generic.Rd b/man/plotDens-generic.Rd new file mode 100644 index 0000000..ad64112 --- /dev/null +++ b/man/plotDens-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{plotDens} +\alias{plotDens} +\title{Plots densities of MCMC samples} +\usage{ +plotDens(x, dev = TRUE, ...) +} +\description{ +Plots densities of MCMC samples +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputbase-method.Rd b/man/plotDens-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..e1c7331 --- /dev/null +++ b/man/plotDens-mcmcoutputbase-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{plotDens,mcmcoutputbase-method} +\alias{plotDens,mcmcoutputbase-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputfix-method.Rd b/man/plotDens-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..53cb102 --- /dev/null +++ b/man/plotDens-mcmcoutputfix-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{plotDens,mcmcoutputfix-method} +\alias{plotDens,mcmcoutputfix-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputfixhier-method.Rd b/man/plotDens-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..d8216fd --- /dev/null +++ b/man/plotDens-mcmcoutputfixhier-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{plotDens,mcmcoutputfixhier-method} +\alias{plotDens,mcmcoutputfixhier-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputfixhierpost-method.Rd b/man/plotDens-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..3ad0235 --- /dev/null +++ b/man/plotDens-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotDens,mcmcoutputfixhierpost-method} +\alias{plotDens,mcmcoutputfixhierpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputfixpost-method.Rd b/man/plotDens-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..7657c91 --- /dev/null +++ b/man/plotDens-mcmcoutputfixpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{plotDens,mcmcoutputfixpost-method} +\alias{plotDens,mcmcoutputfixpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note that this methid calls the equivalent method from the parent class +\code{mcmcoutputfix}. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputhierpost-method.Rd b/man/plotDens-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..414d4d8 --- /dev/null +++ b/man/plotDens-mcmcoutputhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{plotDens,mcmcoutputhierpost-method} +\alias{plotDens,mcmcoutputhierpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the density plots. + +Note that this method calls the equivalent method of the parent class. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermbase-method.Rd b/man/plotDens-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..dd393e6 --- /dev/null +++ b/man/plotDens-mcmcoutputpermbase-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{plotDens,mcmcoutputpermbase-method} +\alias{plotDens,mcmcoutputpermbase-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermfix-method.Rd b/man/plotDens-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..6dfa116 --- /dev/null +++ b/man/plotDens-mcmcoutputpermfix-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{plotDens,mcmcoutputpermfix-method} +\alias{plotDens,mcmcoutputpermfix-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled component parameters +from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermhier-method.Rd b/man/plotDens-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..4ec758c --- /dev/null +++ b/man/plotDens-mcmcoutputpermhier-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{plotDens,mcmcoutputpermhier-method} +\alias{plotDens,mcmcoutputpermhier-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. In addition, the parameters of the hierarchical prior +are plotted. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermhierpost-method.Rd b/man/plotDens-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..4e4137c --- /dev/null +++ b/man/plotDens-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotDens,mcmcoutputpermhierpost-method} +\alias{plotDens,mcmcoutputpermhierpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. In addition, the parameters of the hierarchical prior +are plotted. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermpost-method.Rd b/man/plotDens-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..ad8b022 --- /dev/null +++ b/man/plotDens-mcmcoutputpermpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{plotDens,mcmcoutputpermpost-method} +\alias{plotDens,mcmcoutputpermpost-method} +\title{Plot densities of the parameters and weights} +\usage{ +\S4method{plotDens}{mcmcoutputpermpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotDens-method.Rd b/man/plotDens-method.Rd new file mode 100644 index 0000000..5654057 --- /dev/null +++ b/man/plotDens-method.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotDens} +\alias{plotDens} +\title{Plot densities of the parameters and weights} +\arguments{ +\item{x}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing all sampled +values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +\code{plotDens()} is a class method for \link[=mcmcoutput-class]{mcmcoutput} and +\link[=mcmcoutputperm-class]{mcmcoutputperm} objects. For the former class it +plots densities of MCMC samples and for the latter of the corresponding +permuted samples coming from relabeling. +} +\details{ +Calling \code{\link[=plotDens]{plotDens()}} plots densities of the sampled parameters and weights +from MCMC sampling. Note, for relabeled MCMC samples this method is so far +only implemented for mixtures of Poisson and Binomial distributions. +\subsection{Hierarchical priors}{ + +In case that hierarchical priors had been used in MCMC sampling densities +of the sampled parameters of the hierarchical prior are added to the plot. +} + +\subsection{Posterior density parameters}{ + +In case that posterior density parameters had been stored in MCMC sampling, +densities of these parameters are added to the plot. +} +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +\item \linkS4class{mcmcoutput} for the class definition of \code{mcmcoutput} +\item \linkS4class{mcmcoutputperm} for the class definition of \code{mcmcoutputperm} +} +} diff --git a/man/plotHist-generic.Rd b/man/plotHist-generic.Rd new file mode 100644 index 0000000..6cb79f8 --- /dev/null +++ b/man/plotHist-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{plotHist} +\alias{plotHist} +\title{Plots histograms of MCMC samples} +\usage{ +plotHist(x, dev = TRUE, ...) +} +\description{ +Plots histograms of MCMC samples +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputbase-method.Rd b/man/plotHist-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..f656232 --- /dev/null +++ b/man/plotHist-mcmcoutputbase-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{plotHist,mcmcoutputbase-method} +\alias{plotHist,mcmcoutputbase-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputfix-method.Rd b/man/plotHist-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..54a3bd7 --- /dev/null +++ b/man/plotHist-mcmcoutputfix-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{plotHist,mcmcoutputfix-method} +\alias{plotHist,mcmcoutputfix-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputfixhier-method.Rd b/man/plotHist-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..ff313a2 --- /dev/null +++ b/man/plotHist-mcmcoutputfixhier-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{plotHist,mcmcoutputfixhier-method} +\alias{plotHist,mcmcoutputfixhier-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputfixhierpost-method.Rd b/man/plotHist-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..df02296 --- /dev/null +++ b/man/plotHist-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotHist,mcmcoutputfixhierpost-method} +\alias{plotHist,mcmcoutputfixhierpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputfixpost-method.Rd b/man/plotHist-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..95c0702 --- /dev/null +++ b/man/plotHist-mcmcoutputfixpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{plotHist,mcmcoutputfixpost-method} +\alias{plotHist,mcmcoutputfixpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfix}. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputhierpost-method.Rd b/man/plotHist-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..b5b2778 --- /dev/null +++ b/man/plotHist-mcmcoutputhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{plotHist,mcmcoutputhierpost-method} +\alias{plotHist,mcmcoutputhierpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling.More specifically, all component parameters, \code{K-1} of the +weights and the posterior parameters are considered in the histogram plots. + +Note, this method calls the equivalent method of the parent class. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotHist(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermbase-method.Rd b/man/plotHist-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..346e092 --- /dev/null +++ b/man/plotHist-mcmcoutputpermbase-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{plotHist,mcmcoutputpermbase-method} +\alias{plotHist,mcmcoutputpermbase-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mictures of Poisson and +Binomial distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermfix-method.Rd b/man/plotHist-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..fa916b0 --- /dev/null +++ b/man/plotHist-mcmcoutputpermfix-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{plotHist,mcmcoutputpermfix-method} +\alias{plotHist,mcmcoutputpermfix-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled component parameters +from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermhier-method.Rd b/man/plotHist-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..4d11c7b --- /dev/null +++ b/man/plotHist-mcmcoutputpermhier-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{plotHist,mcmcoutputpermhier-method} +\alias{plotHist,mcmcoutputpermhier-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. In addition the parameters of the hierarchical prior are +plotted. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermhierpost-method.Rd b/man/plotHist-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..2d4f9f2 --- /dev/null +++ b/man/plotHist-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotHist,mcmcoutputpermhierpost-method} +\alias{plotHist,mcmcoutputpermhierpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. In addition the parameters of the hierarchical prior are +plotted. + +Note, this method is so far only implemented for mictures of Poisson and +Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermpost-method.Rd b/man/plotHist-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..d4e1548 --- /dev/null +++ b/man/plotHist-mcmcoutputpermpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{plotHist,mcmcoutputpermpost-method} +\alias{plotHist,mcmcoutputpermpost-method} +\title{Plot histograms of the parameters and weights} +\usage{ +\S4method{plotHist}{mcmcoutputpermpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. + +Note, this method is so far only implemented for mixtures of Poisson and +Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotHist-method.Rd b/man/plotHist-method.Rd new file mode 100644 index 0000000..904999f --- /dev/null +++ b/man/plotHist-method.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotHist} +\alias{plotHist} +\title{Plot histograms of the parameters and weights} +\arguments{ +\item{x}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing all sampled +values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Histograms of the MCMC samples. +} +\description{ +\code{plotHist()} is a class method for \link[=mcmcoutput-class]{mcmcoutput} and +\link[=mcmcoutputperm-class]{mcmcoutputperm} objects. For the former class it +plots histograms of MCMC samples and for the latter of the corresponding +permuted samples coming from relabeling. +} +\details{ +Calling \code{\link[=plotHist]{plotHist()}} plots histograms of the sampled parameters and weights +from MCMC sampling. Note, for relabeled MCMC samples this method is so far +only implemented for mixtures of Poisson and Binomial distributions. +\subsection{Hierarchical priors}{ + +In case that hierarchical priors had been used in MCMC sampling histograms +of the sampled parameters of the hierarchical prior are added to the plot. +} + +\subsection{Posterior density parameters}{ + +In case that posterior density parameters had been stored in MCMC sampling, +histograms of these parameters are added to the plot. +} +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotHist(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +\item \linkS4class{mcmcoutput} for the class definition of \code{mcmcoutput} +\item \linkS4class{mcmcoutputperm} for the class definition of \code{mcmcoutputperm} +} +} diff --git a/man/plotPointProc-generic.Rd b/man/plotPointProc-generic.Rd new file mode 100644 index 0000000..e3ef3c6 --- /dev/null +++ b/man/plotPointProc-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{plotPointProc} +\alias{plotPointProc} +\title{Plots the point process of a finite mixture model} +\usage{ +plotPointProc(x, dev = TRUE, ...) +} +\description{ +Plots the point process of a finite mixture model +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputbase-method.Rd b/man/plotPointProc-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..ff61dee --- /dev/null +++ b/man/plotPointProc-mcmcoutputbase-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{plotPointProc,mcmcoutputbase-method} +\alias{plotPointProc,mcmcoutputbase-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point processes of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputfix-method.Rd b/man/plotPointProc-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..5e53d30 --- /dev/null +++ b/man/plotPointProc-mcmcoutputfix-method.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{plotPointProc,mcmcoutputfix-method} +\alias{plotPointProc,mcmcoutputfix-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputfixhier-method.Rd b/man/plotPointProc-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..a61a96b --- /dev/null +++ b/man/plotPointProc-mcmcoutputfixhier-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{plotPointProc,mcmcoutputfixhier-method} +\alias{plotPointProc,mcmcoutputfixhier-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputfixhierpost-method.Rd b/man/plotPointProc-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..aaf8540 --- /dev/null +++ b/man/plotPointProc-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotPointProc,mcmcoutputfixhierpost-method} +\alias{plotPointProc,mcmcoutputfixhierpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this methid calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputfixpost-method.Rd b/man/plotPointProc-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..7721b4a --- /dev/null +++ b/man/plotPointProc-mcmcoutputfixpost-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{plotPointProc,mcmcoutputfixpost-method} +\alias{plotPointProc,mcmcoutputfixpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this methid calls the equivalent method from the parent class +\code{mcmcoutputfix}. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPointProc(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermbase-method.Rd b/man/plotPointProc-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..9f251fc --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermbase-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{plotPointProc,mcmcoutputpermbase-method} +\alias{plotPointProc,mcmcoutputpermbase-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermfix-method.Rd b/man/plotPointProc-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..c58eec1 --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermfix-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{plotPointProc,mcmcoutputpermfix-method} +\alias{plotPointProc,mcmcoutputpermfix-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermhier-method.Rd b/man/plotPointProc-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..ade074c --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermhier-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{plotPointProc,mcmcoutputpermhier-method} +\alias{plotPointProc,mcmcoutputpermhier-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-mcmcoutputpermhierpost-method.Rd b/man/plotPointProc-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..5defadb --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotPointProc,mcmcoutputpermhierpost-method} +\alias{plotPointProc,mcmcoutputpermhierpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermpost-method.Rd b/man/plotPointProc-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..75387ed --- /dev/null +++ b/man/plotPointProc-mcmcoutputpermpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{plotPointProc,mcmcoutputpermpost-method} +\alias{plotPointProc,mcmcoutputpermpost-method} +\title{Plot point processes of the component parameters} +\usage{ +\S4method{plotPointProc}{mcmcoutputpermpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} plots point processes of the sampled component +parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotPointProc-method.Rd b/man/plotPointProc-method.Rd new file mode 100644 index 0000000..8f42bac --- /dev/null +++ b/man/plotPointProc-method.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotPointProc} +\alias{plotPointProc} +\title{Plot the point process of the component parameters} +\arguments{ +\item{x}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing all sampled +values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +The point process of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPointProc]{plotPointProc()}} on an object of class \code{mcmcoutput} or +\code{mcmcoutputperm} plots the point process of the sampled component parameters +from MCMC sampling, either the original parameters or the relabeled ones. +} +\details{ +The point process is used to identify the number of components in the +underlying distribution of the data for mixtures with unknown number of +components (see Frühwirth-Schnatter (2006, Subsection 3.7.1)). The number of +clusters that evolve in the plot give a hint on the true number of +components in the mixture distribution. The MCMC draws will scatter around +the points corresponding to the true point process of the mixture model. The +spread of the clusters represent the uncertainty of estimating the points. + +For mixtures with univariate component parameters (e.g. Poisson, +Exponential) the component parameters are plotted against draws from a +standard normal distribution. For mixtures with bivariate component +parameters (e.g. Normal) the first parameters are plotted against the +second ones. For mixtures with multivariate component parameters a point +process for each type of mixture model is plotted. + +Note that this method for \code{mcmcoutputperm} objects is only implemented for +mixtures of Poisson and Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPointProc(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotPointProc-model-method.Rd b/man/plotPointProc-model-method.Rd index c414a40..ee2d793 100644 --- a/man/plotPointProc-model-method.Rd +++ b/man/plotPointProc-model-method.Rd @@ -2,17 +2,18 @@ % Please edit documentation in R/model.R \name{plotPointProc,model-method} \alias{plotPointProc,model-method} -\title{Plots point process.} +\title{Plots the point process of a finite model} \usage{ \S4method{plotPointProc}{model}(x, dev = TRUE, ...) } \arguments{ -\item{x}{An S4 model object with defined parameters and weigths.} +\item{x}{An S4 model object with defined parameters and weights.} \item{dev}{A logical indicating, if the plot should be shown in a graphical device. Set to \code{FALSE}, if plotted to a file.} -\item{y}{Unused.} +\item{...}{Arguments to be passed to methods, such as graphical parameters +(see \link{par}).} } \value{ A scatter plot of weighted parameters. diff --git a/man/plotPostDens-generic.Rd b/man/plotPostDens-generic.Rd new file mode 100644 index 0000000..9996e4c --- /dev/null +++ b/man/plotPostDens-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{plotPostDens} +\alias{plotPostDens} +\title{Plots the posterior density of sampled component parameters} +\usage{ +plotPostDens(x, dev = TRUE, ...) +} +\description{ +Plots the posterior density of sampled component parameters +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputbase-method.Rd b/man/plotPostDens-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..61fe2a3 --- /dev/null +++ b/man/plotPostDens-mcmcoutputbase-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{plotPostDens,mcmcoutputbase-method} +\alias{plotPostDens,mcmcoutputbase-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputfix-method.Rd b/man/plotPostDens-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..79643b0 --- /dev/null +++ b/man/plotPostDens-mcmcoutputfix-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{plotPostDens,mcmcoutputfix-method} +\alias{plotPostDens,mcmcoutputfix-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputfixhier-method.Rd b/man/plotPostDens-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..1a513ed --- /dev/null +++ b/man/plotPostDens-mcmcoutputfixhier-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{plotPostDens,mcmcoutputfixhier-method} +\alias{plotPostDens,mcmcoutputfixhier-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputfixhierpost-method.Rd b/man/plotPostDens-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..d9ad2c7 --- /dev/null +++ b/man/plotPostDens-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotPostDens,mcmcoutputfixhierpost-method} +\alias{plotPostDens,mcmcoutputfixhierpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method calls the equivalent method of the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputfixpost-method.Rd b/man/plotPostDens-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..b65e968 --- /dev/null +++ b/man/plotPostDens-mcmcoutputfixpost-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{plotPostDens,mcmcoutputfixpost-method} +\alias{plotPostDens,mcmcoutputfixpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this methid calls the equivalent method of the parent class +\code{mcmcoutputfix}. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputhier-method.Rd b/man/plotPostDens-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..8dcb178 --- /dev/null +++ b/man/plotPostDens-mcmcoutputhier-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{plotPostDens,mcmcoutputhier-method} +\alias{plotPostDens,mcmcoutputhier-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputhierpost-method.Rd b/man/plotPostDens-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..a16b23a --- /dev/null +++ b/man/plotPostDens-mcmcoutputhierpost-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{plotPostDens,mcmcoutputhierpost-method} +\alias{plotPostDens,mcmcoutputhierpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method calls the equivalent method of the parent class. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermbase-method.Rd b/man/plotPostDens-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..ac18613 --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermbase-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{plotPostDens,mcmcoutputpermbase-method} +\alias{plotPostDens,mcmcoutputpermbase-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermfix-method.Rd b/man/plotPostDens-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..a40a3cc --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermfix-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{plotPostDens,mcmcoutputpermfix-method} +\alias{plotPostDens,mcmcoutputpermfix-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermfixhier-method.Rd b/man/plotPostDens-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..428320b --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{plotPostDens,mcmcoutputpermfixhier-method} +\alias{plotPostDens,mcmcoutputpermfixhier-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfixhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson and Binomial +mixture distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermhier-method.Rd b/man/plotPostDens-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..1e5fb50 --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermhier-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{plotPostDens,mcmcoutputpermhier-method} +\alias{plotPostDens,mcmcoutputpermhier-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermhierpost-method.Rd b/man/plotPostDens-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..a5da9c0 --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotPostDens,mcmcoutputpermhierpost-method} +\alias{plotPostDens,mcmcoutputpermhierpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermpost-method.Rd b/man/plotPostDens-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..836514b --- /dev/null +++ b/man/plotPostDens-mcmcoutputpermpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{plotPostDens,mcmcoutputpermpost-method} +\alias{plotPostDens,mcmcoutputpermpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpermpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. + +Note, this method is so far only implemented for Poisson or Binomial +mixture distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotPostDens(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpost-method.Rd b/man/plotPostDens-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..93e2770 --- /dev/null +++ b/man/plotPostDens-mcmcoutputpost-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{plotPostDens,mcmcoutputpost-method} +\alias{plotPostDens,mcmcoutputpost-method} +\title{Plot posterior densities of the component parameters} +\usage{ +\S4method{plotPostDens}{mcmcoutputpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{ mcmcoutputpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Posterior densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} plots posterior densities of the sampled component +parameters from MCMC sampling, if the number of components is two. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +} +} +\keyword{internal} diff --git a/man/plotPostDens-method.Rd b/man/plotPostDens-method.Rd new file mode 100644 index 0000000..dd0d7bb --- /dev/null +++ b/man/plotPostDens-method.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotPostDens} +\alias{plotPostDens} +\title{Plot the posterior density of component parameters} +\arguments{ +\item{x}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing all sampled +values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +The posterior density of the MCMC samples. +} +\description{ +Calling \code{\link[=plotPostDens]{plotPostDens()}} on an object of class \code{mcmcoutput} or +\code{mcmcoutputperm} plots the posterior density of the sampled component +parameters from MCMC sampling, either the original parameters or the +relabeled ones (\code{mcmcoutputperm}). +} +\details{ +Next to sampling representations and the point process of MCMC samples the +posterior density of component parameters can also be plotted directly for +finite mixture distributions with \code{ K=2} components and a single parameter. +The posterior density will always be bimodal due to to label-switching in +the MCMC sampling. This could change when considering a relabeld MCMC sample +(\code{mcmcoutputperm} object). + +Note that this method for \code{mcmcoutputperm} objects is only implemented for +mixtures of Poisson and Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotPostDens(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting the point process of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting the sampling representation for sampled values +} +} diff --git a/man/plotSampRep-generic.Rd b/man/plotSampRep-generic.Rd new file mode 100644 index 0000000..9e886fe --- /dev/null +++ b/man/plotSampRep-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{plotSampRep} +\alias{plotSampRep} +\title{Plots sample representations of MCMC samples} +\usage{ +plotSampRep(x, dev = TRUE, ...) +} +\description{ +Plots sample representations of MCMC samples +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputbase-method.Rd b/man/plotSampRep-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..0f1c144 --- /dev/null +++ b/man/plotSampRep-mcmcoutputbase-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{plotSampRep,mcmcoutputbase-method} +\alias{plotSampRep,mcmcoutputbase-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representations of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputfix-method.Rd b/man/plotSampRep-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..34a779c --- /dev/null +++ b/man/plotSampRep-mcmcoutputfix-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{plotSampRep,mcmcoutputfix-method} +\alias{plotSampRep,mcmcoutputfix-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputfixhier-method.Rd b/man/plotSampRep-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..f64e618 --- /dev/null +++ b/man/plotSampRep-mcmcoutputfixhier-method.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{plotSampRep,mcmcoutputfixhier-method} +\alias{plotSampRep,mcmcoutputfixhier-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputfixhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputfixhierpost-method.Rd b/man/plotSampRep-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..a6d4267 --- /dev/null +++ b/man/plotSampRep-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotSampRep,mcmcoutputfixhierpost-method} +\alias{plotSampRep,mcmcoutputfixhierpost-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputfixhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method calls the equivalent method of the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputfixpost-method.Rd b/man/plotSampRep-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..a02e1dc --- /dev/null +++ b/man/plotSampRep-mcmcoutputfixpost-method.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{plotSampRep,mcmcoutputfixpost-method} +\alias{plotSampRep,mcmcoutputfixpost-method} +\title{Plot sampling representations for the component parameters.} +\usage{ +\S4method{plotSampRep}{mcmcoutputfixpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method calls the equivalent method of the parent class +\code{mcmcoutputfix}. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermbase-method.Rd b/man/plotSampRep-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..1d577e6 --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermbase-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{plotSampRep,mcmcoutputpermbase-method} +\alias{plotSampRep,mcmcoutputpermbase-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermbase}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermfix-method.Rd b/man/plotSampRep-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..640468d --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermfix-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{plotSampRep,mcmcoutputpermfix-method} +\alias{plotSampRep,mcmcoutputpermfix-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermfix}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Sampling represetnation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermhier-method.Rd b/man/plotSampRep-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..50a7f22 --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermhier-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{plotSampRep,mcmcoutputpermhier-method} +\alias{plotSampRep,mcmcoutputpermhier-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermhier}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermhierpost-method.Rd b/man/plotSampRep-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..01c15ab --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotSampRep,mcmcoutputpermhierpost-method} +\alias{plotSampRep,mcmcoutputpermhierpost-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermhierpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermpost-method.Rd b/man/plotSampRep-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..b6fee13 --- /dev/null +++ b/man/plotSampRep-mcmcoutputpermpost-method.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{plotSampRep,mcmcoutputpermpost-method} +\alias{plotSampRep,mcmcoutputpermpost-method} +\title{Plot sampling representations for the component parameters} +\usage{ +\S4method{plotSampRep}{mcmcoutputpermpost}(x, dev = TRUE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +Densities of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} plots sampling representations of the sampled +component parameters from MCMC sampling. + +Note, this method is only implemented for mixtures of Poisson and Binomial +distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotSampRep(f_outputperm) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} +\keyword{internal} diff --git a/man/plotSampRep-method.Rd b/man/plotSampRep-method.Rd new file mode 100644 index 0000000..5c5f72e --- /dev/null +++ b/man/plotSampRep-method.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotSampRep} +\alias{plotSampRep} +\title{Plot the sampling representation of component parameters} +\arguments{ +\item{x}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing all sampled +values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +The sampling representation of the MCMC samples. +} +\description{ +Calling \code{\link[=plotSampRep]{plotSampRep()}} on an object of class \code{mcmcoutput} or +\code{mcmcoutputperm} plots the sampling representation of the sampled component +parameters from MCMC sampling, either the original parameters or the +relabeled ones (\code{mcmcoutputperm}). +} +\details{ +To visualize the posterior density of the component parameters the MCMC +draws are used as a sampling representation. Each combination of component +parameters is plotted in a scatter to visualize the contours of the +posterior density. For bivariate component parameters this could also be +done by estimating and plotting the density directly, but for +higher-dimensional parameter vectors this is not anymore possible and so +sampling representations define a proper solution for visualization and +allow us to study how a specific dimension of the parameter vector differs +among the various components of the mixture distribution. If this element +is significantly different among components we will observe \code{K(K-1)} modes +in the sampling representation. On the other side, if this element is +mainly the same among the components of the mixture, we will rather observe +a single cluster. + +As Frühwirth-Schnatter (2006) writes, "One informal method for diagnosing +mixtures is mode hunting in the mixture posterior density +(Frühwirth-Schnatter, 2001b). It is based on the observation that with an +increasing number of observations, the mixture likelihood function has \verb{K!} +dominant modes if the data actually arise from a finite mixture distribution +with \code{K} components, and that less than \verb{K!} dominant modes are present if +the finite mixture model is overfitting the number of components." The +sampling representation helps to perform this mode hunting in practice. + +Note that this method for \code{mcmcoutputperm} objects is only implemented for +mixtures of Poisson and Binomial distributions. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotSampRep(f_output) + +} +\references{ +\itemize{ +\item Frühwirth-Schnatter (2006), "Finite Mixture and Markov Switching Models" +\item Frühwirth-Schnatter, S. (2001b), "Markov chain Monte Carlo estimation of +classical and dynamic switching and mixture models." Journal of the +American Statistical Association 96, 194–209. +} +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting the traces of sampled values +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting the point process of sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values +} +} diff --git a/man/plotTraces-generic.Rd b/man/plotTraces-generic.Rd new file mode 100644 index 0000000..84f483a --- /dev/null +++ b/man/plotTraces-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{plotTraces} +\alias{plotTraces} +\title{Plots the traces of the MCMC samples} +\usage{ +plotTraces(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\description{ +Plots the traces of the MCMC samples +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputbase-method.Rd b/man/plotTraces-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..4364a5b --- /dev/null +++ b/man/plotTraces-mcmcoutputbase-method.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{plotTraces,mcmcoutputbase-method} +\alias{plotTraces,mcmcoutputbase-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{0}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Complete object slots for consistency. +(f_data ~ f_model ~ f_mcmc) \%=\% mcmcstart(f_data, f_model, f_mcmc) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputfix-method.Rd b/man/plotTraces-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..c9e733e --- /dev/null +++ b/man/plotTraces-mcmcoutputfix-method.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{plotTraces,mcmcoutputfix-method} +\alias{plotTraces,mcmcoutputfix-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputfixhier-method.Rd b/man/plotTraces-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..b6c4be9 --- /dev/null +++ b/man/plotTraces-mcmcoutputfixhier-method.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{plotTraces,mcmcoutputfixhier-method} +\alias{plotTraces,mcmcoutputfixhier-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputfixhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{0}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputfixhierpost-method.Rd b/man/plotTraces-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..702780c --- /dev/null +++ b/man/plotTraces-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{plotTraces,mcmcoutputfixhierpost-method} +\alias{plotTraces,mcmcoutputfixhierpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputfixhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputfixhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. If \code{lik} is set to \code{0} the parameters of the components and the +posterior parameters are plotted together with \code{K-1} weights. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfixhier}. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputfixpost-method.Rd b/man/plotTraces-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..e27fd16 --- /dev/null +++ b/man/plotTraces-mcmcoutputfixpost-method.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{plotTraces,mcmcoutputfixpost-method} +\alias{plotTraces,mcmcoutputfixpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputfixpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutput} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. If \code{lik} is set to \code{0} the parameters of the components and the +posterior parameters are plotted together with \code{K-1} weights. + +Note that this method calls the equivalent method from the parent class +\code{mcmcoutputfix}. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputhierpost-method.Rd b/man/plotTraces-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..d50248b --- /dev/null +++ b/man/plotTraces-mcmcoutputhierpost-method.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{plotTraces,mcmcoutputhierpost-method} +\alias{plotTraces,mcmcoutputhierpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s If \code{lik} is set to \code{0} the parameters of the components and the +posterior parameters are plotted together with \code{K-1} weights. + +Note that this method calls the equivalent method from the parent class. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +plotTraces(f_output, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermbase-method.Rd b/man/plotTraces-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..50d3852 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermbase-method.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{plotTraces,mcmcoutputpermbase-method} +\alias{plotTraces,mcmcoutputpermbase-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermbase}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +\dontrun{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) +} + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermfix-method.Rd b/man/plotTraces-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..27e6f52 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermfix-method.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{plotTraces,mcmcoutputpermfix-method} +\alias{plotTraces,mcmcoutputpermfix-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermfix}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermfix} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}.s + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2, + indicfix = TRUE) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermhier-method.Rd b/man/plotTraces-mcmcoutputpermhier-method.Rd new file mode 100644 index 0000000..fbe9243 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermhier-method.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhier.R +\name{plotTraces,mcmcoutputpermhier-method} +\alias{plotTraces,mcmcoutputpermhier-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermhier}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermhier} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the hierarchical +prior are plotted together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermhierpost-method.Rd b/man/plotTraces-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..f5bade7 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotTraces,mcmcoutputpermhierpost-method} +\alias{plotTraces,mcmcoutputpermhierpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermhierpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermbase} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components, the posterior +parameters, and the parameters of the hierarchical prior are plotted +together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermpost-method.Rd b/man/plotTraces-mcmcoutputpermpost-method.Rd new file mode 100644 index 0000000..219caa4 --- /dev/null +++ b/man/plotTraces-mcmcoutputpermpost-method.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermpost.R +\name{plotTraces,mcmcoutputpermpost-method} +\alias{plotTraces,mcmcoutputpermpost-method} +\title{Plot traces of MCMC sampling} +\usage{ +\S4method{plotTraces}{mcmcoutputpermpost}(x, dev = TRUE, lik = 1, col = FALSE, ...) +} +\arguments{ +\item{x}{An \code{mcmcoutputpermpost} object containing all sampled values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +Calling \code{\link[=plotTraces]{plotTraces()}} plots the MCMC traces of the mixture log-likelihood +, the mixture log-likelihood of the prior distribution, the log-likelihood +of the complete data posterior, or the weights and parameters if \code{lik} is +set to \code{1}. + +If \code{lik} is set to \code{0} the parameters of the components and the posterior +parameters are plotted together with \code{K-1} weights. +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc() +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +} +} +\keyword{internal} diff --git a/man/plotTraces-method.Rd b/man/plotTraces-method.Rd new file mode 100644 index 0000000..3478f93 --- /dev/null +++ b/man/plotTraces-method.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{plotTraces} +\alias{plotTraces} +\title{Plots traces of MCMC sampling} +\arguments{ +\item{x}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing all sampled +values.} + +\item{dev}{A logical indicating, if the plots should be shown by a graphical +device. If plots should be stored to a file set \code{dev} to \code{FALSE}.} + +\item{lik}{An integer indicating, if the log-likelihood traces should be +plotted (default). If set to \code{0} the traces for the parameters +and weights are plotted instead.} + +\item{col}{A logical indicating, if the plot should be colored.} + +\item{...}{Further arguments to be passed to the plotting function.} +} +\value{ +A plot of the traces of the MCMC samples. +} +\description{ +\code{plotTraces()} is a class method for \link[=mcmcoutput-class]{mcmcoutput} and +\link[=mcmcoutputperm-class]{mcmcoutputperm} objects. For the former class it +plots the traces of MCMC samples and for the latter of the corresponding +permuted samples coming from relabeling. +} +\details{ +Calling \code{\link[=plotTraces]{plotTraces()}} with \code{lik} set to \code{1}, plots the MCMC traces of the +mixture log-likelihood, the mixture log-likelihood of the prior +distribution, or the log-likelihood of the complete data posterior, if the +model has unknown indicators. + +If \code{lik} is set to \code{0} the parameters of the components, the posterior +parameters, and the parameters of the hierarchical prior are plotted +together with \code{K-1} weights. +\subsection{Hierarchical priors}{ + +In case of hierarchical priors, the function also plots traces from the +sampled hierarchical prior's parameters, in case \code{lik} is set to \code{1}. +} + +\subsection{Posterior density parameters}{ + +In case posterior density parameters had been stored in MCMC sampling, the +traces of these parameters are added to the plot. +} +} +\examples{ +# Define a Poisson mixture model with two components. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the mixture model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Do not use a hierarchical prior. +setHier(f_prior) <- FALSE +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +f_outputperm <- mcmcpermute(f_output) +plotTraces(f_outputperm, lik = 0) + +} +\seealso{ +\itemize{ +\item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for permuting MCMC samples +\item \code{\link[=plotHist]{plotHist()}} for plotting histograms of sampled values +\item \code{\link[=plotDens]{plotDens()}} for plotting densities of sampled values +\item \code{\link[=plotSampRep]{plotSampRep()}} for plotting sampling representations of sampled values +\item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values +\item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters +\item \linkS4class{mcmcoutput} for the class definition of \code{mcmcoutput} +\item \linkS4class{mcmcoutputperm} for the class definition of \code{mcmcoutputperm} +} +} diff --git a/man/poissonmodelmoments-class.Rd b/man/poissonmodelmoments-class.Rd new file mode 100644 index 0000000..6ab6aef --- /dev/null +++ b/man/poissonmodelmoments-class.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poissonmodelmoments.R +\docType{class} +\name{poissonmodelmoments-class} +\alias{poissonmodelmoments-class} +\alias{.poissonmodelmoments} +\title{Finmix \code{poissonmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of poisson +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\seealso{ +\itemize{ +\item \linkS4class{dmodelmoments} for the parent class +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} +\keyword{internal} diff --git a/man/prior.Rd b/man/prior.Rd index 4e9c475..20656f9 100644 --- a/man/prior.Rd +++ b/man/prior.Rd @@ -11,35 +11,35 @@ prior( hier = TRUE ) } -\description{ -Calling \code{\link[=prior]{prior()}} constructs an object of class \link[=prior-class]{prior}. The -constructor can be called without providing any arguments, but the prior -has to be filled with appropriate parameters when MCMC sampling should be -performed. - -There exists next to the general constructor also an advanced constructor -that specifies a data dependent prior. See \code{\link[=priordefine]{priordefine()}} for this advanced -constructor. -} -\section{Slots}{ - -\describe{ -\item{\code{weight}}{A matrix storing the prior parameters for the \code{weight} of a +\arguments{ +\item{weight}{A matrix storing the prior parameters for the \code{weight} of a finite mixture model.} -\item{\code{par}}{A list storing the prior parameters for the parameters of a finite +\item{par}{A list storing the prior parameters for the parameters of a finite mixture model.} -\item{\code{type}}{A character specifying what type of prior should be used in +\item{type}{A character specifying what type of prior should be used in Bayesian estimation. Either \code{"independent"} for an independent prior distribution or \code{"condconjugate"} for a conditionally conjugate prior distribution.} -\item{\code{hier}}{A logical defining, if the used prior should be hierarchical. +\item{hier}{A logical defining, if the used prior should be hierarchical. Hierarchical prior are often more robust, but need an additional layer in sampling, so computing costs increase.} -}} +} +\value{ +A \code{prior} object with the specified slots. +} +\description{ +Calling \code{\link[=prior]{prior()}} constructs an object of class \link[=prior-class]{prior}. The +constructor can be called without providing any arguments, but the prior +has to be filled with appropriate parameters when MCMC sampling should be +performed. +There exists next to the general constructor also an advanced constructor +that specifies a data dependent prior. See \code{\link[=priordefine]{priordefine()}} for this advanced +constructor. +} \examples{ # Call the default constructor without any arguments. f_prior <- prior() @@ -47,7 +47,8 @@ f_prior <- prior() } \references{ \itemize{ -\item Fr\"uhwirth-Schnatter, S (2006), "Finite Mixture and Markov Switching Models" +\item Fr\"uhwirth-Schnatter, S (2006), +"Finite Mixture and Markov Switching Models" } } \seealso{ diff --git a/man/qincol.Rd b/man/qincol.Rd index 0e88e4f..c7b2162 100644 --- a/man/qincol.Rd +++ b/man/qincol.Rd @@ -7,7 +7,7 @@ qincol(m) } \arguments{ -\item{q}{A symmetric matrix or dimension \code{rxr}.} +\item{m}{A symmetric matrix or dimension \code{rxr}.} } \value{ A vector of length \code{r(r+1)/2}. diff --git a/man/qincolmult.Rd b/man/qincolmult.Rd index d607222..0bd82f8 100644 --- a/man/qincolmult.Rd +++ b/man/qincolmult.Rd @@ -7,17 +7,17 @@ qincolmult(a) } \arguments{ -\item{q}{A symmetric matrix or dimension \code{rxr}.} +\item{a}{An array of symmetric matrices or dimension \code{rxrxK}.} } \value{ -A vector of length \code{r(r+1)/2}. +A matrix of dimension \verb{r(r+1)/2xK}. } \description{ Calling \code{\link[=qincolmult]{qincolmult()}} on an array of symmetric matrices all with dimension \code{rxr} converts these matrices into an array of vectors with length \code{r(r+1)/2}. This function is used to handle the MCMC sampling output from multivariate finite mixture models. To save storage the symmetric -variance-covariance matrices of multivariate mixtures are stored vector +variance-covariance matrices of multivariate mixtures are stored in vector form. If the covariance matrices are needed for calculations the functions \code{\link[=qinmatr]{qinmatr()}} and \code{\link[=qinmatrmult]{qinmatrmult()}} helps to restore these matrices from the storage vectors. diff --git a/man/qinmatrmult.Rd b/man/qinmatrmult.Rd index ee23a21..53d131e 100644 --- a/man/qinmatrmult.Rd +++ b/man/qinmatrmult.Rd @@ -7,7 +7,7 @@ qinmatrmult(m) } \arguments{ -\item{q}{A matrix or array of vectors of dimension \verb{r(r+1)/2x1}.} +\item{m}{A matrix or array of vectors of dimension \verb{r(r+1)/2x1}.} } \value{ An array of symmetric matrices, all of dimension \code{rxr}. diff --git a/man/sdatamoments-class.Rd b/man/sdatamoments-class.Rd new file mode 100644 index 0000000..a9bccb8 --- /dev/null +++ b/man/sdatamoments-class.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\docType{class} +\name{sdatamoments-class} +\alias{sdatamoments-class} +\alias{.sdatamoments} +\title{Finmix \code{sdatamoments} class} +\description{ +Stores moments for indicators of discrete data. +} +\section{Slots}{ + +\describe{ +\item{\code{gmoments}}{A \linkS4class{groupmoments} object storing the +moments for each mixture component.} + +\item{\code{fdata}}{An \linkS4class{fdata} object with data from a discrete valued +mixture distribution.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the base class for data moments +\item \code{\link[=datamoments]{datamoments()}} for the constructor of any object of the \code{datamoments} +class family +\item \linkS4class{groupmoments} for the parent class +\item \linkS4class{csdatamoments} for the corresponding class defining +moments for data from a continuous-valued finite mixture +} +} diff --git a/man/setBurnin-set-mcmc-method.Rd b/man/setBurnin-set-mcmc-method.Rd new file mode 100644 index 0000000..111e47e --- /dev/null +++ b/man/setBurnin-set-mcmc-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{setBurnin<-,mcmc-method} +\alias{setBurnin<-,mcmc-method} +\title{Setter method of \code{mcmc} class.} +\usage{ +\S4method{setBurnin}{mcmc}(object) <- value +} +\arguments{ +\item{object}{An \code{mcmc} object.} + +\item{value}{An integer defining the new value for the \verb{@burnin} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Set the slot +setBurnin(f_mcmc) <- as.integer(2000) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/setBurnin-set.Rd b/man/setBurnin-set.Rd new file mode 100644 index 0000000..fe8fd7c --- /dev/null +++ b/man/setBurnin-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setBurnin<-} +\alias{setBurnin<-} +\title{Setter for the \code{burnin} slot} +\usage{ +setBurnin(object) <- value +} +\description{ +Setter for the \code{burnin} slot +} +\keyword{internal} diff --git a/man/setBycolumn-set-fdata-method.Rd b/man/setBycolumn-set-fdata-method.Rd new file mode 100644 index 0000000..1d2c4d2 --- /dev/null +++ b/man/setBycolumn-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setBycolumn<-,fdata-method} +\alias{setBycolumn<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setBycolumn}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{bycolumn} should be set.} + +\item{value}{A logical that should be set as \code{bycolumn} slot of the \code{fdata} +object.} +} +\value{ +The \code{fdata} object with slot \code{bycolumn} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{bycolumn}. +} +\description{ +Sets the slot \code{bycolumn} of an \code{fdata} object and validates the slot data +before setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setBycolumn(f_data) <- TRUE + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setBycolumn-set.Rd b/man/setBycolumn-set.Rd new file mode 100644 index 0000000..91d53cf --- /dev/null +++ b/man/setBycolumn-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setBycolumn<-} +\alias{setBycolumn<-} +\title{Setter for the \code{bycolumn} format} +\usage{ +setBycolumn(object) <- value +} +\description{ +Setter for the \code{bycolumn} format +} +\keyword{internal} diff --git a/man/setDist-set-model-method.Rd b/man/setDist-set-model-method.Rd new file mode 100644 index 0000000..75aa524 --- /dev/null +++ b/man/setDist-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setDist<-,model-method} +\alias{setDist<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setDist}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{A character defining the distribution.} +} +\value{ +The \code{model} object with slot \code{dist} set to \code{value}. +} +\description{ +Sets a value for the \code{dist} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Get the slot +setDist(f_model) <- "poisson" + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setDist-set.Rd b/man/setDist-set.Rd new file mode 100644 index 0000000..c56045a --- /dev/null +++ b/man/setDist-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setDist<-} +\alias{setDist<-} +\title{Setter for the \code{dist} slot} +\usage{ +setDist(object) <- value +} +\description{ +Setter for the \code{dist} slot +} +\keyword{internal} diff --git a/man/setExp-set-fdata-method.Rd b/man/setExp-set-fdata-method.Rd new file mode 100644 index 0000000..b0ae160 --- /dev/null +++ b/man/setExp-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setExp<-,fdata-method} +\alias{setExp<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setExp}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{exp} should be set.} + +\item{value}{A matrix that should be set as \code{exp} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +The \code{fdata} object with slot \code{exp} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{exp}. +} +\description{ +Sets the slot \code{exp} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setExp(f_data) <- matrix(rep(100, 100)) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setExp-set.Rd b/man/setExp-set.Rd new file mode 100644 index 0000000..869151b --- /dev/null +++ b/man/setExp-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setExp<-} +\alias{setExp<-} +\title{Setter for the \code{exp} slot} +\usage{ +setExp(object) <- value +} +\description{ +Setter for the \code{exp} slot +} +\keyword{internal} diff --git a/man/setHier-set-prior-method.Rd b/man/setHier-set-prior-method.Rd new file mode 100644 index 0000000..72d0b3e --- /dev/null +++ b/man/setHier-set-prior-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{setHier<-,prior-method} +\alias{setHier<-,prior-method} +\title{Setter method of \code{prior} class.} +\usage{ +\S4method{setHier}{prior}(object) <- value +} +\arguments{ +\item{object}{An \code{prior} object.} + +\item{value}{An integer defining the new value for the \verb{@hier} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns none. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Set the slot. +setHier(f_prior) <- TRUE +} +\keyword{internal} diff --git a/man/setHier-set.Rd b/man/setHier-set.Rd new file mode 100644 index 0000000..8ecbc70 --- /dev/null +++ b/man/setHier-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setHier<-} +\alias{setHier<-} +\title{Setter for the \code{hier} slot} +\usage{ +setHier(object) <- value +} +\description{ +Setter for the \code{hier} slot +} +\keyword{internal} diff --git a/man/setIndicfix-set-model-method.Rd b/man/setIndicfix-set-model-method.Rd new file mode 100644 index 0000000..1fb2290 --- /dev/null +++ b/man/setIndicfix-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setIndicfix<-,model-method} +\alias{setIndicfix<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setIndicfix}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{A logical specifying, if the model is one with fixed indicators.} +} +\value{ +The \code{model} object with slot \code{indicfix} set to \code{value}. +} +\description{ +Sets a value for the \code{indicfix} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the slot. +setIndicfix(f_model) <- TRUE + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setIndicfix-set.Rd b/man/setIndicfix-set.Rd new file mode 100644 index 0000000..58ca7ab --- /dev/null +++ b/man/setIndicfix-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setIndicfix<-} +\alias{setIndicfix<-} +\title{Setter for the \code{indicfix} slot} +\usage{ +setIndicfix(object) <- value +} +\description{ +Setter for the \code{indicfix} slot +} +\keyword{internal} diff --git a/man/setIndicmod-set-model-method.Rd b/man/setIndicmod-set-model-method.Rd new file mode 100644 index 0000000..477daae --- /dev/null +++ b/man/setIndicmod-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setIndicmod<-,model-method} +\alias{setIndicmod<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setIndicmod}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{An character specifying the indicator model.} +} +\value{ +The \code{model} object with slot \code{indicmod} set to \code{value}. +} +\description{ +Sets a value for the \code{indicmod} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the slot. +setK(f_model) <- 2 + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setIndicmod-set.Rd b/man/setIndicmod-set.Rd new file mode 100644 index 0000000..fb3a26c --- /dev/null +++ b/man/setIndicmod-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setIndicmod<-} +\alias{setIndicmod<-} +\title{Setter for the \code{indicmod} slot} +\usage{ +setIndicmod(object) <- value +} +\description{ +Setter for the \code{indicmod} slot +} +\keyword{internal} diff --git a/man/setK-set-model-method.Rd b/man/setK-set-model-method.Rd new file mode 100644 index 0000000..7030e62 --- /dev/null +++ b/man/setK-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setK<-,model-method} +\alias{setK<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setK}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{An integer specifying the number of components.} +} +\value{ +The \code{model} object with slot \code{K} set to \code{value}. +} +\description{ +Sets a value for the \code{K} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the slot. +setK(f_model) <- 2 + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setK-set.Rd b/man/setK-set.Rd new file mode 100644 index 0000000..28e8acb --- /dev/null +++ b/man/setK-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setK<-} +\alias{setK<-} +\title{Setter for the \code{K} slot} +\usage{ +setK(object) <- value +} +\description{ +Setter for the \code{K} slot +} +\keyword{internal} diff --git a/man/setM-set-mcmc-method.Rd b/man/setM-set-mcmc-method.Rd new file mode 100644 index 0000000..735517d --- /dev/null +++ b/man/setM-set-mcmc-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{setM<-,mcmc-method} +\alias{setM<-,mcmc-method} +\title{Setter method of \code{mcmc} class.} +\usage{ +\S4method{setM}{mcmc}(object) <- value +} +\arguments{ +\item{object}{An \code{mcmc} object.} + +\item{value}{An integer defining the new value for the \verb{@M} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Set the slot +setM(f_mcmc) <- as.integer(20000) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/setM-set.Rd b/man/setM-set.Rd new file mode 100644 index 0000000..129a57e --- /dev/null +++ b/man/setM-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setM<-} +\alias{setM<-} +\title{Setter for the \code{M} slot} +\usage{ +setM(object) <- value +} +\description{ +Setter for the \code{M} slot +} +\keyword{internal} diff --git a/man/setN-set-fdata-method.Rd b/man/setN-set-fdata-method.Rd new file mode 100644 index 0000000..b4af8e9 --- /dev/null +++ b/man/setN-set-fdata-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setN<-,fdata-method} +\alias{setN<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setN}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{N} should be set.} + +\item{value}{An integer that should be set as \code{N} slot of the \code{fdata} object.} +} +\value{ +The \code{fdata} object with slot \code{N} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{N}. +} +\description{ +Sets the slot \code{N} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +f_data <- fdata() +setN(f_data) <- as.integer(100) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setN-set.Rd b/man/setN-set.Rd new file mode 100644 index 0000000..8d9cf1d --- /dev/null +++ b/man/setN-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setN<-} +\alias{setN<-} +\title{Getter for the \code{N} slot} +\usage{ +setN(object) <- value +} +\description{ +Getter for the \code{N} slot +} +\keyword{internal} diff --git a/man/setName-set-fdata-method.Rd b/man/setName-set-fdata-method.Rd new file mode 100644 index 0000000..7fbc9ac --- /dev/null +++ b/man/setName-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setName<-,fdata-method} +\alias{setName<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setName}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{name} should be set.} + +\item{value}{A matrix that should be set as \code{name} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +The \code{fdata} object with slot \code{name} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{name}. +} +\description{ +Sets the slot \code{name} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setName(f_data) <- "poisson_data" + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setName-set.Rd b/man/setName-set.Rd new file mode 100644 index 0000000..79d2f96 --- /dev/null +++ b/man/setName-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setName<-} +\alias{setName<-} +\title{Setter for the \code{name} slot} +\usage{ +setName(object) <- value +} +\description{ +Setter for the \code{name} slot +} +\keyword{internal} diff --git a/man/setPar-set-model-method.Rd b/man/setPar-set-model-method.Rd new file mode 100644 index 0000000..74946eb --- /dev/null +++ b/man/setPar-set-model-method.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setPar<-,model-method} +\alias{setPar<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setPar}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{A list specifying the component parameters.} +} +\value{ +The \code{model} object with slot \code{par} set to \code{value}. +} +\description{ +Sets a value for the \code{par} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the number of components to two. +setK(f_model) <- 2 +# Set the slot. +setPar(f_model) <- list(lambda=c(0.2, 0.7)) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setPar-set-prior-method.Rd b/man/setPar-set-prior-method.Rd new file mode 100644 index 0000000..4eb8ab0 --- /dev/null +++ b/man/setPar-set-prior-method.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{setPar<-,prior-method} +\alias{setPar<-,prior-method} +\title{Setter method of \code{prior} class.} +\usage{ +\S4method{setPar}{prior}(object) <- value +} +\arguments{ +\item{object}{An \code{prior} object.} + +\item{value}{An integer defining the new value for the \verb{@par} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Set the slot. +setPar(f_prior) <- setPar(f_prior) <- list(a = matrix(c(1.2, 0.8), nrow = 1), + b = matrix(c(2.3, 0.4), nrow = 1)) +} +\keyword{internal} diff --git a/man/setPar-set.Rd b/man/setPar-set.Rd new file mode 100644 index 0000000..c98f15c --- /dev/null +++ b/man/setPar-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setPar<-} +\alias{setPar<-} +\title{Setter for the \code{par} slot} +\usage{ +setPar(object) <- value +} +\description{ +Setter for the \code{par} slot +} +\keyword{internal} diff --git a/man/setR-set-fdata-method.Rd b/man/setR-set-fdata-method.Rd new file mode 100644 index 0000000..1f5aab8 --- /dev/null +++ b/man/setR-set-fdata-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setR<-,fdata-method} +\alias{setR<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setR}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{R} should be set.} + +\item{value}{An integer that should be set as \code{R} slot of the \code{fdata} object.} +} +\value{ +The \code{fdata} object with slot \code{R} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{R}. +} +\description{ +Sets the slot \code{R} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +f_data <- fdata() +setR(f_data) <- as.integer(2) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setR-set-model-method.Rd b/man/setR-set-model-method.Rd new file mode 100644 index 0000000..3913854 --- /dev/null +++ b/man/setR-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setR<-,model-method} +\alias{setR<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setR}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{A character defining the distribution.} +} +\value{ +The \code{model} object with slot \code{r} set to \code{value}. +} +\description{ +Sets a value for the \code{r} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the slot. +setR(f_model) <- 1 + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setR-set.Rd b/man/setR-set.Rd new file mode 100644 index 0000000..5bb48a5 --- /dev/null +++ b/man/setR-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setR<-} +\alias{setR<-} +\title{Setter for the \code{r} slot} +\usage{ +setR(object) <- value +} +\description{ +Setter for the \code{r} slot +} +\keyword{internal} diff --git a/man/setRanperm-set-mcmc-method.Rd b/man/setRanperm-set-mcmc-method.Rd new file mode 100644 index 0000000..eaf4da3 --- /dev/null +++ b/man/setRanperm-set-mcmc-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{setRanperm<-,mcmc-method} +\alias{setRanperm<-,mcmc-method} +\title{Setter method of \code{mcmc} class.} +\usage{ +\S4method{setRanperm}{mcmc}(object) <- value +} +\arguments{ +\item{object}{An \code{mcmc} object.} + +\item{value}{An integer defining the new value for the \verb{@ranperm} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Set the slot +setRanperm(f_mcmc) <- FALSE + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/setRanperm-set.Rd b/man/setRanperm-set.Rd new file mode 100644 index 0000000..af2c417 --- /dev/null +++ b/man/setRanperm-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setRanperm<-} +\alias{setRanperm<-} +\title{Setter for the \code{ranperm} slot} +\usage{ +setRanperm(object) <- value +} +\description{ +Setter for the \code{ranperm} slot +} +\keyword{internal} diff --git a/man/setS-set-fdata-method.Rd b/man/setS-set-fdata-method.Rd new file mode 100644 index 0000000..7165e0a --- /dev/null +++ b/man/setS-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setS<-,fdata-method} +\alias{setS<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setS}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} object, whose slot \code{S} should be set.} + +\item{value}{A matrix that should be set as \code{S} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +The \code{fdata} object with slot \code{S} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{S}. +} +\description{ +Sets the slot \code{S} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setS(f_data) <- matrix(sample.int(4, 100, replace = TRUE)) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setS-set.Rd b/man/setS-set.Rd new file mode 100644 index 0000000..2d8885d --- /dev/null +++ b/man/setS-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setS<-} +\alias{setS<-} +\title{Getter for the \code{S} slot} +\usage{ +setS(object) <- value +} +\description{ +Getter for the \code{S} slot +} +\keyword{internal} diff --git a/man/setSim-set-fdata-method.Rd b/man/setSim-set-fdata-method.Rd new file mode 100644 index 0000000..eeecbfc --- /dev/null +++ b/man/setSim-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setSim<-,fdata-method} +\alias{setSim<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setSim}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{sim} should be set.} + +\item{value}{A logical that should be set as \code{sim} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +The \code{fdata} object with slot \code{sim} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{sim}. +} +\description{ +Sets the slot \code{sim} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setSim(f_data) <- TRUE + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setSim-set.Rd b/man/setSim-set.Rd new file mode 100644 index 0000000..3c37a24 --- /dev/null +++ b/man/setSim-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setSim<-} +\alias{setSim<-} +\title{Setter for the \code{sim} slot} +\usage{ +setSim(object) <- value +} +\description{ +Setter for the \code{sim} slot +} +\keyword{internal} diff --git a/man/setStartpar-set-mcmc-method.Rd b/man/setStartpar-set-mcmc-method.Rd new file mode 100644 index 0000000..ea1fec7 --- /dev/null +++ b/man/setStartpar-set-mcmc-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{setStartpar<-,mcmc-method} +\alias{setStartpar<-,mcmc-method} +\title{Setter method of \code{mcmc} class.} +\usage{ +\S4method{setStartpar}{mcmc}(object) <- value +} +\arguments{ +\item{object}{An \code{mcmc} object.} + +\item{value}{An integer defining the new value for the \verb{@startpar} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Set the slot +setStartpar(f_mcmc) <- FALSE + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/setStartpar-set.Rd b/man/setStartpar-set.Rd new file mode 100644 index 0000000..586feea --- /dev/null +++ b/man/setStartpar-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setStartpar<-} +\alias{setStartpar<-} +\title{Setter for the \code{startpar} slot} +\usage{ +setStartpar(object) <- value +} +\description{ +Setter for the \code{startpar} slot +} +\keyword{internal} diff --git a/man/setStoreS-set-mcmc-method.Rd b/man/setStoreS-set-mcmc-method.Rd new file mode 100644 index 0000000..cb457e7 --- /dev/null +++ b/man/setStoreS-set-mcmc-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{setStoreS<-,mcmc-method} +\alias{setStoreS<-,mcmc-method} +\title{Setter method of \code{mcmc} class.} +\usage{ +\S4method{setStoreS}{mcmc}(object) <- value +} +\arguments{ +\item{object}{An \code{mcmc} object.} + +\item{value}{An integer defining the new value for the \verb{@storeS} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Set the slot +setStoreS(f_mcmc) <- as.integer(500) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/setStoreS-set.Rd b/man/setStoreS-set.Rd new file mode 100644 index 0000000..7726d3d --- /dev/null +++ b/man/setStoreS-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setStoreS<-} +\alias{setStoreS<-} +\title{Setter for the \code{storeS} slot} +\usage{ +setStoreS(object) <- value +} +\description{ +Setter for the \code{storeS} slot +} +\keyword{internal} diff --git a/man/setStorepost-set-mcmc-method.Rd b/man/setStorepost-set-mcmc-method.Rd new file mode 100644 index 0000000..3b2cd3d --- /dev/null +++ b/man/setStorepost-set-mcmc-method.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{setStorepost<-,mcmc-method} +\alias{setStorepost<-,mcmc-method} +\title{Setter method of \code{mcmc} class.} +\usage{ +\S4method{setStorepost}{mcmc}(object) <- value +} +\arguments{ +\item{object}{An \code{mcmc} object.} + +\item{value}{An integer defining the new value for the \verb{@storepost} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate an mcmc object +f_mcmc <- mcmc() +# Set the slot +setStorepost(f_mcmc) <- FALSE + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the \code{mcmc} class +} +} +\keyword{internal} diff --git a/man/setStorepost-set.Rd b/man/setStorepost-set.Rd new file mode 100644 index 0000000..49a9d66 --- /dev/null +++ b/man/setStorepost-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setStorepost<-} +\alias{setStorepost<-} +\title{Setter for the \code{storepost} slot} +\usage{ +setStorepost(object) <- value +} +\description{ +Setter for the \code{storepost} slot +} +\keyword{internal} diff --git a/man/setT-set-fdata-method.Rd b/man/setT-set-fdata-method.Rd new file mode 100644 index 0000000..9116b26 --- /dev/null +++ b/man/setT-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setT<-,fdata-method} +\alias{setT<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setT}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{T} should be set.} + +\item{value}{A matrix that should be set as \code{T} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +The \code{fdata} object with slot \code{T} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{T}. +} +\description{ +Sets the slot \code{T} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setT(f_data) <- matrix(rep(100, 100)) + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setT-set-model-method.Rd b/man/setT-set-model-method.Rd new file mode 100644 index 0000000..544ce64 --- /dev/null +++ b/man/setT-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setT<-,model-method} +\alias{setT<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setT}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{An integer specifying the number of components.} +} +\value{ +The \code{model} object with slot \code{T} set to \code{value}. +} +\description{ +Sets a value for the \code{T} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the slot. +setT(f_model) <- as.integer(4) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setT-set.Rd b/man/setT-set.Rd new file mode 100644 index 0000000..c5d8b6d --- /dev/null +++ b/man/setT-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setT<-} +\alias{setT<-} +\title{Setter for the \code{T} slot} +\usage{ +setT(object) <- value +} +\description{ +Setter for the \code{T} slot +} +\keyword{internal} diff --git a/man/setType-set-fdata-method.Rd b/man/setType-set-fdata-method.Rd new file mode 100644 index 0000000..646a6a2 --- /dev/null +++ b/man/setType-set-fdata-method.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setType<-,fdata-method} +\alias{setType<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setType}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{type} should be set.} + +\item{value}{A character that should be set as \code{type} slot of the \code{fdata} object. +Has to be of type integer.} +} +\value{ +The \code{fdata} object with slot \code{type} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{type}. +} +\description{ +Sets the slot \code{type} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +# Generate an empty fdata object. +f_data <- fdata() +setType(f_data) <- "discrete" + +} +\seealso{ +\link{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setType-set-prior-method.Rd b/man/setType-set-prior-method.Rd new file mode 100644 index 0000000..300b215 --- /dev/null +++ b/man/setType-set-prior-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{setType<-,prior-method} +\alias{setType<-,prior-method} +\title{Setter method of \code{prior} class.} +\usage{ +\S4method{setType}{prior}(object) <- value +} +\arguments{ +\item{object}{An \code{prior} object.} + +\item{value}{An integer defining the new value for the \verb{@type} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns none. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Set the slot. +setType(f_prior) <- "condconjugate" +} +\keyword{internal} diff --git a/man/setType-set.Rd b/man/setType-set.Rd new file mode 100644 index 0000000..cc71720 --- /dev/null +++ b/man/setType-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setType<-} +\alias{setType<-} +\title{Setter for the \code{type} format} +\usage{ +setType(object) <- value +} +\description{ +Setter for the \code{type} format +} +\keyword{internal} diff --git a/man/setWeight-set-model-method.Rd b/man/setWeight-set-model-method.Rd new file mode 100644 index 0000000..c33d80b --- /dev/null +++ b/man/setWeight-set-model-method.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{setWeight<-,model-method} +\alias{setWeight<-,model-method} +\title{Setter method of \code{model} class.} +\usage{ +\S4method{setWeight}{model}(object) <- value +} +\arguments{ +\item{object}{An \code{model} object.} + +\item{value}{An matrix specifying the weights.} +} +\value{ +The \code{model} object with slot \code{weight} set to \code{value}. +} +\description{ +Sets a value for the \code{weight} slot. +} +\examples{ +# Generate an default mixture model. +f_model <- model() +# Set the slot. +setWeight(f_model) <- matrix(c(0.4, 0.6), nrow = 1) + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +} +} +\keyword{internal} diff --git a/man/setWeight-set-prior-method.Rd b/man/setWeight-set-prior-method.Rd new file mode 100644 index 0000000..f577212 --- /dev/null +++ b/man/setWeight-set-prior-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{setWeight<-,prior-method} +\alias{setWeight<-,prior-method} +\title{Setter method of \code{prior} class.} +\usage{ +\S4method{setWeight}{prior}(object) <- value +} +\arguments{ +\item{object}{An \code{prior} object.} + +\item{value}{An integer defining the new value for the \verb{@weight} slot.} +} +\value{ +None. +} +\description{ +Sets the slot. Returns the none. +} +\examples{ +# Generate a prior object. +f_prior <- prior() +# Set the slot. +setWeight(f_prior) <- matrix(c(0.5, 0.5), nrow = 1) +} +\keyword{internal} diff --git a/man/setWeight-set.Rd b/man/setWeight-set.Rd new file mode 100644 index 0000000..b36772a --- /dev/null +++ b/man/setWeight-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setWeight<-} +\alias{setWeight<-} +\title{Setter for the \code{weight} slot} +\usage{ +setWeight(object) <- value +} +\description{ +Setter for the \code{weight} slot +} +\keyword{internal} diff --git a/man/setY-set-fdata-method.Rd b/man/setY-set-fdata-method.Rd new file mode 100644 index 0000000..b17a31a --- /dev/null +++ b/man/setY-set-fdata-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{setY<-,fdata-method} +\alias{setY<-,fdata-method} +\title{Setter method of \code{fdata} class} +\usage{ +\S4method{setY}{fdata}(object) <- value +} +\arguments{ +\item{object}{An \code{fdata} objects, whose slot \code{y} should be set.} + +\item{value}{A matrix that should be set as \code{y} slot of the \code{fdata} object.} +} +\value{ +The \code{fdata} object with slot \code{y} set to \code{value} or an error message +if the \code{value} cannot be set as slot \code{y}. +} +\description{ +Sets the slot \code{y} of an \code{fdata} object and validates the slot data before +setting. +} +\examples{ +f_data <- fdata() +setY(f_data) <- rpois(100, 312) + +} +\seealso{ +\linkS4class{fdata} for all slots of the \code{fdata} class +} diff --git a/man/setY-set.Rd b/man/setY-set.Rd new file mode 100644 index 0000000..f395e4d --- /dev/null +++ b/man/setY-set.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{setY<-} +\alias{setY<-} +\title{Setter for the \code{y} slot} +\usage{ +setY(object) <- value +} +\description{ +Setter for the \code{y} slot +} +\keyword{internal} diff --git a/man/show-binomialmodelmoments-method.Rd b/man/show-binomialmodelmoments-method.Rd new file mode 100644 index 0000000..29875d2 --- /dev/null +++ b/man/show-binomialmodelmoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/binomialmodelmoments.R +\name{show,binomialmodelmoments-method} +\alias{show,binomialmodelmoments-method} +\title{Shows a summary of an \code{binomialmodelmoments} object.} +\usage{ +\S4method{show}{binomialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{binomialmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{binomialmodelmoments} object gives an overview +of the moments of an binomial finite mixture. +} +\seealso{ +\itemize{ +\item \code{\link[=modelmoments]{modelmoments()}} for the mutual constructor for all modelmoments +\item \linkS4class{binomialmodelmoments} for the class definition +} +} +\keyword{internal} diff --git a/man/show-cdatamoments-method.Rd b/man/show-cdatamoments-method.Rd new file mode 100644 index 0000000..4949123 --- /dev/null +++ b/man/show-cdatamoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cdatamoments.R +\name{show,cdatamoments-method} +\alias{show,cdatamoments-method} +\title{Shows a summary of a \code{cdatamoments} object.} +\usage{ +\S4method{show}{cdatamoments}(object) +} +\arguments{ +\item{object}{A \code{cdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{cdatamoments} object gives an overview +of the moments of a finit mixture with continuous data. +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the parent class +\item \code{\link[=datamoments]{datamoments()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/show-csdatamoments-method.Rd b/man/show-csdatamoments-method.Rd new file mode 100644 index 0000000..45957af --- /dev/null +++ b/man/show-csdatamoments-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/csdatamoments.R +\name{show,csdatamoments-method} +\alias{show,csdatamoments-method} +\title{Shows a summary of an \code{csdatamoments} object.} +\usage{ +\S4method{show}{csdatamoments}(object) +} +\arguments{ +\item{object}{An \code{csdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{csdatamoments} object gives an overview +of the moments of a finite mixture with continuous data. +} +\keyword{internal} diff --git a/man/show-dataclass-method.Rd b/man/show-dataclass-method.Rd new file mode 100644 index 0000000..05bb1bd --- /dev/null +++ b/man/show-dataclass-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataclass.R +\name{show,dataclass-method} +\alias{show,dataclass-method} +\title{Shows a summary of a \code{dataclass} object.} +\usage{ +\S4method{show}{dataclass}(object) +} +\arguments{ +\item{object}{A \code{dataclass} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{dataclass} object gives an overview +of the slots of this class. +} +\seealso{ +\itemize{ +\item \linkS4class{dataclass} for the class definition +\item \code{\link[=dataclass]{dataclass()}} for the class constructor +} +} +\keyword{internal} diff --git a/man/show-ddatamoments-method.Rd b/man/show-ddatamoments-method.Rd new file mode 100644 index 0000000..6880478 --- /dev/null +++ b/man/show-ddatamoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddatamoments.R +\name{show,ddatamoments-method} +\alias{show,ddatamoments-method} +\title{Shows a summary of a \code{ddatamoments} object.} +\usage{ +\S4method{show}{ddatamoments}(object) +} +\arguments{ +\item{object}{A \code{ddatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{ddatamoments} object gives an overview +of the moments of a finit mixture with continuous data. +} +\seealso{ +\itemize{ +\item \linkS4class{datamoments} for the parent class definition +\item \code{\link[=datamoments]{datamoments()}} for the mutual constructor of all datamoments classes +} +} +\keyword{internal} diff --git a/man/show-exponentialmodelmoments-method.Rd b/man/show-exponentialmodelmoments-method.Rd new file mode 100644 index 0000000..cda5aa4 --- /dev/null +++ b/man/show-exponentialmodelmoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exponentialmodelmoments.R +\name{show,exponentialmodelmoments-method} +\alias{show,exponentialmodelmoments-method} +\title{Shows a summary of an \code{exponentialmodelmoments} object.} +\usage{ +\S4method{show}{exponentialmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{exponentialmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{exponentialmodelmoments} object gives an overview +of the moments of an exponential finite mixture. +} +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} +\keyword{internal} diff --git a/man/show-fdata-method.Rd b/man/show-fdata-method.Rd new file mode 100644 index 0000000..06d9c22 --- /dev/null +++ b/man/show-fdata-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fdata.R +\name{show,fdata-method} +\alias{show,fdata-method} +\title{Shows a summary of an \code{fdata} object.} +\usage{ +\S4method{show}{fdata}(object) +} +\arguments{ +\item{object}{An \code{fdata} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{fdata} object gives an overview of the different +slots and dimensions. +} +\examples{ +# Generate some Poisson data and show the `fdata` object +f_data <- fdata(y = rpois(100, 312), sim = TRUE) +show(f_data) + +} +\seealso{ +\link{fdata} class for an overview of the slots +} +\keyword{internal} diff --git a/man/show-groupmoments-method.Rd b/man/show-groupmoments-method.Rd new file mode 100644 index 0000000..c093b6d --- /dev/null +++ b/man/show-groupmoments-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groupmoments.R +\name{show,groupmoments-method} +\alias{show,groupmoments-method} +\title{Shows a summary of a \code{groupmoments} object.} +\usage{ +\S4method{show}{groupmoments}(object) +} +\arguments{ +\item{object}{A \code{groupmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{groupmoments} object gives an overview +of the moments of a finit mixture with continuous data. +} +\keyword{internal} diff --git a/man/show-mcmc-method.Rd b/man/show-mcmc-method.Rd new file mode 100644 index 0000000..bfd3d41 --- /dev/null +++ b/man/show-mcmc-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmc.R +\name{show,mcmc-method} +\alias{show,mcmc-method} +\title{Shows a summary of an \code{mcmc} object.} +\usage{ +\S4method{show}{mcmc}(object) +} +\arguments{ +\item{object}{A \code{mcmc} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmc} object gives an overview +of the \code{mcmc} object. +} +\seealso{ +\itemize{ +\item \linkS4class{mcmc} for the class definition +\item \code{\link[=mcmc]{mcmc()}} for the constructor of the class +} +} +\keyword{internal} diff --git a/man/show-mcmcestfix-method.Rd b/man/show-mcmcestfix-method.Rd new file mode 100644 index 0000000..2895ab8 --- /dev/null +++ b/man/show-mcmcestfix-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestfix.R +\name{show,mcmcestfix-method} +\alias{show,mcmcestfix-method} +\title{Shows a summary of an \code{mcmcestfix} object.} +\usage{ +\S4method{show}{mcmcestfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcestfix} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcestfix} object gives an overview +of the \code{mcmcestfix} object. +} +\keyword{internal} diff --git a/man/show-mcmcestind-method.Rd b/man/show-mcmcestind-method.Rd new file mode 100644 index 0000000..8f9015c --- /dev/null +++ b/man/show-mcmcestind-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcestind.R +\name{show,mcmcestind-method} +\alias{show,mcmcestind-method} +\title{Shows a summary of an \code{mcmcestind} object.} +\usage{ +\S4method{show}{mcmcestind}(object) +} +\arguments{ +\item{object}{An \code{mcmcestind} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcestind} object gives an overview +of the \code{mcmcestind} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputbase-method.Rd b/man/show-mcmcoutputbase-method.Rd new file mode 100644 index 0000000..b453277 --- /dev/null +++ b/man/show-mcmcoutputbase-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{show,mcmcoutputbase-method} +\alias{show,mcmcoutputbase-method} +\title{Shows a summary of an \code{mcmcoutputbase} object.} +\usage{ +\S4method{show}{mcmcoutputbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputbase} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputbase} object gives an overview +of the \code{mcmcoutputbase} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputfix-method.Rd b/man/show-mcmcoutputfix-method.Rd new file mode 100644 index 0000000..143612c --- /dev/null +++ b/man/show-mcmcoutputfix-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{show,mcmcoutputfix-method} +\alias{show,mcmcoutputfix-method} +\title{Shows a summary of an \code{mcmcoutputfix} object.} +\usage{ +\S4method{show}{mcmcoutputfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfix} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfix} object gives an overview +of the \code{mcmcoutputfix} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputfixhier-method.Rd b/man/show-mcmcoutputfixhier-method.Rd new file mode 100644 index 0000000..c553ea6 --- /dev/null +++ b/man/show-mcmcoutputfixhier-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{show,mcmcoutputfixhier-method} +\alias{show,mcmcoutputfixhier-method} +\title{Shows a summary of an \code{mcmcoutputfixhier} object.} +\usage{ +\S4method{show}{mcmcoutputfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixhier} object gives an overview +of the \code{mcmcoutputfixhier} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputfixhierpost-method.Rd b/man/show-mcmcoutputfixhierpost-method.Rd new file mode 100644 index 0000000..ceb8ee9 --- /dev/null +++ b/man/show-mcmcoutputfixhierpost-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{show,mcmcoutputfixhierpost-method} +\alias{show,mcmcoutputfixhierpost-method} +\title{Shows a summary of an \code{mcmcoutputfixhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputfixhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixhierpost} object gives an overview +of the \code{mcmcoutputfixhierpost} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputfixpost-method.Rd b/man/show-mcmcoutputfixpost-method.Rd new file mode 100644 index 0000000..635955a --- /dev/null +++ b/man/show-mcmcoutputfixpost-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{show,mcmcoutputfixpost-method} +\alias{show,mcmcoutputfixpost-method} +\title{Shows a summary of an \code{mcmcoutputfixpost} object.} +\usage{ +\S4method{show}{mcmcoutputfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputfixpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputfixpost} object gives an overview +of the \code{mcmcoutputfixpost} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputhier-method.Rd b/man/show-mcmcoutputhier-method.Rd new file mode 100644 index 0000000..503a582 --- /dev/null +++ b/man/show-mcmcoutputhier-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{show,mcmcoutputhier-method} +\alias{show,mcmcoutputhier-method} +\title{Shows a summary of an \code{mcmcoutputhier} object.} +\usage{ +\S4method{show}{mcmcoutputhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputhier} object gives an overview +of the \code{mcmcoutputhier} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputhierpost-method.Rd b/man/show-mcmcoutputhierpost-method.Rd new file mode 100644 index 0000000..cd85e89 --- /dev/null +++ b/man/show-mcmcoutputhierpost-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{show,mcmcoutputhierpost-method} +\alias{show,mcmcoutputhierpost-method} +\title{Shows a summary of an \code{mcmcoutputhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputhierpost} object gives an overview +of the \code{mcmcoutputhierpost} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputpermbase-method.Rd b/man/show-mcmcoutputpermbase-method.Rd new file mode 100644 index 0000000..39a7beb --- /dev/null +++ b/man/show-mcmcoutputpermbase-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermbase.R +\name{show,mcmcoutputpermbase-method} +\alias{show,mcmcoutputpermbase-method} +\title{Shows a summary of an \code{mcmcoutputpermbase} object.} +\usage{ +\S4method{show}{mcmcoutputpermbase}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermbase} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermbase} object gives an overview +of the \code{mcmcoutputpermbase} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputpermfix-method.Rd b/man/show-mcmcoutputpermfix-method.Rd new file mode 100644 index 0000000..faac29c --- /dev/null +++ b/man/show-mcmcoutputpermfix-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfix.R +\name{show,mcmcoutputpermfix-method} +\alias{show,mcmcoutputpermfix-method} +\title{Shows a summary of an \code{mcmcoutputpermfix} object.} +\usage{ +\S4method{show}{mcmcoutputpermfix}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfix} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfix} object gives an overview +of the \code{mcmcoutputpermfix} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputpermfixhier-method.Rd b/man/show-mcmcoutputpermfixhier-method.Rd new file mode 100644 index 0000000..b90e9f8 --- /dev/null +++ b/man/show-mcmcoutputpermfixhier-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhier.R +\name{show,mcmcoutputpermfixhier-method} +\alias{show,mcmcoutputpermfixhier-method} +\title{Shows a summary of an \code{mcmcoutputpermfixhier} object.} +\usage{ +\S4method{show}{mcmcoutputpermfixhier}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixhier} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhier} object gives an overview +of the \code{mcmcoutputpermfixhier} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputpermfixhierpost-method.Rd b/man/show-mcmcoutputpermfixhierpost-method.Rd new file mode 100644 index 0000000..bf30088 --- /dev/null +++ b/man/show-mcmcoutputpermfixhierpost-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixhierpost.R +\name{show,mcmcoutputpermfixhierpost-method} +\alias{show,mcmcoutputpermfixhierpost-method} +\title{Shows a summary of an \code{mcmcoutputpermfixhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermfixhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixhierpost} object gives an overview +of the \code{mcmcoutputpermfixhierpost} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputpermfixpost-method.Rd b/man/show-mcmcoutputpermfixpost-method.Rd new file mode 100644 index 0000000..f459e31 --- /dev/null +++ b/man/show-mcmcoutputpermfixpost-method.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermfixpost.R +\name{show,mcmcoutputpermfixpost-method} +\alias{show,mcmcoutputpermfixpost-method} +\title{Shows a summary of an \code{mcmcoutputpermfixpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermfixpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermfixpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermfixpost} object gives an overview +of the \code{mcmcoutputpermfixpost} object. +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutputpermfixpost} for the class definition +} +} +\keyword{internal} diff --git a/man/show-mcmcoutputpermhierpost-method.Rd b/man/show-mcmcoutputpermhierpost-method.Rd new file mode 100644 index 0000000..adc779b --- /dev/null +++ b/man/show-mcmcoutputpermhierpost-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{show,mcmcoutputpermhierpost-method} +\alias{show,mcmcoutputpermhierpost-method} +\title{Shows a summary of an \code{mcmcoutputpermhierpost} object.} +\usage{ +\S4method{show}{mcmcoutputpermhierpost}(object) +} +\arguments{ +\item{object}{An \code{mcmcoutputpermhierpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{mcmcoutputpermhierpost} object gives an overview +of the \code{mcmcoutputpermhierpost} object. +} +\keyword{internal} diff --git a/man/show-mcmcoutputpost-method.Rd b/man/show-mcmcoutputpost-method.Rd new file mode 100644 index 0000000..7739e2b --- /dev/null +++ b/man/show-mcmcoutputpost-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{show,mcmcoutputpost-method} +\alias{show,mcmcoutputpost-method} +\title{Shows a summary of an \code{ mcmcoutputpost} object.} +\usage{ +\S4method{show}{mcmcoutputpost}(object) +} +\arguments{ +\item{object}{An \code{ mcmcoutputpost} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{ mcmcoutputpost} object gives an overview +of the \code{ mcmcoutputpost} object. +} +\keyword{internal} diff --git a/man/show-normalmodelmoments-method.Rd b/man/show-normalmodelmoments-method.Rd new file mode 100644 index 0000000..d381822 --- /dev/null +++ b/man/show-normalmodelmoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalmodelmoments.R +\name{show,normalmodelmoments-method} +\alias{show,normalmodelmoments-method} +\title{Shows a summary of an \code{normalmodelmoments} object.} +\usage{ +\S4method{show}{normalmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normalmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{normalmodelmoments} object gives an overview +of the moments of an normal finite mixture. +} +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} +\keyword{internal} diff --git a/man/show-normultmodelmoments-method.Rd b/man/show-normultmodelmoments-method.Rd new file mode 100644 index 0000000..7a5642e --- /dev/null +++ b/man/show-normultmodelmoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normultmodelmoments.R +\name{show,normultmodelmoments-method} +\alias{show,normultmodelmoments-method} +\title{Shows a summary of an \code{normultmodelmoments} object.} +\usage{ +\S4method{show}{normultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{normultmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{normultmodelmoments} object gives an overview +of the moments of an normult finite mixture. +} +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} +\keyword{internal} diff --git a/man/show-poissonmodelmoments-method.Rd b/man/show-poissonmodelmoments-method.Rd new file mode 100644 index 0000000..8374543 --- /dev/null +++ b/man/show-poissonmodelmoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poissonmodelmoments.R +\name{show,poissonmodelmoments-method} +\alias{show,poissonmodelmoments-method} +\title{Shows a summary of an \code{poissonmodelmoments} object.} +\usage{ +\S4method{show}{poissonmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{poissonmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{poissonmodelmoments} object gives an overview +of the moments of an poisson finite mixture. +} +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} +\keyword{internal} diff --git a/man/show-prior-method.Rd b/man/show-prior-method.Rd new file mode 100644 index 0000000..eb6c4e3 --- /dev/null +++ b/man/show-prior-method.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior.R +\name{show,prior-method} +\alias{show,prior-method} +\title{Shows a summary of a \code{prior} object.} +\usage{ +\S4method{show}{prior}(object) +} +\arguments{ +\item{object}{A \code{prior} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on a \code{prior} object gives an overview +of the slots of a \code{prior} object. +} +\seealso{ +\itemize{ +\item \linkS4class{prior} for the class definition +\item \code{\link[=prior]{prior()}} for the basic constructor of the class +\item \code{\link[=priordefine]{priordefine()}} for the advanced constructor of the class +} +} +\keyword{internal} diff --git a/man/show-sdatamoments-method.Rd b/man/show-sdatamoments-method.Rd new file mode 100644 index 0000000..57db6f6 --- /dev/null +++ b/man/show-sdatamoments-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdatamoments.R +\name{show,sdatamoments-method} +\alias{show,sdatamoments-method} +\title{Shows a summary of an \code{sdatamoments} object.} +\usage{ +\S4method{show}{sdatamoments}(object) +} +\arguments{ +\item{object}{An \code{sdatamoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{sdatamoments} object gives an overview +of the moments of a finite mixture with discrete data. +} +\keyword{internal} diff --git a/man/show-studentmodelmoments-method.Rd b/man/show-studentmodelmoments-method.Rd new file mode 100644 index 0000000..738bade --- /dev/null +++ b/man/show-studentmodelmoments-method.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\name{show,studentmodelmoments-method} +\alias{show,studentmodelmoments-method} +\title{Shows a summary of an \code{studentmodelmoments} object.} +\usage{ +\S4method{show}{studentmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studentmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{studentmodelmoments} object gives an overview +of the moments of an student finite mixture. +} +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} +\keyword{internal} diff --git a/man/show-studmultmodelmoments-method.Rd b/man/show-studmultmodelmoments-method.Rd new file mode 100644 index 0000000..00d8ec1 --- /dev/null +++ b/man/show-studmultmodelmoments-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\name{show,studmultmodelmoments-method} +\alias{show,studmultmodelmoments-method} +\title{Shows a summary of an \code{studmultmodelmoments} object.} +\usage{ +\S4method{show}{studmultmodelmoments}(object) +} +\arguments{ +\item{object}{An \code{studmultmodelmoments} object.} +} +\value{ +A console output listing the slots and summary information about +each of them. +} +\description{ +Calling \code{\link[=show]{show()}} on an \code{studmultmodelmoments} object gives an overview +of the moments of an studmult finite mixture. +} +\keyword{internal} diff --git a/man/simulate-model-method.Rd b/man/simulate-model-method.Rd new file mode 100644 index 0000000..163cb8e --- /dev/null +++ b/man/simulate-model-method.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{simulate,model-method} +\alias{simulate,model-method} +\title{Simulates data from a model.} +\usage{ +\S4method{simulate}{model}(model, N = 100, varargin, seed = 0) +} +\arguments{ +\item{model}{An S4 model object with specified parameters and weights.} + +\item{N}{An integer specifying the number of values to be simulated.} + +\item{varargin}{An S4 fdata object with specified variable dimensions, \code{r} +and repetitions \code{T}.} + +\item{seed}{An integer specifying the seed for the RNG.} +} +\value{ +An S4 fdata object holding the simulated values. +} +\description{ +\code{simulate()} simulates values for a specified mixture model in an +S4 \code{model} object. +} +\examples{ +\dontrun{ +f_data <- simulate(model, 100) +} + +} +\seealso{ +\itemize{ +\item \linkS4class{model} for the class definition +\item \linkS4class{fdata} for the class defining \code{finmix} data objects +} +} +\keyword{internal} diff --git a/man/simulate.Rd b/man/simulate.Rd new file mode 100644 index 0000000..6638883 --- /dev/null +++ b/man/simulate.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{simulate} +\alias{simulate} +\title{Simulates data from a finite mixture model} +\usage{ +simulate(model, N = 100, varargin, seed = 0) +} +\description{ +Simulates data from a finite mixture model +} +\keyword{internal} diff --git a/man/stephens1997b_binomial_cc.Rd b/man/stephens1997b_binomial_cc.Rd index f55581a..a1495e8 100644 --- a/man/stephens1997b_binomial_cc.Rd +++ b/man/stephens1997b_binomial_cc.Rd @@ -9,14 +9,13 @@ stephens1997b_binomial_cc(values, reps, comp_par, weight_par) \arguments{ \item{values}{A matrix of observations of dimension \code{Nx1}.} +\item{reps}{A vector containing the repetitions.} + \item{comp_par}{An array of component parameter samples from MCMC sampling. Dimension is \code{MxK}.} -\item{weight}{An array of weight parameter samples from MCMC sampling. +\item{weight_par}{An array of weight parameter samples from MCMC sampling. Dimension is \code{MxK}.} - -\item{max_iter}{A signed integer specifying the number of iterations to be -run in optimization. Unused.} } \value{ An integer matrix of dimension \code{MxK} that holding the optimal diff --git a/man/studentmodelmoments-class.Rd b/man/studentmodelmoments-class.Rd new file mode 100644 index 0000000..b76a63c --- /dev/null +++ b/man/studentmodelmoments-class.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studentmodelmoments.R +\docType{class} +\name{studentmodelmoments-class} +\alias{studentmodelmoments-class} +\alias{.studentmodelmoments} +\title{Finmix \code{studentmodelmoments} class} +\description{ +Defines a class that holds theoretical moments for a finite mixture of +student distributions. Note that this class is not directly used, but +indirectly when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{R}}{A numeric defining the coefficient of determination.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/studmultmodelmoments-class.Rd b/man/studmultmodelmoments-class.Rd new file mode 100644 index 0000000..1e540e7 --- /dev/null +++ b/man/studmultmodelmoments-class.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/studmultmodelmoments.R +\docType{class} +\name{studmultmodelmoments-class} +\alias{studmultmodelmoments-class} +\alias{.studmultmodelmoments} +\title{Finmix \code{studmultmodelmoments} class} +\description{ +Defines a class that holds modelmoments for a finite mixture of studmult +distributions. Note that this class is not directly used, but indirectly +when calling the \code{modelmoments} constructor \code{\link[=modelmoments]{modelmoments()}}. +} +\section{Slots}{ + +\describe{ +\item{\code{B}}{A numeric defining the between-group heterogeneity.} + +\item{\code{W}}{A numeric defining the within-group heterogeneity.} + +\item{\code{Rdet}}{A numeric defining the coefficient of determination based on the +determinant of the covariance matrix.} + +\item{\code{Rtr}}{A numeric defining the coefficient of determination based on the +trace of the covariance matrix.} + +\item{\code{corr}}{A \code{matrix} storing the correlation matrix.} +}} + +\seealso{ +\itemize{ +\item \linkS4class{modelmoments} for the base class for model moments +\item \code{\link[=modelmoments]{modelmoments()}} for the constructor of \code{modelmoments} classes +} +} diff --git a/man/subseq-generic.Rd b/man/subseq-generic.Rd new file mode 100644 index 0000000..d1b7e7a --- /dev/null +++ b/man/subseq-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{subseq} +\alias{subseq} +\title{Generates a sub-chain from MCMC samples} +\usage{ +subseq(object, index) +} +\description{ +Generates a sub-chain from MCMC samples +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputbase-array-method.Rd b/man/subseq-mcmcoutputbase-array-method.Rd new file mode 100644 index 0000000..6c22065 --- /dev/null +++ b/man/subseq-mcmcoutputbase-array-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{subseq,mcmcoutputbase,array-method} +\alias{subseq,mcmcoutputbase,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputbase,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputfix-array-method.Rd b/man/subseq-mcmcoutputfix-array-method.Rd new file mode 100644 index 0000000..ea3cfbe --- /dev/null +++ b/man/subseq-mcmcoutputfix-array-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{subseq,mcmcoutputfix,array-method} +\alias{subseq,mcmcoutputfix,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputfix,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputfixhier-array-method.Rd b/man/subseq-mcmcoutputfixhier-array-method.Rd new file mode 100644 index 0000000..d77d394 --- /dev/null +++ b/man/subseq-mcmcoutputfixhier-array-method.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{subseq,mcmcoutputfixhier,array-method} +\alias{subseq,mcmcoutputfixhier,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputfixhier,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputfixhierpost-array-method.Rd b/man/subseq-mcmcoutputfixhierpost-array-method.Rd new file mode 100644 index 0000000..bd943c2 --- /dev/null +++ b/man/subseq-mcmcoutputfixhierpost-array-method.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{subseq,mcmcoutputfixhierpost,array-method} +\alias{subseq,mcmcoutputfixhierpost,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputfixhierpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. + +Note that this method calls the equivalent method from the parent class and +adds the sub-chains for the posterior density parameters. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputfixpost-array-method.Rd b/man/subseq-mcmcoutputfixpost-array-method.Rd new file mode 100644 index 0000000..b698695 --- /dev/null +++ b/man/subseq-mcmcoutputfixpost-array-method.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{subseq,mcmcoutputfixpost,array-method} +\alias{subseq,mcmcoutputfixpost,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputfixpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. + +Note that this method calls the equivalent method from the parent class and +adds the sub-chains for the posterior density parameters. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputhier-array-method.Rd b/man/subseq-mcmcoutputhier-array-method.Rd new file mode 100644 index 0000000..f6c8655 --- /dev/null +++ b/man/subseq-mcmcoutputhier-array-method.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{subseq,mcmcoutputhier,array-method} +\alias{subseq,mcmcoutputhier,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputhier,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutput} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. + +Note, this method calls the equivalent method of the parent class and then +adds to it the sub-chains for the parameters of the hierarchical prior. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputhierpost-array-method.Rd b/man/subseq-mcmcoutputhierpost-array-method.Rd new file mode 100644 index 0000000..7f568db --- /dev/null +++ b/man/subseq-mcmcoutputhierpost-array-method.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{subseq,mcmcoutputhierpost,array-method} +\alias{subseq,mcmcoutputhierpost,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputhierpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutputhierpost} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutputhierpost} object containing the values from the +sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples in the +passed-in \code{mcmcoutput} object specfied by the index \code{array} in \code{index}. This +can be advantageous, if chains are non-stationary. For successful MCMC +sampling the chain must be converged to the target distribution, the true +distribution of parameters, weights and indicators. + +Note, this method calls the equivalent method of the parent class and then +adds to it the sub-chains for the parameters of the posterior density by +calling a function from the \code{mcmcoutputfixpost} class. +} +\keyword{internal} diff --git a/man/subseq-mcmcoutputpost-array-method.Rd b/man/subseq-mcmcoutputpost-array-method.Rd new file mode 100644 index 0000000..d1dbf65 --- /dev/null +++ b/man/subseq-mcmcoutputpost-array-method.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{subseq,mcmcoutputpost,array-method} +\alias{subseq,mcmcoutputpost,array-method} +\title{Constructs a sub-chain of MCMC samples} +\usage{ +\S4method{subseq}{mcmcoutputpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutputpost} object containing all sampled values.} + +\item{index}{An array specifying the extraction of the sub-chain.} +} +\value{ +An \code{mcmcoutputpost} object containing the values from the sub-chain. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} constructs an MCMC sub-chain from the samples +in the passed-in \code{mcmcoutputpost} object specfied by the index \code{array} in +\code{index}. This can be advantageous, if chains are non-stationary. For +successful MCMC sampling the chain must be converged to the target +distribution, the true distribution of parameters, weights and indicators. + +Note, this method calls the equivalent method of the parent class and then +adds to it the sub-chains for the parameters of the hierarchical prior. +} +\keyword{internal} diff --git a/man/subseq-method.Rd b/man/subseq-method.Rd new file mode 100644 index 0000000..cbc248b --- /dev/null +++ b/man/subseq-method.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{subseq} +\alias{subseq} +\title{Extract sub-chains from MCMC samples} +\arguments{ +\item{object}{An \code{mcmcoutput} or \code{mcmcoutputperm} object containing samples +from MCMC samples.} + +\item{index}{A logical \code{array} of dimension \code{Mx1} defining the schema for +the sub-chain.} +} +\value{ +An \code{mcmcoutput} or \code{mcmcoutputperm} object containing the +sub-chained MCMC samples. +} +\description{ +Calling \code{\link[=subseq]{subseq()}} on an \code{mcmcoutput} or \code{mcmcoutputperm} object creates a +sub-chain defined by the argument \code{index}. Sub-chains can be used to further +investigate convergence of MCMC sampling. +} +\details{ +Running MCMC sampling should by time result in a roughly stationary sequence +of random draws. If trace plots do not show this stationary pattern MCMC +sampling should be run with a longer burn-in period until the sampling +distribution has converged. Another possibility is to remove the first draws. +Removing the first draws can be achieved by calling \code{subseq()} on the object +holding the MCMC samples. +In case of autocorrelations in the traces it is also possible to extract +every \code{t}-th value by setting the \code{index} argument accordingly. +} +\examples{ +# Define a mixture of Poisson distributions. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +# Define a sub-chain randomly. +index <- array(sample(c(FALSE, TRUE), size = getM(f_output), replace = TRUE)) +# Extract the sub-chain. +subseq(f_output, index) + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class storing MCMC samples +\item \linkS4class{mcmcoutputperm} for the corresponding class for re-labeled MCMC +samples +\item \code{\link[=plotTraces]{plotTraces()}} for plotting traces to be used for a convergence analysis +\item \code{\link[=swapElements]{swapElements()}} for swapping elements in MCMC samples +} +} diff --git a/man/swapElements-generic.Rd b/man/swapElements-generic.Rd new file mode 100644 index 0000000..5e0df32 --- /dev/null +++ b/man/swapElements-generic.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\docType{methods} +\name{swapElements} +\alias{swapElements} +\title{Swaps elements in the MCMC sample arrays} +\usage{ +swapElements(object, index) +} +\description{ +Swaps elements in the MCMC sample arrays +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputbase-array-method.Rd b/man/swapElements-mcmcoutputbase-array-method.Rd new file mode 100644 index 0000000..01d23c4 --- /dev/null +++ b/man/swapElements-mcmcoutputbase-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputbase.R +\name{swapElements,mcmcoutputbase,array-method} +\alias{swapElements,mcmcoutputbase,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputbase,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputfix-array-method.Rd b/man/swapElements-mcmcoutputfix-array-method.Rd new file mode 100644 index 0000000..f825f9d --- /dev/null +++ b/man/swapElements-mcmcoutputfix-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfix.R +\name{swapElements,mcmcoutputfix,array-method} +\alias{swapElements,mcmcoutputfix,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputfix,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputfixhier-array-method.Rd b/man/swapElements-mcmcoutputfixhier-array-method.Rd new file mode 100644 index 0000000..0104a00 --- /dev/null +++ b/man/swapElements-mcmcoutputfixhier-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhier.R +\name{swapElements,mcmcoutputfixhier,array-method} +\alias{swapElements,mcmcoutputfixhier,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputfixhier,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputfixhierpost-array-method.Rd b/man/swapElements-mcmcoutputfixhierpost-array-method.Rd new file mode 100644 index 0000000..70a2cc1 --- /dev/null +++ b/man/swapElements-mcmcoutputfixhierpost-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixhierpost.R +\name{swapElements,mcmcoutputfixhierpost,array-method} +\alias{swapElements,mcmcoutputfixhierpost,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputfixhierpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputfixpost-array-method.Rd b/man/swapElements-mcmcoutputfixpost-array-method.Rd new file mode 100644 index 0000000..4814df7 --- /dev/null +++ b/man/swapElements-mcmcoutputfixpost-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputfixpost.R +\name{swapElements,mcmcoutputfixpost,array-method} +\alias{swapElements,mcmcoutputfixpost,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputfixpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputhier-array-method.Rd b/man/swapElements-mcmcoutputhier-array-method.Rd new file mode 100644 index 0000000..6dcefda --- /dev/null +++ b/man/swapElements-mcmcoutputhier-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhier.R +\name{swapElements,mcmcoutputhier,array-method} +\alias{swapElements,mcmcoutputhier,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputhier,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputhierpost-array-method.Rd b/man/swapElements-mcmcoutputhierpost-array-method.Rd new file mode 100644 index 0000000..ae64ccd --- /dev/null +++ b/man/swapElements-mcmcoutputhierpost-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputhierpost.R +\name{swapElements,mcmcoutputhierpost,array-method} +\alias{swapElements,mcmcoutputhierpost,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputhierpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutputhierpost} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutputhierpost} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-mcmcoutputpost-array-method.Rd b/man/swapElements-mcmcoutputpost-array-method.Rd new file mode 100644 index 0000000..9806dce --- /dev/null +++ b/man/swapElements-mcmcoutputpost-array-method.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpost.R +\name{swapElements,mcmcoutputpost,array-method} +\alias{swapElements,mcmcoutputpost,array-method} +\title{Swaps elements between components} +\usage{ +\S4method{swapElements}{mcmcoutputpost,array}(object, index) +} +\arguments{ +\item{object}{An \code{mcmcoutputpost} object containing the sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutputpost} object with swapped elements. +} +\description{ +Not yet implemented. +} +\keyword{internal} diff --git a/man/swapElements-method.Rd b/man/swapElements-method.Rd new file mode 100644 index 0000000..28cf430 --- /dev/null +++ b/man/swapElements-method.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcmcoutputpermhierpost.R +\name{swapElements} +\alias{swapElements} +\title{Swap elements of MCMC samples} +\arguments{ +\item{object}{An \code{mcmcoutput} object containing the +sampled values.} + +\item{index}{An array specifying the extraction of the values.} +} +\value{ +An \code{mcmcoutput} object with swapped elements. +} +\description{ +Calling \code{swapElements()} on an \code{mcmcoutput} object +swaps all labels by the schema given in the \code{index} argument. +} +\details{ +This function is merely a utility function that simplifies relabeling for +users and developers. For relabeling the labels have to be permuted and +depending on the MCMC sampling chosen there could be a lot of different +slots that need to be permuted. \code{swapElements()} swaps the elements in any +slot that needs to be relabeled. +} +\examples{ +\dontrun{ +# Generate a model of Poisson distributions. +f_model <- model("poisson", par = list(lambda = c(0.3, 1.2)), K = 2) +# Simulate data from the model. +f_data <- simulate(f_model) +# Define the hyper-parameters for MCMC sampling. +f_mcmc <- mcmc(storepost = FALSE) +# Define the prior distribution by relying on the data. +f_prior <- priordefine(f_data, f_model) +# Start MCMC sampling. +f_output <- mixturemcmc(f_data, f_model, f_prior, f_mcmc) +index <- matrix(c(1, 2), nrow = getM(f_output) + 1, + ncol = 2)[1:getM(f_output),] +swapElements(f_output, index) +} + +} +\seealso{ +\itemize{ +\item \linkS4class{mcmcoutput} for the class definition +\item \code{\link[=subseq]{subseq()}} for generating sub-chains from MCMC samples +\item \code{\link[=mcmcpermute]{mcmcpermute()}} for a calling function +} +} diff --git a/man/swap_3d_cc.Rd b/man/swap_3d_cc.Rd index 1a4e212..c8eec52 100644 --- a/man/swap_3d_cc.Rd +++ b/man/swap_3d_cc.Rd @@ -11,8 +11,9 @@ swap_3d_cc(values, index) \item{index}{An integer matrix of dimension \verb{M x K}. containing the scheme by which values should be swapped.} - -\item{A}{three-dimensional array with swapped values.} +} +\value{ +A three-dimensional array with swapped values. } \description{ This function swaps the elements in a three-dimensional array by using the diff --git a/src/attributes.cpp b/src/attributes.cpp index f751cf6..bc64cd3 100644 --- a/src/attributes.cpp +++ b/src/attributes.cpp @@ -86,7 +86,7 @@ Rcpp::NumericMatrix swap_cc(Rcpp::NumericMatrix values, Rcpp::IntegerMatrix inde //' @param values An array of dimension `M x r x K` of values to swap. //' @param index An integer matrix of dimension `M x K`. containing the scheme //' by which values should be swapped. -//' @param A three-dimensional array with swapped values. +//' @return A three-dimensional array with swapped values. //' @export //' //' @examples diff --git a/src/mcmc_binomial.cpp b/src/mcmc_binomial.cpp index df64c36..e475f20 100644 --- a/src/mcmc_binomial.cpp +++ b/src/mcmc_binomial.cpp @@ -50,7 +50,7 @@ //' density parameters. See for more information on mixin layers Smaragdakis //' and Butory (1998). //' -//' @param data_S4 An `fdata` object storing the observations and indicators. +//' @param fdata_S4 An `fdata` object storing the observations and indicators. //' @param model_S4 A `model` object specifying the Binomial finite mixture //' model. //' @param prior_S4 A `prior` object specifying the prior distribution for MCMC diff --git a/src/relabel_algorithms.cpp b/src/relabel_algorithms.cpp index 4521dc4..4f760f4 100644 --- a/src/relabel_algorithms.cpp +++ b/src/relabel_algorithms.cpp @@ -386,12 +386,11 @@ arma::imat stephens1997b_poisson_cc(Rcpp::NumericVector values, //' Stephens (1997b) for MCMC samples of a Binomial mixture distribution. //' //' @param values A matrix of observations of dimension `Nx1`. +//' @param reps A vector containing the repetitions. //' @param comp_par An array of component parameter samples from MCMC sampling. //' Dimension is `MxK`. -//' @param weight An array of weight parameter samples from MCMC sampling. +//' @param weight_par An array of weight parameter samples from MCMC sampling. //' Dimension is `MxK`. -//' @param max_iter A signed integer specifying the number of iterations to be -//' run in optimization. Unused. //' @return An integer matrix of dimension `MxK` that holding the optimal //' labeling. //' @export From 0a32344a469a59c1087ddde782a5391824d6eec5 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Sat, 6 Nov 2021 10:02:53 +0100 Subject: [PATCH 21/24] Fixed some warnings in the documentation. --- R/AllGenerics.R | 2 +- R/mcmcestind.R | 24 ++++----- R/mcmcoutputhierpost.R | 35 +++++++------ R/mcmcoutputpermhierpost.R | 22 ++++---- data/normal.data.csv | 101 ------------------------------------ data/poisson.data.csv | 100 ----------------------------------- data/poisson.ind.csv | 100 ----------------------------------- man/mcmcest-class.Rd | 70 ++++++++++--------------- man/mcmcoutput-class.Rd | 82 ++++++++++++----------------- man/mcmcoutputperm-class.Rd | 65 +++++++++-------------- man/plotTraces-generic.Rd | 4 +- 11 files changed, 130 insertions(+), 475 deletions(-) delete mode 100644 data/normal.data.csv delete mode 100644 data/poisson.data.csv delete mode 100644 data/poisson.ind.csv diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 44323ae..2ab153c 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -612,7 +612,7 @@ setGeneric("moments", function(object) standardGeneric("moments")) #' @export #' @docType methods #' @keywords internal -#' @rdname plotTraces-generic +#' @name plotTraces-generic setGeneric("plotTraces", function(x, dev = TRUE, lik = 1, col = FALSE, ...) standardGeneric("plotTraces")) #' Plots histograms of MCMC samples diff --git a/R/mcmcestind.R b/R/mcmcestind.R index 4806afc..5f30c42 100644 --- a/R/mcmcestind.R +++ b/R/mcmcestind.R @@ -121,32 +121,32 @@ #' * `getIeavg()` returns the identified EAVG estimates. #' * `getSdpost()` returns the `sdpost`. #' -#' @slot dist A character specifying the distribution family of the mixture +#' * `dist` A character specifying the distribution family of the mixture #' model used in MCMC sampling. -#' @slot K An integer specifying the number of components in the mixture model. -#' @slot indicmod A character specifying the indicator model. At this moment +#' * `K` An integer specifying the number of components in the mixture model. +#' * `indicmod` A character specifying the indicator model. At this moment #' only a multinomial model can be chosen. -#' @slot burnin An integer specifying the number of iterations in the burn-in +#' * `burnin` An integer specifying the number of iterations in the burn-in #' phase of MCMC sampling. -#' @slot M An integer specifying the number of iterations to store in MCMC +#' * `M` An integer specifying the number of iterations to store in MCMC #' sampling. -#' @slot ranperm A logical specifying, if random permutation has been used +#' * `ranperm` A logical specifying, if random permutation has been used #' during MCMC sampling. -#' @slot relabel A character specifying the re-labeling algorithm used during +#' * `relabel` A character specifying the re-labeling algorithm used during #' parameter estimation for the identified ergodic average. -#' @slot map A named list containing the parameter estimates of the MAP. The +#' * `map` A named list containing the parameter estimates of the MAP. The #' element `par` is a named list and contains the component parameters and #' the element `weight` contains the weights. -#' @slot bml A named list containing the parameter estimates of the BML. The +#' * `bml` A named list containing the parameter estimates of the BML. The #' element `par` is a named list and contains the component parameters and #' the element `weight` contains the weights. -#' @slot eavg A named list containing the parameter estimates of the +#' * `eavg` A named list containing the parameter estimates of the #' unidentified EAVG. Note that this is only the case for a model with #' unknown indicators. -#' @slot ieavg A named list containing the parameter estimates of the IEAVG. The +#' * `ieavg` A named list containing the parameter estimates of the IEAVG. The #' element `par` is a named list and contains the component parameters and #' the element `weight` contains the weights. -#' @slot sdpost A named list containing the standard deviations of the +#' * `sdpost` A named list containing the standard deviations of the #' parameter estimates from the posterior distributions. #' #' @exportClass mcmcest diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index d2e8507..2725366 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -120,39 +120,40 @@ #' that this function can only be applied for mixtures of two components. See #' [plotPostDens()] for further information. #' -#' @slot M An integer defining the number of iterations in MCMC sampling. -#' @slot burnin An integer defining the number of iterations in the burn-in +#' ## Slots +#' * `M` An integer defining the number of iterations in MCMC sampling. +#' * `burnin` An integer defining the number of iterations in the burn-in #' phase of MCMC sampling. These number of sampling steps are not stored #' in the output. -#' @slot ranperm A logical indicating, if MCMC sampling has been performed +#' * `ranperm` A logical indicating, if MCMC sampling has been performed #' with random permutations of components. -#' @slot par A named list containing the sampled component parameters. -#' @slot weight An `array` of dimension `M x K` containing the sampled +#' * `par` A named list containing the sampled component parameters. +#' * `weight` An `array` of dimension `M x K` containing the sampled #' weights. -#' @slot log A named list containing the values of the mixture log-likelihood, +#' * `log` A named list containing the values of the mixture log-likelihood, #' mixture prior log-likelihood, and the complete data posterior #' log-likelihood. -#' @slot hyper A list storing the sampled parameters from the hierarchical +#' * `hyper` A list storing the sampled parameters from the hierarchical #' prior. -#' @slot post A named list containing a list `par` that contains the posterior +#' * `post` A named list containing a list `par` that contains the posterior #' parameters as named arrays. -#' @slot entropy An `array` of dimension `M x 1` containing the entropy +#' * `entropy` An `array` of dimension `M x 1` containing the entropy #' for each MCMC draw. -#' @slot ST An `array` of dimension `M x 1` containing all MCMC states, +#' * `ST` An `array` of dimension `M x 1` containing all MCMC states, #' for the last observation in slot `y` of the `fdata` object passed in to #' [mixturemcmc()] where a state is defined for non-Markov models as the #' last indicator of this observation. -#' @slot S An `array` of dimension `N x storeS` containing the last -#' `storeS` indicators sampled. `storeS` is defined in the slot `@@storeS` of +#' * `S` An `array` of dimension `N x storeS` containing the last +#' `storeS` indicators sampled. `storeS` is defined in the slot `storeS` of #' the `mcmc` object passed into [mixturemcmc()]. -#' @slot NK An `array` of dimension `M x K` containing the number of +#' * `NK` An `array` of dimension `M x K` containing the number of #' observations assigned to each component for each MCMC draw. -#' @slot clust An `array` of dimension `N x 1` containing the recent +#' * `clust` An `array` of dimension `N x 1` containing the recent #' indicators defining the last "clustering" of observations into the #' mixture components. -#' @slot model The `model` object that specifies the finite mixture model for -#' whcih MCMC sampling has been performed. -#' @slot prior The `prior` object defining the prior distributions for the +#' * `model` The `model` object that specifies the finite mixture model for +#' which MCMC sampling has been performed. +#' * `prior` The `prior` object defining the prior distributions for the #' component parameters that has been used in MCMC sampling. #' #' @exportClass mcmcoutput diff --git a/R/mcmcoutputpermhierpost.R b/R/mcmcoutputpermhierpost.R index ce3dc93..5b77b1c 100644 --- a/R/mcmcoutputpermhierpost.R +++ b/R/mcmcoutputpermhierpost.R @@ -656,38 +656,38 @@ setMethod( #' that this function can only be applied for mixtures of two components. See #' [plotPostDens()] for further information. #' -#' @slot Mperm An integer defining the number of permuted MCMC samples. -#' @slot parperm A named list containing the permuted component parameter +#' * `Mperm` An integer defining the number of permuted MCMC samples. +#' * `parperm` A named list containing the permuted component parameter #' samples from MCMC sampling. -#' @slot relabel A character specifying the relabeling algorithm used for +#' * `relabel` A character specifying the relabeling algorithm used for #' permuting the MCMC samples. -#' @slot weightperm An array of dimension `MpermxK` containing the +#' * `weightperm` An array of dimension `MpermxK` containing the #' relabeled weight parameters. This slot is not available for models with #' fixed indicators as weights do not get sampled for such models. -#' @slot logperm A named list containing the mixture log-likelihood, the +#' * `logperm` A named list containing the mixture log-likelihood, the #' prior log-likelihood, and for models with unknown indicators the complete #' data posterior log-likelihood for the permuted MCMC samples. -#' @slot hyperperm A named list containing the (permuted) parameters of the +#' * `hyperperm` A named list containing the (permuted) parameters of the #' hierarchical prior. This slot is only available, if a hierarchical prior #' had been used for sampling, i.e. the slot `hier` of the #' [prior][prior-class] had been set to `TRUE`. -#' @slot postperm A named list containing a named list `par` with array(s) of +#' * `postperm` A named list containing a named list `par` with array(s) of #' parameters from the posterior density. This slot is only available if #' the hyperparameter `storepost` in the [mcmc][mcmc-class] object had been #' set to `TRUE`. -#' @slot entropyperm An `array` of dimension `Mpermx1` containing the +#' * `entropyperm` An `array` of dimension `Mpermx1` containing the #' entropy for each MCMC permuted draw. This slot is only available for #' models with unknown indicators. -#' @slot STperm An `array` of dimension `Mpermx1` containing all permuted +#' `STperm` An `array` of dimension `Mpermx1` containing all permuted #' MCMC states, for the last observation in slot `y` of the `fdata` object #' passed in to [mixturemcmc()] where a state is defined for non-Markov #' models as the last indicator of this observation. This slot is only #' available for models with unknown indicators. -#' @slot Sperm An `array` of dimension `N x storeS` containing the last +#' * `Sperm` An `array` of dimension `N x storeS` containing the last #' `storeS` permuted indicators. `storeS` is defined in the slot `storeS` #' of the `mcmc` object passed into [mixturemcmc()]. This slot is only #' available for models with unknown indicators. -#' @slot NKperm An `array` of dimension `Mperm x K` containing the numbers +#' * `NKperm` An `array` of dimension `Mperm x K` containing the numbers #' of observations assigned to each component. This slot is only available for #' models with unknown indicators. #' diff --git a/data/normal.data.csv b/data/normal.data.csv deleted file mode 100644 index be7ba8e..0000000 --- a/data/normal.data.csv +++ /dev/null @@ -1,101 +0,0 @@ -"x" -0.520423579615056 --1.44636620061558 -0.742167780022348 -0.984152728724147 --1.34798941210538 --0.234836665094758 --0.58823091215483 --0.448789840817087 --0.286330360230501 -0.512313466732322 -0.331058299659809 --0.387163333013486 -0.831643051080909 -0.0341468923342194 -0.722512454631328 -1.55773557063051 --0.585200335696442 --1.33356484380762 --0.331375689004131 -0.722471407211668 --1.92466976787985 --0.433235560507227 --0.553063517987895 --0.120297165677945 -1.20220393201727 -0.389198578355064 --0.987556323963088 -1.52783947478201 -0.721861707917357 -0.879117974654953 --1.62890396136571 --1.22333560050141 --0.00143730614542278 --0.540986654758332 -0.446880419003879 -1.63912014865521 --0.250092790458527 --0.312420383630235 -0.656744213076947 -1.88476674600079 -0.867212672659141 --0.622172855420289 -0.547520043180325 --1.37713091830205 -1.72784034095113 -0.970345441959976 --0.12584977632593 -0.0803389904832104 -0.141457361976448 --0.523571400474605 --0.00797843195558607 -1.69713563068159 --0.969501796618967 -1.13308010589328 --0.180677512593388 --0.690211864714125 -1.29077470459985 --0.726229969741046 -0.165979024659433 -0.45240706624537 -0.594764986814349 --0.594038566421872 -1.38719785789989 --2.03316710387479 -0.593625980978848 --1.17592220051568 --1.5445087430504 --0.54952656979793 -0.561536970642764 --0.879133995810428 -0.482572199304425 --0.204900282852521 --0.405666940435497 --1.25685613447083 -0.295784356178309 --1.28983462198295 -0.975428298541146 --1.03265929501944 --1.54713612553825 -1.19844775029095 --0.990229387938044 -2.89848686654208 -2.12658893933864 --0.106736165059247 --0.108188952472409 -0.608524778372288 -0.286591262373892 --0.528141861788054 --0.176851003535354 -0.877028491401702 -0.392875351555265 -1.21630626368013 --0.931325420722352 --1.42304317426073 -0.507280696184439 -0.600223371238026 -0.659221251324369 --1.73240901204352 -0.0307821557093998 -1.06022256195694 diff --git a/data/poisson.data.csv b/data/poisson.data.csv deleted file mode 100644 index b3e3c7e..0000000 --- a/data/poisson.data.csv +++ /dev/null @@ -1,100 +0,0 @@ -163 -155 -149 -172 -163 -186 -144 -149 -145 -148 -162 -145 -151 -188 -116 -175 -165 -156 -143 -154 -157 -144 -166 -165 -154 -129 -174 -157 -177 -176 -162 -150 -164 -149 -137 -166 -163 -164 -172 -186 -159 -166 -165 -163 -161 -146 -154 -159 -142 -160 -160 -159 -131 -156 -170 -166 -163 -157 -151 -151 -154 -148 -189 -152 -152 -151 -159 -155 -150 -161 -150 -167 -171 -183 -186 -140 -155 -168 -165 -165 -164 -137 -175 -147 -152 -156 -182 -154 -138 -180 -151 -158 -148 -179 -141 -159 -150 -153 -162 -145 diff --git a/data/poisson.ind.csv b/data/poisson.ind.csv deleted file mode 100644 index a4cad3e..0000000 --- a/data/poisson.ind.csv +++ /dev/null @@ -1,100 +0,0 @@ -1 -2 -2 -1 -1 -1 -2 -2 -2 -2 -1 -2 -2 -1 -2 -1 -1 -2 -2 -2 -2 -2 -1 -1 -2 -2 -1 -2 -1 -1 -1 -2 -1 -2 -2 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -2 -2 -1 -2 -1 -1 -1 -2 -2 -1 -1 -1 -2 -2 -2 -2 -2 -1 -2 -2 -2 -1 -2 -2 -1 -2 -1 -1 -1 -1 -2 -2 -1 -1 -1 -1 -2 -1 -2 -2 -2 -1 -2 -2 -1 -2 -2 -2 -1 -2 -1 -2 -2 -1 -2 diff --git a/man/mcmcest-class.Rd b/man/mcmcest-class.Rd index 2d4a4ec..7b7e6b3 100644 --- a/man/mcmcest-class.Rd +++ b/man/mcmcest-class.Rd @@ -77,51 +77,35 @@ as the slots are only set internally. \item \code{getEavg()} returns the EAVG estimates. \item \code{getIeavg()} returns the identified EAVG estimates. \item \code{getSdpost()} returns the \code{sdpost}. -} -} - -} -} -\section{Slots}{ - -\describe{ -\item{\code{dist}}{A character specifying the distribution family of the mixture -model used in MCMC sampling.} - -\item{\code{K}}{An integer specifying the number of components in the mixture model.} - -\item{\code{indicmod}}{A character specifying the indicator model. At this moment -only a multinomial model can be chosen.} - -\item{\code{burnin}}{An integer specifying the number of iterations in the burn-in -phase of MCMC sampling.} - -\item{\code{M}}{An integer specifying the number of iterations to store in MCMC -sampling.} - -\item{\code{ranperm}}{A logical specifying, if random permutation has been used -during MCMC sampling.} - -\item{\code{relabel}}{A character specifying the re-labeling algorithm used during -parameter estimation for the identified ergodic average.} - -\item{\code{map}}{A named list containing the parameter estimates of the MAP. The +\item \code{dist} A character specifying the distribution family of the mixture +model used in MCMC sampling. +\item \code{K} An integer specifying the number of components in the mixture model. +\item \code{indicmod} A character specifying the indicator model. At this moment +only a multinomial model can be chosen. +\item \code{burnin} An integer specifying the number of iterations in the burn-in +phase of MCMC sampling. +\item \code{M} An integer specifying the number of iterations to store in MCMC +sampling. +\item \code{ranperm} A logical specifying, if random permutation has been used +during MCMC sampling. +\item \code{relabel} A character specifying the re-labeling algorithm used during +parameter estimation for the identified ergodic average. +\item \code{map} A named list containing the parameter estimates of the MAP. The element \code{par} is a named list and contains the component parameters and -the element \code{weight} contains the weights.} - -\item{\code{bml}}{A named list containing the parameter estimates of the BML. The +the element \code{weight} contains the weights. +\item \code{bml} A named list containing the parameter estimates of the BML. The element \code{par} is a named list and contains the component parameters and -the element \code{weight} contains the weights.} - -\item{\code{eavg}}{A named list containing the parameter estimates of the +the element \code{weight} contains the weights. +\item \code{eavg} A named list containing the parameter estimates of the unidentified EAVG. Note that this is only the case for a model with -unknown indicators.} - -\item{\code{ieavg}}{A named list containing the parameter estimates of the IEAVG. The +unknown indicators. +\item \code{ieavg} A named list containing the parameter estimates of the IEAVG. The element \code{par} is a named list and contains the component parameters and -the element \code{weight} contains the weights.} - -\item{\code{sdpost}}{A named list containing the standard deviations of the -parameter estimates from the posterior distributions.} -}} +the element \code{weight} contains the weights. +\item \code{sdpost} A named list containing the standard deviations of the +parameter estimates from the posterior distributions. +} +} +} +} diff --git a/man/mcmcoutput-class.Rd b/man/mcmcoutput-class.Rd index 2b1263c..353f6ec 100644 --- a/man/mcmcoutput-class.Rd +++ b/man/mcmcoutput-class.Rd @@ -78,60 +78,46 @@ that this function can only be applied for mixtures of two components. See } } -} -\section{Slots}{ - -\describe{ -\item{\code{M}}{An integer defining the number of iterations in MCMC sampling.} -\item{\code{burnin}}{An integer defining the number of iterations in the burn-in +\subsection{Slots}{ +\itemize{ +\item \code{M} An integer defining the number of iterations in MCMC sampling. +\item \code{burnin} An integer defining the number of iterations in the burn-in phase of MCMC sampling. These number of sampling steps are not stored -in the output.} - -\item{\code{ranperm}}{A logical indicating, if MCMC sampling has been performed -with random permutations of components.} - -\item{\code{par}}{A named list containing the sampled component parameters.} - -\item{\code{weight}}{An \code{array} of dimension \verb{M x K} containing the sampled -weights.} - -\item{\code{log}}{A named list containing the values of the mixture log-likelihood, +in the output. +\item \code{ranperm} A logical indicating, if MCMC sampling has been performed +with random permutations of components. +\item \code{par} A named list containing the sampled component parameters. +\item \code{weight} An \code{array} of dimension \verb{M x K} containing the sampled +weights. +\item \code{log} A named list containing the values of the mixture log-likelihood, mixture prior log-likelihood, and the complete data posterior -log-likelihood.} - -\item{\code{hyper}}{A list storing the sampled parameters from the hierarchical -prior.} - -\item{\code{post}}{A named list containing a list \code{par} that contains the posterior -parameters as named arrays.} - -\item{\code{entropy}}{An \code{array} of dimension \verb{M x 1} containing the entropy -for each MCMC draw.} - -\item{\code{ST}}{An \code{array} of dimension \verb{M x 1} containing all MCMC states, +log-likelihood. +\item \code{hyper} A list storing the sampled parameters from the hierarchical +prior. +\item \code{post} A named list containing a list \code{par} that contains the posterior +parameters as named arrays. +\item \code{entropy} An \code{array} of dimension \verb{M x 1} containing the entropy +for each MCMC draw. +\item \code{ST} An \code{array} of dimension \verb{M x 1} containing all MCMC states, for the last observation in slot \code{y} of the \code{fdata} object passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the -last indicator of this observation.} - -\item{\code{S}}{An \code{array} of dimension \verb{N x storeS} containing the last -\code{storeS} indicators sampled. \code{storeS} is defined in the slot \verb{@storeS} of -the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}.} - -\item{\code{NK}}{An \code{array} of dimension \verb{M x K} containing the number of -observations assigned to each component for each MCMC draw.} - -\item{\code{clust}}{An \code{array} of dimension \verb{N x 1} containing the recent +last indicator of this observation. +\item \code{S} An \code{array} of dimension \verb{N x storeS} containing the last +\code{storeS} indicators sampled. \code{storeS} is defined in the slot \code{storeS} of +the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}. +\item \code{NK} An \code{array} of dimension \verb{M x K} containing the number of +observations assigned to each component for each MCMC draw. +\item \code{clust} An \code{array} of dimension \verb{N x 1} containing the recent indicators defining the last "clustering" of observations into the -mixture components.} - -\item{\code{model}}{The \code{model} object that specifies the finite mixture model for -whcih MCMC sampling has been performed.} - -\item{\code{prior}}{The \code{prior} object defining the prior distributions for the -component parameters that has been used in MCMC sampling.} -}} - +mixture components. +\item \code{model} The \code{model} object that specifies the finite mixture model for +which MCMC sampling has been performed. +\item \code{prior} The \code{prior} object defining the prior distributions for the +component parameters that has been used in MCMC sampling. +} +} +} \seealso{ \itemize{ \item \linkS4class{mcmcoutputperm} for the corresponding class defined for relabeled diff --git a/man/mcmcoutputperm-class.Rd b/man/mcmcoutputperm-class.Rd index 352a3fb..74ecdb5 100644 --- a/man/mcmcoutputperm-class.Rd +++ b/man/mcmcoutputperm-class.Rd @@ -68,57 +68,42 @@ parameters. See \code{\link[=plotSampRep]{plotSampRep()}} for further informatio \item \code{plotPostDens()} plots the posterior density of component parameters. Note that this function can only be applied for mixtures of two components. See \code{\link[=plotPostDens]{plotPostDens()}} for further information. -} -} - -} -} -\section{Slots}{ - -\describe{ -\item{\code{Mperm}}{An integer defining the number of permuted MCMC samples.} - -\item{\code{parperm}}{A named list containing the permuted component parameter -samples from MCMC sampling.} - -\item{\code{relabel}}{A character specifying the relabeling algorithm used for -permuting the MCMC samples.} - -\item{\code{weightperm}}{An array of dimension \code{MpermxK} containing the +\item \code{Mperm} An integer defining the number of permuted MCMC samples. +\item \code{parperm} A named list containing the permuted component parameter +samples from MCMC sampling. +\item \code{relabel} A character specifying the relabeling algorithm used for +permuting the MCMC samples. +\item \code{weightperm} An array of dimension \code{MpermxK} containing the relabeled weight parameters. This slot is not available for models with -fixed indicators as weights do not get sampled for such models.} - -\item{\code{logperm}}{A named list containing the mixture log-likelihood, the +fixed indicators as weights do not get sampled for such models. +\item \code{logperm} A named list containing the mixture log-likelihood, the prior log-likelihood, and for models with unknown indicators the complete -data posterior log-likelihood for the permuted MCMC samples.} - -\item{\code{hyperperm}}{A named list containing the (permuted) parameters of the +data posterior log-likelihood for the permuted MCMC samples. +\item \code{hyperperm} A named list containing the (permuted) parameters of the hierarchical prior. This slot is only available, if a hierarchical prior had been used for sampling, i.e. the slot \code{hier} of the -\link[=prior-class]{prior} had been set to \code{TRUE}.} - -\item{\code{postperm}}{A named list containing a named list \code{par} with array(s) of +\link[=prior-class]{prior} had been set to \code{TRUE}. +\item \code{postperm} A named list containing a named list \code{par} with array(s) of parameters from the posterior density. This slot is only available if the hyperparameter \code{storepost} in the \link[=mcmc-class]{mcmc} object had been -set to \code{TRUE}.} - -\item{\code{entropyperm}}{An \code{array} of dimension \code{Mpermx1} containing the +set to \code{TRUE}. +\item \code{entropyperm} An \code{array} of dimension \code{Mpermx1} containing the entropy for each MCMC permuted draw. This slot is only available for -models with unknown indicators.} - -\item{\code{STperm}}{An \code{array} of dimension \code{Mpermx1} containing all permuted +models with unknown indicators. +\code{STperm} An \code{array} of dimension \code{Mpermx1} containing all permuted MCMC states, for the last observation in slot \code{y} of the \code{fdata} object passed in to \code{\link[=mixturemcmc]{mixturemcmc()}} where a state is defined for non-Markov models as the last indicator of this observation. This slot is only -available for models with unknown indicators.} - -\item{\code{Sperm}}{An \code{array} of dimension \verb{N x storeS} containing the last +available for models with unknown indicators. +\item \code{Sperm} An \code{array} of dimension \verb{N x storeS} containing the last \code{storeS} permuted indicators. \code{storeS} is defined in the slot \code{storeS} of the \code{mcmc} object passed into \code{\link[=mixturemcmc]{mixturemcmc()}}. This slot is only -available for models with unknown indicators.} - -\item{\code{NKperm}}{An \code{array} of dimension \verb{Mperm x K} containing the numbers +available for models with unknown indicators. +\item \code{NKperm} An \code{array} of dimension \verb{Mperm x K} containing the numbers of observations assigned to each component. This slot is only available for -models with unknown indicators.} -}} +models with unknown indicators. +} +} +} +} diff --git a/man/plotTraces-generic.Rd b/man/plotTraces-generic.Rd index 84f483a..20ef3ff 100644 --- a/man/plotTraces-generic.Rd +++ b/man/plotTraces-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{plotTraces} -\alias{plotTraces} +\name{plotTraces-generic} +\alias{plotTraces-generic} \title{Plots the traces of the MCMC samples} \usage{ plotTraces(x, dev = TRUE, lik = 1, col = FALSE, ...) From 49fe96f1153c959a841e2e484e1d4bea9cbfa401 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Sun, 7 Nov 2021 11:51:18 +0100 Subject: [PATCH 22/24] Fixed documentation on generics and some methods. devtools::check() runs without warnings --- R/AllGenerics.R | 9 ++++++ R/fdata.R | 29 +++++++++++++++++++ R/mcmcoutputhier.R | 5 ++++ R/mcmcoutputhierpost.R | 3 ++ R/mcmcoutputpermfixhier.R | 5 ++++ R/mcmcoutputpermfixhierpost.R | 6 ++++ R/mcmcoutputpermfixpost.R | 6 ++++ R/mcmcoutputpermhier.R | 1 + R/mcmcoutputpost.R | 5 ++++ R/model.R | 6 +++- man/{extract.Rd => extract-generic.Rd} | 4 +-- man/getBycolumn-fdata-method.Rd | 1 + man/getColExp-fdata-method.Rd | 1 + man/getColS-fdata-method.Rd | 1 + man/getColT-fdata-method.Rd | 1 + man/getColY-fdata-method.Rd | 1 + man/getExp-fdata-method.Rd | 1 + man/getN-fdata-method.Rd | 1 + man/getName-fdata-method.Rd | 1 + man/getPost-mcmcoutputhierpost-method.Rd | 1 + man/getR-fdata-method.Rd | 1 + man/getRowExp-fdata-method.Rd | 1 + man/getRowS-fdata-method.Rd | 1 + man/getRowT-fdata-method.Rd | 1 + man/getRowY-fdata-method.Rd | 1 + man/getS-fdata-method.Rd | 1 + man/getSim-fdata-method.Rd | 1 + man/getT-fdata-method.Rd | 1 + man/getType-fdata-method.Rd | 1 + man/getY-fdata-method.Rd | 1 + man/hasPar-model-method.Rd | 5 +++- man/plot-fdata-missing-method.Rd | 1 + man/plot-model-ANY-method.Rd | 1 + man/plotDens-generic.Rd | 4 +-- man/plotDens-mcmcoutputhier-method.Rd | 1 + man/plotDens-mcmcoutputpermfixhier-method.Rd | 1 + ...otDens-mcmcoutputpermfixhierpost-method.Rd | 1 + man/plotDens-mcmcoutputpermfixpost-method.Rd | 1 + man/plotDens-mcmcoutputpost-method.Rd | 1 + man/plotHist-generic.Rd | 4 +-- man/plotHist-mcmcoutputhier-method.Rd | 1 + man/plotHist-mcmcoutputpermfixhier-method.Rd | 1 + ...otHist-mcmcoutputpermfixhierpost-method.Rd | 1 + man/plotHist-mcmcoutputpermfixpost-method.Rd | 1 + man/plotHist-mcmcoutputpost-method.Rd | 1 + man/plotPointProc-generic.Rd | 4 +-- man/plotPointProc-mcmcoutputhier-method.Rd | 1 + ...plotPointProc-mcmcoutputhierpost-method.Rd | 1 + ...tPointProc-mcmcoutputpermfixhier-method.Rd | 1 + ...ntProc-mcmcoutputpermfixhierpost-method.Rd | 1 + ...tPointProc-mcmcoutputpermfixpost-method.Rd | 1 + ...plotPointProc-mcmcoutputpermhier-method.Rd | 1 + man/plotPointProc-mcmcoutputpost-method.Rd | 1 + man/plotPointProc-model-method.Rd | 1 + man/plotPostDens-generic.Rd | 4 +-- ...stDens-mcmcoutputpermfixhierpost-method.Rd | 1 + ...otPostDens-mcmcoutputpermfixpost-method.Rd | 1 + man/plotSampRep-generic.Rd | 4 +-- man/plotSampRep-mcmcoutputhier-method.Rd | 1 + man/plotSampRep-mcmcoutputhierpost-method.Rd | 1 + ...lotSampRep-mcmcoutputpermfixhier-method.Rd | 1 + ...ampRep-mcmcoutputpermfixhierpost-method.Rd | 1 + ...lotSampRep-mcmcoutputpermfixpost-method.Rd | 1 + man/plotSampRep-mcmcoutputpost-method.Rd | 1 + man/plotTraces-mcmcoutputhier-method.Rd | 1 + ...plotTraces-mcmcoutputpermfixhier-method.Rd | 1 + ...Traces-mcmcoutputpermfixhierpost-method.Rd | 1 + ...plotTraces-mcmcoutputpermfixpost-method.Rd | 1 + man/plotTraces-mcmcoutputpost-method.Rd | 1 + man/setBycolumn-set-fdata-method.Rd | 1 + man/setExp-set-fdata-method.Rd | 1 + man/setN-set-fdata-method.Rd | 1 + man/setName-set-fdata-method.Rd | 1 + man/setR-set-fdata-method.Rd | 1 + man/setS-set-fdata-method.Rd | 1 + man/setSim-set-fdata-method.Rd | 1 + man/setT-set-fdata-method.Rd | 1 + man/setType-set-fdata-method.Rd | 1 + man/setY-set-fdata-method.Rd | 1 + man/subseq-generic.Rd | 4 +-- man/swapElements-generic.Rd | 4 +-- 81 files changed, 156 insertions(+), 18 deletions(-) rename man/{extract.Rd => extract-generic.Rd} (87%) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 2ab153c..cfc4030 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -31,6 +31,7 @@ setGeneric("simulate", function(model, N = 100, varargin, seed = 0) standardGene #' @export #' @docType methods #' @keywords internal +#' @name plotPointProc-generic #' @rdname plotPointProc-generic setGeneric("plotPointProc", function(x, dev = TRUE, ...) standardGeneric("plotPointProc")) @@ -619,6 +620,7 @@ setGeneric("plotTraces", function(x, dev = TRUE, lik = 1, col = FALSE, ...) stan #' @export #' @docType methods #' @keywords internal +#' @name plotHist-generic #' @rdname plotHist-generic setGeneric("plotHist", function(x, dev = TRUE, ...) standardGeneric("plotHist")) @@ -626,6 +628,7 @@ setGeneric("plotHist", function(x, dev = TRUE, ...) standardGeneric("plotHist")) #' @export #' @docType methods #' @keywords internal +#' @name plotDens-generic #' @rdname plotDens-generic setGeneric("plotDens", function(x, dev = TRUE, ...) standardGeneric("plotDens")) @@ -633,6 +636,7 @@ setGeneric("plotDens", function(x, dev = TRUE, ...) standardGeneric("plotDens")) #' @export #' @docType methods #' @keywords internal +#' @name plotSampRep-generic #' @rdname plotSampRep-generic setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSampRep")) @@ -640,6 +644,7 @@ setGeneric("plotSampRep", function(x, dev = TRUE, ...) standardGeneric("plotSamp #' @export #' @docType methods #' @keywords internal +#' @name plotPostDens-generic #' @rdname plotPostDens-generic setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPostDens")) @@ -647,6 +652,7 @@ setGeneric("plotPostDens", function(x, dev = TRUE, ...) standardGeneric("plotPos #' @export #' @docType methods #' @keywords internal +#' @name subseq-generic #' @rdname subseq-generic setGeneric("subseq", function(object, index) standardGeneric("subseq")) @@ -654,6 +660,7 @@ setGeneric("subseq", function(object, index) standardGeneric("subseq")) #' @export #' @docType methods #' @keywords internal +#' @name swapElements-generic #' @rdname swapElements-generic setGeneric("swapElements", function(object, index) standardGeneric("swapElements")) @@ -661,6 +668,8 @@ setGeneric("swapElements", function(object, index) standardGeneric("swapElements #' @export #' @docType methods #' @keywords internal +#' @name extract-generic +#' @rdname extract-generic setGeneric("extract", function(object, index) standardGeneric("extract")) #' Getter for the `log` slot diff --git a/R/fdata.R b/R/fdata.R index e3c6b1f..7f8d960 100644 --- a/R/fdata.R +++ b/R/fdata.R @@ -284,6 +284,7 @@ #' @param ... Further arguments passed to the plotting functions `hist` or #' `barplot`. #' @exportMethod plot +#' @keywords internal #' #' @examples #' # Generate Poisson data and plot it. @@ -523,6 +524,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `y` slot of the `object` as a column-ordered matrix. #' @exportMethod getColY +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -548,6 +550,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `y` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowY +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -573,6 +576,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `S` slot of the `object` as a column-ordered matrix. #' @exportMethod getColS +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -598,6 +602,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `S` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowS +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -623,6 +628,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `exp` slot of the `object` as a column-ordered matrix. #' @exportMethod getColExp +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -648,6 +654,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `exp` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowExp +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -673,6 +680,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `T` slot of the `object` as a column-ordered matrix. #' @exportMethod getColT +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -698,6 +706,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `T` slot of the `object` as a row-ordered matrix. #' @exportMethod getRowT +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -725,6 +734,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `y` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getY +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -746,6 +756,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `N` slot of the `object`. #' @exportMethod getN +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -767,6 +778,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `r` slot of the `object`. #' @exportMethod getR +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -788,6 +800,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `S` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getS +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -809,6 +822,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `bycolumn` slot of the `object`. #' @exportMethod getBycolumn +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -830,6 +844,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `name` slot of the `object`. #' @exportMethod getName +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -851,6 +866,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `type` slot of the `object`. #' @exportMethod getType +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -872,6 +888,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `sim` slot of the `object`. #' @exportMethod getSim +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -893,6 +910,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `exp` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getExp +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -914,6 +932,7 @@ setMethod( #' @param object An `fdata` object. #' @returns The `T` slot of the `object` in the order defined `bycolumn`. #' @exportMethod getT +#' @keywords internal #' #' @examples #' # Create an fdata object with Poisson data @@ -940,6 +959,7 @@ setMethod( #' @returns The `fdata` object with slot `y` set to `value` or an error message #' if the `value` cannot be set as slot `y`. #' @exportMethod setY<- +#' @keywords internal #' #' @examples #' f_data <- fdata() @@ -979,6 +999,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `N` set to `value` or an error message #' if the `value` cannot be set as slot `N`. #' @exportMethod setN<- +#' @keywords internal #' #' @examples #' f_data <- fdata() @@ -1005,6 +1026,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `R` set to `value` or an error message #' if the `value` cannot be set as slot `R`. #' @exportMethod setR<- +#' @keywords internal #' #' @examples #' f_data <- fdata() @@ -1032,6 +1054,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `S` set to `value` or an error message #' if the `value` cannot be set as slot `S`. #' @exportMethod setS<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. @@ -1065,6 +1088,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `bycolumn` set to `value` or an error message #' if the `value` cannot be set as slot `bycolumn`. #' @exportMethod setBycolumn<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. @@ -1109,6 +1133,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `name` set to `value` or an error message #' if the `value` cannot be set as slot `name`. #' @exportMethod setName<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. @@ -1136,6 +1161,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `type` set to `value` or an error message #' if the `value` cannot be set as slot `type`. #' @exportMethod setType<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. @@ -1164,6 +1190,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `sim` set to `value` or an error message #' if the `value` cannot be set as slot `sim`. #' @exportMethod setSim<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. @@ -1192,6 +1219,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `exp` set to `value` or an error message #' if the `value` cannot be set as slot `exp`. #' @exportMethod setExp<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. @@ -1226,6 +1254,7 @@ setReplaceMethod( #' @returns The `fdata` object with slot `T` set to `value` or an error message #' if the `value` cannot be set as slot `T`. #' @exportMethod setT<- +#' @keywords internal #' #' @examples #' # Generate an empty fdata object. diff --git a/R/mcmcoutputhier.R b/R/mcmcoutputhier.R index 1a7b2e8..cde705b 100644 --- a/R/mcmcoutputhier.R +++ b/R/mcmcoutputhier.R @@ -126,6 +126,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces +#' @keywords internal #' #' @examples #' \dontrun{ @@ -199,6 +200,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist +#' @keywords internal #' #' @examples #' \dontrun{ @@ -250,6 +252,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens +#' @keywords internal #' #' @examples #' \dontrun{ @@ -301,6 +304,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ @@ -347,6 +351,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputhierpost.R b/R/mcmcoutputhierpost.R index 2725366..51c4a61 100644 --- a/R/mcmcoutputhierpost.R +++ b/R/mcmcoutputhierpost.R @@ -426,6 +426,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ @@ -474,6 +475,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep +#' @keywords internal #' #' @examples #' \dontrun{ @@ -641,6 +643,7 @@ setMethod( #' @param object An `mcmcoutputhierpost` object. #' @returns The `post` slot of the `object`. #' @exportMethod getPost +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpermfixhier.R b/R/mcmcoutputpermfixhier.R index bdb27fb..a9d0e87 100644 --- a/R/mcmcoutputpermfixhier.R +++ b/R/mcmcoutputpermfixhier.R @@ -165,6 +165,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces +#' @keywords internal #' #' @examples #' \dontrun{ @@ -240,6 +241,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist +#' @keywords internal #' #' @examples #' \dontrun{ @@ -297,6 +299,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens +#' @keywords internal #' #' @examples #' \dontrun{ @@ -353,6 +356,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ @@ -406,6 +410,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfixhierpost.R b/R/mcmcoutputpermfixhierpost.R index f8a7df5..4d7f92b 100644 --- a/R/mcmcoutputpermfixhierpost.R +++ b/R/mcmcoutputpermfixhierpost.R @@ -185,6 +185,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces +#' @keywords internal #' #' @examples #' \dontrun{ @@ -260,6 +261,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist +#' @keywords internal #' #' @examples #' \dontrun{ @@ -317,6 +319,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens +#' @keywords internal #' #' @examples #' \dontrun{ @@ -373,6 +376,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ @@ -429,6 +433,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampliing representations of the MCMC samples. #' @exportMethod plotSampRep +#' @keywords internal #' #' @examples #' \dontrun{ @@ -485,6 +490,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermfixpost.R b/R/mcmcoutputpermfixpost.R index 6fceaf1..57c6d0e 100644 --- a/R/mcmcoutputpermfixpost.R +++ b/R/mcmcoutputpermfixpost.R @@ -164,6 +164,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces +#' @keywords internal #' #' @examples #' \dontrun{ @@ -241,6 +242,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist +#' @keywords internal #' #' @examples #' \dontrun{ @@ -300,6 +302,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens +#' @keywords internal #' #' @examples #' \dontrun{ @@ -358,6 +361,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ @@ -413,6 +417,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep +#' @keywords internal #' #' @examples #' \dontrun{ @@ -471,6 +476,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Posterior densities of the MCMC samples. #' @exportMethod plotPostDens +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/mcmcoutputpermhier.R b/R/mcmcoutputpermhier.R index 46752b8..c388e32 100644 --- a/R/mcmcoutputpermhier.R +++ b/R/mcmcoutputpermhier.R @@ -424,6 +424,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' # Define a Poisson mixture model with two components. diff --git a/R/mcmcoutputpost.R b/R/mcmcoutputpost.R index 0f55b2c..320799a 100644 --- a/R/mcmcoutputpost.R +++ b/R/mcmcoutputpost.R @@ -124,6 +124,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return A plot of the traces of the MCMC samples. #' @exportMethod plotTraces +#' @keywords internal #' #' @examples #' \dontrun{ @@ -175,6 +176,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Histograms of the MCMC samples. #' @exportMethod plotHist +#' @keywords internal #' #' @examples #' \dontrun{ @@ -223,6 +225,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Densities of the MCMC samples. #' @exportMethod plotDens +#' @keywords internal #' #' @examples #' \dontrun{ @@ -272,6 +275,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Point process of the MCMC samples. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ @@ -320,6 +324,7 @@ setMethod( #' @param ... Further arguments to be passed to the plotting function. #' @return Sampling representation of the MCMC samples. #' @exportMethod plotSampRep +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/R/model.R b/R/model.R index ad36f73..e9ef264 100644 --- a/R/model.R +++ b/R/model.R @@ -283,13 +283,15 @@ setMethod( #' @param verbose A logical indicating, if the function should give a print out. #' @return A matrix with repetitions. Can be empty, if no repetitions are set. #' @exportMethod hasPar +#' @keywords internal #' #' @examples #' \dontrun{ #' if(hasPar(model)) {simulate(model)} #' } #' -#' @seealso \code{model} +#' @seealso +#' * [model-class] for the class definition setMethod( "hasPar", "model", function(object, verbose = FALSE) { @@ -359,6 +361,7 @@ setMethod( #' (see par). #' @return Density or barplot of the S4 model object. #' @exportMethod plot +#' @keywords internal #' #' @examples \dontrun{ #' plot(f_model) @@ -405,6 +408,7 @@ setMethod( #' (see [par]). #' @return A scatter plot of weighted parameters. #' @exportMethod plotPointProc +#' @keywords internal #' #' @examples #' \dontrun{ diff --git a/man/extract.Rd b/man/extract-generic.Rd similarity index 87% rename from man/extract.Rd rename to man/extract-generic.Rd index 61b4a2a..53ec17a 100644 --- a/man/extract.Rd +++ b/man/extract-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{extract} -\alias{extract} +\name{extract-generic} +\alias{extract-generic} \title{Extracts the MCMC samples from a specific dimension of a multivariate model} \usage{ extract(object, index) diff --git a/man/getBycolumn-fdata-method.Rd b/man/getBycolumn-fdata-method.Rd index a725da3..14043dd 100644 --- a/man/getBycolumn-fdata-method.Rd +++ b/man/getBycolumn-fdata-method.Rd @@ -24,3 +24,4 @@ getBycolumn(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getColExp-fdata-method.Rd b/man/getColExp-fdata-method.Rd index b7d2fe9..6123d3e 100644 --- a/man/getColExp-fdata-method.Rd +++ b/man/getColExp-fdata-method.Rd @@ -24,3 +24,4 @@ getColExp(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getColS-fdata-method.Rd b/man/getColS-fdata-method.Rd index d8cf954..217e510 100644 --- a/man/getColS-fdata-method.Rd +++ b/man/getColS-fdata-method.Rd @@ -24,3 +24,4 @@ getColS(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getColT-fdata-method.Rd b/man/getColT-fdata-method.Rd index 160b713..c1cc1df 100644 --- a/man/getColT-fdata-method.Rd +++ b/man/getColT-fdata-method.Rd @@ -24,3 +24,4 @@ getColT(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getColY-fdata-method.Rd b/man/getColY-fdata-method.Rd index b457bfb..81a41c3 100644 --- a/man/getColY-fdata-method.Rd +++ b/man/getColY-fdata-method.Rd @@ -24,3 +24,4 @@ getColY(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getExp-fdata-method.Rd b/man/getExp-fdata-method.Rd index 8bc1274..ccf8fd4 100644 --- a/man/getExp-fdata-method.Rd +++ b/man/getExp-fdata-method.Rd @@ -24,3 +24,4 @@ getExp(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getN-fdata-method.Rd b/man/getN-fdata-method.Rd index 31e5191..5a93e2a 100644 --- a/man/getN-fdata-method.Rd +++ b/man/getN-fdata-method.Rd @@ -24,3 +24,4 @@ getN(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getName-fdata-method.Rd b/man/getName-fdata-method.Rd index 6360fab..b6b8dc2 100644 --- a/man/getName-fdata-method.Rd +++ b/man/getName-fdata-method.Rd @@ -24,3 +24,4 @@ getName(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getPost-mcmcoutputhierpost-method.Rd b/man/getPost-mcmcoutputhierpost-method.Rd index fd8b3c2..70b33dd 100644 --- a/man/getPost-mcmcoutputhierpost-method.Rd +++ b/man/getPost-mcmcoutputhierpost-method.Rd @@ -36,3 +36,4 @@ getPost(f_output) \item \code{\link[=mixturemcmc]{mixturemcmc()}} for performing MCMC sampling } } +\keyword{internal} diff --git a/man/getR-fdata-method.Rd b/man/getR-fdata-method.Rd index 3e3effe..364c55f 100644 --- a/man/getR-fdata-method.Rd +++ b/man/getR-fdata-method.Rd @@ -24,3 +24,4 @@ getR(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getRowExp-fdata-method.Rd b/man/getRowExp-fdata-method.Rd index f6df800..56bb7c8 100644 --- a/man/getRowExp-fdata-method.Rd +++ b/man/getRowExp-fdata-method.Rd @@ -24,3 +24,4 @@ getRowExp(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getRowS-fdata-method.Rd b/man/getRowS-fdata-method.Rd index ae1cf7b..a722328 100644 --- a/man/getRowS-fdata-method.Rd +++ b/man/getRowS-fdata-method.Rd @@ -24,3 +24,4 @@ getRowS(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getRowT-fdata-method.Rd b/man/getRowT-fdata-method.Rd index b040255..7f083a6 100644 --- a/man/getRowT-fdata-method.Rd +++ b/man/getRowT-fdata-method.Rd @@ -24,3 +24,4 @@ getRowT(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getRowY-fdata-method.Rd b/man/getRowY-fdata-method.Rd index ce06c83..a56efd4 100644 --- a/man/getRowY-fdata-method.Rd +++ b/man/getRowY-fdata-method.Rd @@ -24,3 +24,4 @@ getRowY(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getS-fdata-method.Rd b/man/getS-fdata-method.Rd index 31de6e8..6162290 100644 --- a/man/getS-fdata-method.Rd +++ b/man/getS-fdata-method.Rd @@ -24,3 +24,4 @@ getS(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getSim-fdata-method.Rd b/man/getSim-fdata-method.Rd index 9fd11aa..b99fc72 100644 --- a/man/getSim-fdata-method.Rd +++ b/man/getSim-fdata-method.Rd @@ -24,3 +24,4 @@ getSim(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getT-fdata-method.Rd b/man/getT-fdata-method.Rd index 9655355..239b335 100644 --- a/man/getT-fdata-method.Rd +++ b/man/getT-fdata-method.Rd @@ -24,3 +24,4 @@ getT(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getType-fdata-method.Rd b/man/getType-fdata-method.Rd index fa90466..e3b2484 100644 --- a/man/getType-fdata-method.Rd +++ b/man/getType-fdata-method.Rd @@ -24,3 +24,4 @@ getType(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/getY-fdata-method.Rd b/man/getY-fdata-method.Rd index b9f43da..1ef9eb9 100644 --- a/man/getY-fdata-method.Rd +++ b/man/getY-fdata-method.Rd @@ -24,3 +24,4 @@ getY(f_data) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/hasPar-model-method.Rd b/man/hasPar-model-method.Rd index ca1bf8a..97d688e 100644 --- a/man/hasPar-model-method.Rd +++ b/man/hasPar-model-method.Rd @@ -24,5 +24,8 @@ if(hasPar(model)) {simulate(model)} } \seealso{ -\code{model} +\itemize{ +\item \linkS4class{model} for the class definition } +} +\keyword{internal} diff --git a/man/plot-fdata-missing-method.Rd b/man/plot-fdata-missing-method.Rd index 113141a..b4ee4b4 100644 --- a/man/plot-fdata-missing-method.Rd +++ b/man/plot-fdata-missing-method.Rd @@ -30,3 +30,4 @@ plot(f_data) \seealso{ \link{fdata} class } +\keyword{internal} diff --git a/man/plot-model-ANY-method.Rd b/man/plot-model-ANY-method.Rd index 19588b1..ddecd55 100644 --- a/man/plot-model-ANY-method.Rd +++ b/man/plot-model-ANY-method.Rd @@ -36,3 +36,4 @@ plot(f_model) \item \code{\link[=model]{model()}} for the class constructor } } +\keyword{internal} diff --git a/man/plotDens-generic.Rd b/man/plotDens-generic.Rd index ad64112..27248d2 100644 --- a/man/plotDens-generic.Rd +++ b/man/plotDens-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{plotDens} -\alias{plotDens} +\name{plotDens-generic} +\alias{plotDens-generic} \title{Plots densities of MCMC samples} \usage{ plotDens(x, dev = TRUE, ...) diff --git a/man/plotDens-mcmcoutputhier-method.Rd b/man/plotDens-mcmcoutputhier-method.Rd index df80d9a..ed0edf7 100644 --- a/man/plotDens-mcmcoutputhier-method.Rd +++ b/man/plotDens-mcmcoutputhier-method.Rd @@ -49,3 +49,4 @@ plotDens(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermfixhier-method.Rd b/man/plotDens-mcmcoutputpermfixhier-method.Rd index cb97df9..ed346ac 100644 --- a/man/plotDens-mcmcoutputpermfixhier-method.Rd +++ b/man/plotDens-mcmcoutputpermfixhier-method.Rd @@ -54,3 +54,4 @@ plotDens(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermfixhierpost-method.Rd b/man/plotDens-mcmcoutputpermfixhierpost-method.Rd index 5063737..f0fa7e2 100644 --- a/man/plotDens-mcmcoutputpermfixhierpost-method.Rd +++ b/man/plotDens-mcmcoutputpermfixhierpost-method.Rd @@ -54,3 +54,4 @@ plotDens(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpermfixpost-method.Rd b/man/plotDens-mcmcoutputpermfixpost-method.Rd index 0d0eaf5..55439ad 100644 --- a/man/plotDens-mcmcoutputpermfixpost-method.Rd +++ b/man/plotDens-mcmcoutputpermfixpost-method.Rd @@ -56,3 +56,4 @@ plotDens(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotDens-mcmcoutputpost-method.Rd b/man/plotDens-mcmcoutputpost-method.Rd index 11faf8d..41ff2f8 100644 --- a/man/plotDens-mcmcoutputpost-method.Rd +++ b/man/plotDens-mcmcoutputpost-method.Rd @@ -51,3 +51,4 @@ plotDens(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotHist-generic.Rd b/man/plotHist-generic.Rd index 6cb79f8..7b07bb5 100644 --- a/man/plotHist-generic.Rd +++ b/man/plotHist-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{plotHist} -\alias{plotHist} +\name{plotHist-generic} +\alias{plotHist-generic} \title{Plots histograms of MCMC samples} \usage{ plotHist(x, dev = TRUE, ...) diff --git a/man/plotHist-mcmcoutputhier-method.Rd b/man/plotHist-mcmcoutputhier-method.Rd index f7f8338..c3b4f61 100644 --- a/man/plotHist-mcmcoutputhier-method.Rd +++ b/man/plotHist-mcmcoutputhier-method.Rd @@ -48,3 +48,4 @@ plotHist(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermfixhier-method.Rd b/man/plotHist-mcmcoutputpermfixhier-method.Rd index 562e8e5..0f0e17a 100644 --- a/man/plotHist-mcmcoutputpermfixhier-method.Rd +++ b/man/plotHist-mcmcoutputpermfixhier-method.Rd @@ -54,3 +54,4 @@ plotHist(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermfixhierpost-method.Rd b/man/plotHist-mcmcoutputpermfixhierpost-method.Rd index 4750468..1f0282d 100644 --- a/man/plotHist-mcmcoutputpermfixhierpost-method.Rd +++ b/man/plotHist-mcmcoutputpermfixhierpost-method.Rd @@ -54,3 +54,4 @@ plotHist(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpermfixpost-method.Rd b/man/plotHist-mcmcoutputpermfixpost-method.Rd index dd0a01f..e1e45b8 100644 --- a/man/plotHist-mcmcoutputpermfixpost-method.Rd +++ b/man/plotHist-mcmcoutputpermfixpost-method.Rd @@ -56,3 +56,4 @@ plotHist(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component } } +\keyword{internal} diff --git a/man/plotHist-mcmcoutputpost-method.Rd b/man/plotHist-mcmcoutputpost-method.Rd index 8b09c64..6716578 100644 --- a/man/plotHist-mcmcoutputpost-method.Rd +++ b/man/plotHist-mcmcoutputpost-method.Rd @@ -49,3 +49,4 @@ plotHist(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotPointProc-generic.Rd b/man/plotPointProc-generic.Rd index e3ef3c6..4d68646 100644 --- a/man/plotPointProc-generic.Rd +++ b/man/plotPointProc-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{plotPointProc} -\alias{plotPointProc} +\name{plotPointProc-generic} +\alias{plotPointProc-generic} \title{Plots the point process of a finite mixture model} \usage{ plotPointProc(x, dev = TRUE, ...) diff --git a/man/plotPointProc-mcmcoutputhier-method.Rd b/man/plotPointProc-mcmcoutputhier-method.Rd index 1b057dd..43dbc60 100644 --- a/man/plotPointProc-mcmcoutputhier-method.Rd +++ b/man/plotPointProc-mcmcoutputhier-method.Rd @@ -47,3 +47,4 @@ plotPointProc(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputhierpost-method.Rd b/man/plotPointProc-mcmcoutputhierpost-method.Rd index e405e50..6ef330c 100644 --- a/man/plotPointProc-mcmcoutputhierpost-method.Rd +++ b/man/plotPointProc-mcmcoutputhierpost-method.Rd @@ -49,3 +49,4 @@ plotPointProc(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermfixhier-method.Rd b/man/plotPointProc-mcmcoutputpermfixhier-method.Rd index 76a7dd9..3bdd801 100644 --- a/man/plotPointProc-mcmcoutputpermfixhier-method.Rd +++ b/man/plotPointProc-mcmcoutputpermfixhier-method.Rd @@ -53,3 +53,4 @@ plotPointProc(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd b/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd index 802580d..b5b14ff 100644 --- a/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd +++ b/man/plotPointProc-mcmcoutputpermfixhierpost-method.Rd @@ -53,3 +53,4 @@ plotPointProc(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermfixpost-method.Rd b/man/plotPointProc-mcmcoutputpermfixpost-method.Rd index 95298f9..fb9e70a 100644 --- a/man/plotPointProc-mcmcoutputpermfixpost-method.Rd +++ b/man/plotPointProc-mcmcoutputpermfixpost-method.Rd @@ -55,3 +55,4 @@ plotPointProc(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpermhier-method.Rd b/man/plotPointProc-mcmcoutputpermhier-method.Rd index ade074c..23fdde3 100644 --- a/man/plotPointProc-mcmcoutputpermhier-method.Rd +++ b/man/plotPointProc-mcmcoutputpermhier-method.Rd @@ -50,3 +50,4 @@ plotPointProc(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-mcmcoutputpost-method.Rd b/man/plotPointProc-mcmcoutputpost-method.Rd index 879ddcb..98b982e 100644 --- a/man/plotPointProc-mcmcoutputpost-method.Rd +++ b/man/plotPointProc-mcmcoutputpost-method.Rd @@ -49,3 +49,4 @@ plotPointProc(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotPointProc-model-method.Rd b/man/plotPointProc-model-method.Rd index ee2d793..f5f1a54 100644 --- a/man/plotPointProc-model-method.Rd +++ b/man/plotPointProc-model-method.Rd @@ -31,3 +31,4 @@ plotPointProc(f_model) \seealso{ \code{model} } +\keyword{internal} diff --git a/man/plotPostDens-generic.Rd b/man/plotPostDens-generic.Rd index 9996e4c..9dd0fb0 100644 --- a/man/plotPostDens-generic.Rd +++ b/man/plotPostDens-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{plotPostDens} -\alias{plotPostDens} +\name{plotPostDens-generic} +\alias{plotPostDens-generic} \title{Plots the posterior density of sampled component parameters} \usage{ plotPostDens(x, dev = TRUE, ...) diff --git a/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd b/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd index 57b0568..13fad46 100644 --- a/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd +++ b/man/plotPostDens-mcmcoutputpermfixhierpost-method.Rd @@ -53,3 +53,4 @@ plotPostDens(f_outputperm) \item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values } } +\keyword{internal} diff --git a/man/plotPostDens-mcmcoutputpermfixpost-method.Rd b/man/plotPostDens-mcmcoutputpermfixpost-method.Rd index 56165e6..f65f76e 100644 --- a/man/plotPostDens-mcmcoutputpermfixpost-method.Rd +++ b/man/plotPostDens-mcmcoutputpermfixpost-method.Rd @@ -55,3 +55,4 @@ plotPostDens(f_outputperm) \item \code{\link[=plotPointProc]{plotPointProc()}} for plotting point processes for sampled values } } +\keyword{internal} diff --git a/man/plotSampRep-generic.Rd b/man/plotSampRep-generic.Rd index 9e886fe..d44f50b 100644 --- a/man/plotSampRep-generic.Rd +++ b/man/plotSampRep-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{plotSampRep} -\alias{plotSampRep} +\name{plotSampRep-generic} +\alias{plotSampRep-generic} \title{Plots sample representations of MCMC samples} \usage{ plotSampRep(x, dev = TRUE, ...) diff --git a/man/plotSampRep-mcmcoutputhier-method.Rd b/man/plotSampRep-mcmcoutputhier-method.Rd index dd4fbaa..099dc61 100644 --- a/man/plotSampRep-mcmcoutputhier-method.Rd +++ b/man/plotSampRep-mcmcoutputhier-method.Rd @@ -47,3 +47,4 @@ plotSampRep(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputhierpost-method.Rd b/man/plotSampRep-mcmcoutputhierpost-method.Rd index 7b00d7a..9f578b2 100644 --- a/man/plotSampRep-mcmcoutputhierpost-method.Rd +++ b/man/plotSampRep-mcmcoutputhierpost-method.Rd @@ -49,3 +49,4 @@ plotSampRep(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermfixhier-method.Rd b/man/plotSampRep-mcmcoutputpermfixhier-method.Rd index dfc4f8d..e4732a4 100644 --- a/man/plotSampRep-mcmcoutputpermfixhier-method.Rd +++ b/man/plotSampRep-mcmcoutputpermfixhier-method.Rd @@ -50,3 +50,4 @@ plotSampRep(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd b/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd index 777908b..6d20ab4 100644 --- a/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd +++ b/man/plotSampRep-mcmcoutputpermfixhierpost-method.Rd @@ -53,3 +53,4 @@ plotSampRep(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpermfixpost-method.Rd b/man/plotSampRep-mcmcoutputpermfixpost-method.Rd index 037af45..049a7ee 100644 --- a/man/plotSampRep-mcmcoutputpermfixpost-method.Rd +++ b/man/plotSampRep-mcmcoutputpermfixpost-method.Rd @@ -52,3 +52,4 @@ plotSampRep(f_outputperm) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotSampRep-mcmcoutputpost-method.Rd b/man/plotSampRep-mcmcoutputpost-method.Rd index 8532ab0..b76124f 100644 --- a/man/plotSampRep-mcmcoutputpost-method.Rd +++ b/man/plotSampRep-mcmcoutputpost-method.Rd @@ -49,3 +49,4 @@ plotSampRep(f_output) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting posterior densities for sampled values } } +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputhier-method.Rd b/man/plotTraces-mcmcoutputhier-method.Rd index b108364..2602ca7 100644 --- a/man/plotTraces-mcmcoutputhier-method.Rd +++ b/man/plotTraces-mcmcoutputhier-method.Rd @@ -58,3 +58,4 @@ plotTraces(f_output, lik = 0) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermfixhier-method.Rd b/man/plotTraces-mcmcoutputpermfixhier-method.Rd index 7be5d86..4d72d0f 100644 --- a/man/plotTraces-mcmcoutputpermfixhier-method.Rd +++ b/man/plotTraces-mcmcoutputpermfixhier-method.Rd @@ -61,3 +61,4 @@ plotTraces(f_outputperm, lik = 0) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd b/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd index 8b5de21..762678f 100644 --- a/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd +++ b/man/plotTraces-mcmcoutputpermfixhierpost-method.Rd @@ -63,3 +63,4 @@ plotTraces(f_outputperm, lik = 0) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpermfixpost-method.Rd b/man/plotTraces-mcmcoutputpermfixpost-method.Rd index 34b2a74..2e43bea 100644 --- a/man/plotTraces-mcmcoutputpermfixpost-method.Rd +++ b/man/plotTraces-mcmcoutputpermfixpost-method.Rd @@ -63,3 +63,4 @@ plotTraces(f_outputperm, lik = 0) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/plotTraces-mcmcoutputpost-method.Rd b/man/plotTraces-mcmcoutputpost-method.Rd index 8d2553b..8a505e9 100644 --- a/man/plotTraces-mcmcoutputpost-method.Rd +++ b/man/plotTraces-mcmcoutputpost-method.Rd @@ -60,3 +60,4 @@ plotTraces(f_output, lik = 0) \item \code{\link[=plotPostDens]{plotPostDens()}} for plotting the posterior density of component parameters } } +\keyword{internal} diff --git a/man/setBycolumn-set-fdata-method.Rd b/man/setBycolumn-set-fdata-method.Rd index 1d2c4d2..f6a21f5 100644 --- a/man/setBycolumn-set-fdata-method.Rd +++ b/man/setBycolumn-set-fdata-method.Rd @@ -29,3 +29,4 @@ setBycolumn(f_data) <- TRUE \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setExp-set-fdata-method.Rd b/man/setExp-set-fdata-method.Rd index b0ae160..6628ca6 100644 --- a/man/setExp-set-fdata-method.Rd +++ b/man/setExp-set-fdata-method.Rd @@ -29,3 +29,4 @@ setExp(f_data) <- matrix(rep(100, 100)) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setN-set-fdata-method.Rd b/man/setN-set-fdata-method.Rd index b4af8e9..81d81a7 100644 --- a/man/setN-set-fdata-method.Rd +++ b/man/setN-set-fdata-method.Rd @@ -27,3 +27,4 @@ setN(f_data) <- as.integer(100) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setName-set-fdata-method.Rd b/man/setName-set-fdata-method.Rd index 7fbc9ac..da67af6 100644 --- a/man/setName-set-fdata-method.Rd +++ b/man/setName-set-fdata-method.Rd @@ -29,3 +29,4 @@ setName(f_data) <- "poisson_data" \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setR-set-fdata-method.Rd b/man/setR-set-fdata-method.Rd index 1f5aab8..75372e4 100644 --- a/man/setR-set-fdata-method.Rd +++ b/man/setR-set-fdata-method.Rd @@ -27,3 +27,4 @@ setR(f_data) <- as.integer(2) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setS-set-fdata-method.Rd b/man/setS-set-fdata-method.Rd index 7165e0a..0b28cf5 100644 --- a/man/setS-set-fdata-method.Rd +++ b/man/setS-set-fdata-method.Rd @@ -29,3 +29,4 @@ setS(f_data) <- matrix(sample.int(4, 100, replace = TRUE)) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setSim-set-fdata-method.Rd b/man/setSim-set-fdata-method.Rd index eeecbfc..4082715 100644 --- a/man/setSim-set-fdata-method.Rd +++ b/man/setSim-set-fdata-method.Rd @@ -29,3 +29,4 @@ setSim(f_data) <- TRUE \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setT-set-fdata-method.Rd b/man/setT-set-fdata-method.Rd index 9116b26..eff4199 100644 --- a/man/setT-set-fdata-method.Rd +++ b/man/setT-set-fdata-method.Rd @@ -29,3 +29,4 @@ setT(f_data) <- matrix(rep(100, 100)) \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setType-set-fdata-method.Rd b/man/setType-set-fdata-method.Rd index 646a6a2..5a11a8c 100644 --- a/man/setType-set-fdata-method.Rd +++ b/man/setType-set-fdata-method.Rd @@ -29,3 +29,4 @@ setType(f_data) <- "discrete" \seealso{ \link{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/setY-set-fdata-method.Rd b/man/setY-set-fdata-method.Rd index b17a31a..46f1a82 100644 --- a/man/setY-set-fdata-method.Rd +++ b/man/setY-set-fdata-method.Rd @@ -27,3 +27,4 @@ setY(f_data) <- rpois(100, 312) \seealso{ \linkS4class{fdata} for all slots of the \code{fdata} class } +\keyword{internal} diff --git a/man/subseq-generic.Rd b/man/subseq-generic.Rd index d1b7e7a..669aa3a 100644 --- a/man/subseq-generic.Rd +++ b/man/subseq-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{subseq} -\alias{subseq} +\name{subseq-generic} +\alias{subseq-generic} \title{Generates a sub-chain from MCMC samples} \usage{ subseq(object, index) diff --git a/man/swapElements-generic.Rd b/man/swapElements-generic.Rd index 5e0df32..a769b99 100644 --- a/man/swapElements-generic.Rd +++ b/man/swapElements-generic.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \docType{methods} -\name{swapElements} -\alias{swapElements} +\name{swapElements-generic} +\alias{swapElements-generic} \title{Swaps elements in the MCMC sample arrays} \usage{ swapElements(object, index) From de8d05fbcaf258cfb354f5bae71e8c758341184c Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Mon, 8 Nov 2021 09:58:24 +0100 Subject: [PATCH 23/24] Added .registration=TRUE to try out what it does. --- NAMESPACE | 2 +- R/AllGenerics.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 75a7bfa..415f850 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -382,4 +382,4 @@ importFrom(stats,runif) importFrom(stats,sd) importFrom(stats,var) importFrom(utils,tail) -useDynLib(finmix) +useDynLib(finmix, .registration=TRUE) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index cfc4030..f812e40 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -16,7 +16,7 @@ # along with Rcpp. If not, see . ## Load the dynamic library -#' @useDynLib finmix +#' @useDynLib finmix, .registration=TRUE #' @importFrom Rcpp sourceCpp NULL From 030d4c51ec0fd3e0d0cfc54b415d1009118e2bd0 Mon Sep 17 00:00:00 2001 From: Simon Zehnder Date: Thu, 11 Nov 2021 12:06:10 +0100 Subject: [PATCH 24/24] Changed inheritance to non-virtual in ParStudentInd.h --- NAMESPACE | 2 +- R/AllGenerics.R | 2 +- src/IND.h | 2 +- src/ParStudentInd.cpp | 1 + src/ParStudentInd.h | 4 ++-- 5 files changed, 6 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 415f850..75a7bfa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -382,4 +382,4 @@ importFrom(stats,runif) importFrom(stats,sd) importFrom(stats,var) importFrom(utils,tail) -useDynLib(finmix, .registration=TRUE) +useDynLib(finmix) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index f812e40..cfc4030 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -16,7 +16,7 @@ # along with Rcpp. If not, see . ## Load the dynamic library -#' @useDynLib finmix, .registration=TRUE +#' @useDynLib finmix #' @importFrom Rcpp sourceCpp NULL diff --git a/src/IND.h b/src/IND.h index 3749a97..80523c8 100644 --- a/src/IND.h +++ b/src/IND.h @@ -43,7 +43,7 @@ * neded to perform the permutations for random permutation * Gibbs sampling. * @see FIX, HIER, POST, ADAPTER, BASE - * @author Lars SImon Zehnder + * @author Lars Simon Zehnder * ------------------------------------------------------------------ */ template diff --git a/src/ParStudentInd.cpp b/src/ParStudentInd.cpp index d944440..e03664f 100644 --- a/src/ParStudentInd.cpp +++ b/src/ParStudentInd.cpp @@ -15,5 +15,6 @@ ParStudentInd::ParStudentInd (const bool& STARTPAR, inline void ParStudentInd::update(const PriorStudentInd& hyperPar) { + // updating the parameters is performed in PriorStudentInd.update() weight = rdirichlet(hyperPar.weightPost); } diff --git a/src/ParStudentInd.h b/src/ParStudentInd.h index c7efd45..15c20b9 100644 --- a/src/ParStudentInd.h +++ b/src/ParStudentInd.h @@ -18,7 +18,7 @@ #include "ParStudentFix.h" #include "PriorStudentInd.h" -class ParStudentInd : virtual public ParStudentFix { +class ParStudentInd : public ParStudentFix { public: arma::rowvec weight; @@ -27,7 +27,7 @@ ParStudentInd (const bool&, virtual ~ParStudentInd () { } -virtual void update(const PriorStudentInd&); +void update(const PriorStudentInd&); }; #endif /* __FINMIX_PARSTUDENTIND_H__ */