// Prevents agglomeration in a single cluster.
void HDCluster::determineSubStability(const unsigned int& minPts, Progress& p) {
#ifdef DEBUG
if (sz < minPts && parent != nullptr) throw Rcpp::exception("Condense failed.");
#endif
stability = sum_lambda_p - (lambda_birth * fallenPoints.size());
if (left != nullptr) {
const double childStabilities = left->determineStability(minPts, p) +
right->determineStability(minPts, p);
if (childStabilities > stability) stability = childStabilities;
} else {
p.increment(sz);
}
}
void thread(Progress& progress, const uword& batchSize) {
coordinatetype * const holder = new coordinatetype[D * 2];
while (rho >= 0) {
const double localRho = rho;
innerLoop(localRho, batchSize, holder);
#ifdef _OPENMP
#pragma omp atomic
#endif
rho -= (rhoIncrement * batchSize);
if (!progress.increment()) break;
}
delete[] holder;
}
void HDCluster::extract( int* clusters,
double* lambdas,
int& selectedClusterCnt,
int currentSelectedCluster,
Progress& p) const {
if (selected) currentSelectedCluster = selectedClusterCnt++;
std::for_each(fallenPoints.begin(), fallenPoints.end(),
[&clusters, &lambdas, ¤tSelectedCluster](const std::pair<arma::uword, double>& it) {
clusters[it.first] = (currentSelectedCluster == 0) ? NA_INTEGER : currentSelectedCluster;
lambdas[it.first] = it.second;
});
if (left != nullptr) {
left->extract(clusters, lambdas, selectedClusterCnt, currentSelectedCluster, p);
right->extract(clusters, lambdas, selectedClusterCnt, currentSelectedCluster, p);
} else {
p.increment(sz);
}
}
double HDCluster::determineStability(const unsigned int& minPts, Progress& p) {
#ifdef DEBUG
if (sz < minPts && parent != nullptr) throw Rcpp::exception("Condense failed.");
#endif
stability = sum_lambda_p - (lambda_birth * fallenPoints.size());
if (left == nullptr) { // leaf node
if (sz >= minPts) selected = true; // Otherwise, this is a parent singleton smaller than minPts.
p.increment();
} else {
const double childStabilities = left->determineStability(minPts, p) +
right->determineStability(minPts, p);
stability += lambda_death * (left->sz + right->sz);
if (stability > childStabilities) {
selected = true;
left->deselect();
right->deselect();
} else stability = childStabilities;
}
return stability;
}
/*
* Converts the specified registry file. The specified file is
* removed if the conversion is successful. If conversion_count
* is not NULL, the total number of Articles converted will be
* passed back.
*/
int
wsreg_convert_registry(const char *filename, int *conversion_count,
Progress_function progress_callback)
{
File_util *futil = _wsreg_fileutil_initialize();
if (initialized == WSREG_NOT_INITIALIZED) {
return (WSREG_NOT_INITIALIZED);
}
if (!futil->exists(filename)) {
/*
* Bad filename.
*/
return (WSREG_FILE_NOT_FOUND);
}
if (futil->can_read(filename) && futil->can_write(filename)) {
/*
* The registry file can be read and removed.
*/
if (wsreg_can_access_registry(O_RDWR)) {
/*
* The conversion permissions are appropriate.
* Perform the conversion.
*/
int result;
int article_count = 0;
Progress *progress =
_wsreg_progress_create(
(Progress_callback)*progress_callback);
int count = 0;
Unz_article_input_stream *ain = NULL;
Conversion *c = NULL;
/*
* The first progress section represents the
* unzipping of the data file.
*/
progress->set_section_bounds(progress, 5, 1);
ain = _wsreg_uzais_open(filename, &result);
progress->finish_section(progress);
if (result != WSREG_SUCCESS) {
/*
* The open failed. Clean up and
* return the error code.
*/
if (ain != NULL) {
ain->close(ain);
}
progress->free(progress);
return (result);
}
c = _wsreg_conversion_create(progress);
/*
* The second progress section represents
* the reading of articles.
*/
article_count = ain->get_article_count(ain);
progress->set_section_bounds(progress, 8,
article_count);
while (ain->has_more_articles(ain)) {
Article *a = ain->get_next_article(ain);
if (a != NULL) {
c->add_article(c, a);
}
progress->increment(progress);
}
progress->finish_section(progress);
ain->close(ain);
/*
* The third progress section represents
* the conversion and registration of the
* resulting components.
*/
progress->set_section_bounds(progress, 100,
article_count);
count = c->register_components(c, NULL, FALSE);
progress->finish_section(progress);
/*
* Pass the count back to the caller.
*/
if (conversion_count != NULL) {
*conversion_count = count;
}
/*
* Remove the old registry file.
*/
futil->remove(filename);
/*
* Cleanup objects.
*/
c->free(c);
progress->free(progress);
return (WSREG_SUCCESS);
} else {
/*
* No permission to modify the registry.
*/
return (WSREG_NO_REG_ACCESS);
}
} else {
/*
* No permission to read and delete the specified file.
*/
return (WSREG_NO_FILE_ACCESS);
}
}
SEXP clmm(SEXP yR, SEXP XR, SEXP par_XR, SEXP list_of_design_matricesR, SEXP par_design_matricesR, SEXP par_mcmcR, SEXP verboseR, SEXP threadsR, SEXP use_BLAS){
int threads = as<int>(threadsR);
int verbose = as<int>(verboseR);
bool BLAS = Rcpp::as<bool>(use_BLAS);
Rcpp::List list_of_phenotypes(yR);
Rcpp::List list_of_par_design_matrices(par_design_matricesR);
Rcpp::List list_of_par_mcmc(par_mcmcR);
int p = list_of_phenotypes.size();
//omp_set_dynamic(0);
omp_set_num_threads(threads);
Eigen::setNbThreads(1);
Eigen::initParallel();
int max = p / threads;
if(max < 1) max = 1;
//printer prog(max);
Rcpp::List summary_out;
mcmc_st vec_mcmc_st;
MCMC_abstract * single_mcmc;
Rcpp::List Summary;
bool multiple_phenos = false;
// CV
if(p > 1) {
multiple_phenos = true;
// fill the container with mcmc_objects
for(int i=0;i<p;i++) {
vec_mcmc_st.push_back(MCMC<base_methods_st>(list_of_phenotypes[i], XR, par_XR, list_of_design_matricesR ,list_of_par_design_matrices[i], list_of_par_mcmc[i],i));
}
for(mcmc_st::iterator it = vec_mcmc_st.begin(); it != vec_mcmc_st.end(); it++) {
it->initialize();
}
// if ((p > 1) & verbose) { prog.initialize(); }
// this looks easy - the work was to allow this step to be parallelized
// verbose
Progress * prog = new Progress(vec_mcmc_st.size(), verbose);
#pragma omp parallel for
for(unsigned int i=0;i<vec_mcmc_st.size();i++){
if ( ! Progress::check_abort() ) {
vec_mcmc_st.at(i).gibbs();
prog->increment();
}
}
for(mcmc_st::iterator it = vec_mcmc_st.begin(); it != vec_mcmc_st.end(); it++) {
it->summary();
Summary[it->get_name()] = it->get_summary();
}
delete prog;
summary_out = Summary;
} else {
// Dont know whether it is possible to control threads for OMP and BLAS seperately
// Single Model Run
if (threads==1 & !BLAS) {
single_mcmc = new MCMC<base_methods_st>(list_of_phenotypes[0], XR, par_XR, list_of_design_matricesR,
list_of_par_design_matrices[0], list_of_par_mcmc[0],0);
}
if (threads>1 & !BLAS) {
single_mcmc = new MCMC<base_methods_mp>(list_of_phenotypes[0], XR, par_XR, list_of_design_matricesR,
list_of_par_design_matrices[0], list_of_par_mcmc[0],0);
}
if (BLAS) {
single_mcmc = new MCMC<base_methods_BLAS>(list_of_phenotypes[0], XR, par_XR, list_of_design_matricesR,
list_of_par_design_matrices[0], list_of_par_mcmc[0],0);
}
single_mcmc->initialize();
Progress * prog = new Progress(single_mcmc->get_niter() , single_mcmc->get_verbose());
// single_mcmc->gibbs(prog);
single_mcmc->gibbs(prog);
single_mcmc->summary();
Summary[single_mcmc->get_name()] = single_mcmc->get_summary();
delete single_mcmc;
delete prog;
summary_out = Summary;
}
////////////
return summary_out;
}