diff --git a/R/RcppExports.R b/R/RcppExports.R index da90effa..bc7f57bb 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,6 +1,10 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 +loglike_hmm_cpp <- function(m, geno, ph1, ph2, rf, verbose) { + .Call('_mappoly_loglike_hmm_cpp', PACKAGE = 'mappoly', m, geno, ph1, ph2, rf, verbose) +} + .vcf_get_probabilities <- function(mat, pl_pos) { .Call('_mappoly_vcf_get_probabilities', PACKAGE = 'mappoly', mat, pl_pos) } diff --git a/R/loglike_hmm.R b/R/loglike_hmm.R index 7806115a..40658608 100644 --- a/R/loglike_hmm.R +++ b/R/loglike_hmm.R @@ -43,14 +43,12 @@ loglike_hmm <- function(input.map, input.data = NULL, verbose = FALSE) D[j, D[j, ] == input.map$info$ploidy + 1] <- dp[j] + dq[j] + 1 + as.numeric(dp[j] == 0 || dq[j] == 0) for(i in 1:length(input.map$maps)){ rf.temp <- input.map$maps[[i]]$seq.rf - res.temp <- .Call("loglike_hmm", - input.map$info$ploidy, - t(D), - lapply(input.map$maps[[i]]$seq.ph$P, function(x) x-1), - lapply(input.map$maps[[i]]$seq.ph$Q, function(x) x-1), - rf.temp, - verbose, - PACKAGE = "mappoly") + res.temp <- loglike_hmm_cpp(input.map$info$ploidy, + t(D), + lapply(input.map$maps[[i]]$seq.ph$P, function(x) x-1), + lapply(input.map$maps[[i]]$seq.ph$Q, function(x) x-1), + rf.temp, + verbose) input.map$maps[[i]]$loglike <- res.temp[[1]] } return(input.map) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index f10427fb..e021adc0 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -10,6 +10,22 @@ Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif +// loglike_hmm_cpp +List loglike_hmm_cpp(int m, NumericMatrix geno, List ph1, List ph2, NumericVector rf, int verbose); +RcppExport SEXP _mappoly_loglike_hmm_cpp(SEXP mSEXP, SEXP genoSEXP, SEXP ph1SEXP, SEXP ph2SEXP, SEXP rfSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type m(mSEXP); + Rcpp::traits::input_parameter< NumericMatrix >::type geno(genoSEXP); + Rcpp::traits::input_parameter< List >::type ph1(ph1SEXP); + Rcpp::traits::input_parameter< List >::type ph2(ph2SEXP); + Rcpp::traits::input_parameter< NumericVector >::type rf(rfSEXP); + Rcpp::traits::input_parameter< int >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(loglike_hmm_cpp(m, geno, ph1, ph2, rf, verbose)); + return rcpp_result_gen; +END_RCPP +} // vcf_get_probabilities Rcpp::List vcf_get_probabilities(Rcpp::StringMatrix& mat, int pl_pos); RcppExport SEXP _mappoly_vcf_get_probabilities(SEXP matSEXP, SEXP pl_posSEXP) { @@ -70,13 +86,13 @@ RcppExport SEXP est_hmm_map_single_parent(void *, void *, void *, void *, void * RcppExport SEXP est_map_hmm(void *, void *, void *, void *, void *, void *, void *, void *); RcppExport SEXP est_map_hmm_highprec(void *, void *, void *, void *, void *, void *, void *, void *); RcppExport SEXP get_counts_single_parent_cpp(void *, void *, void *, void *, void *, void *); -RcppExport SEXP loglike_hmm(void *, void *, void *, void *, void *, void *); RcppExport SEXP pairwise_rf_estimation_disc(void *, void *, void *, void *, void *, void *, void *); RcppExport SEXP pairwise_rf_estimation_disc_rcpp(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); RcppExport SEXP pairwise_rf_estimation_prob(void *, void *, void *, void *, void *, void *, void *, void *); RcppExport SEXP poly_hmm_est_CPP(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); static const R_CallMethodDef CallEntries[] = { + {"_mappoly_loglike_hmm_cpp", (DL_FUNC) &_mappoly_loglike_hmm_cpp, 6}, {"_mappoly_vcf_get_probabilities", (DL_FUNC) &_mappoly_vcf_get_probabilities, 2}, {"_mappoly_vcf_transform_dosage", (DL_FUNC) &_mappoly_vcf_transform_dosage, 2}, {"_mappoly_vcf_get_ploidy", (DL_FUNC) &_mappoly_vcf_get_ploidy, 2}, @@ -92,7 +108,6 @@ static const R_CallMethodDef CallEntries[] = { {"est_map_hmm", (DL_FUNC) &est_map_hmm, 8}, {"est_map_hmm_highprec", (DL_FUNC) &est_map_hmm_highprec, 8}, {"get_counts_single_parent_cpp", (DL_FUNC) &get_counts_single_parent_cpp, 6}, - {"loglike_hmm", (DL_FUNC) &loglike_hmm, 6}, {"pairwise_rf_estimation_disc", (DL_FUNC) &pairwise_rf_estimation_disc, 7}, {"pairwise_rf_estimation_disc_rcpp", (DL_FUNC) &pairwise_rf_estimation_disc_rcpp, 12}, {"pairwise_rf_estimation_prob", (DL_FUNC) &pairwise_rf_estimation_prob, 8}, diff --git a/src/calc_loglike_given_map.cpp b/src/calc_loglike_given_map.cpp index 18a914e6..0c00d584 100644 --- a/src/calc_loglike_given_map.cpp +++ b/src/calc_loglike_given_map.cpp @@ -49,21 +49,14 @@ using namespace std; using namespace Rcpp; -RcppExport SEXP loglike_hmm(SEXP ploidyR, - SEXP genoR, - SEXP phPR, - SEXP phQR, - SEXP rfR, - SEXP verboseR) +// [[Rcpp::export]] +List loglike_hmm_cpp(int m, + NumericMatrix geno, + List ph1, + List ph2, + NumericVector rf, + int verbose) { - //*convert input to C++ types - int m = Rcpp::as(ploidyR); - Rcpp::NumericMatrix geno(genoR); //(n.ind x n.col) - Rcpp::List ph1(phPR); - Rcpp::List ph2(phQR); - Rcpp::NumericVector rf(rfR); - int verbose = Rcpp::as(verboseR); - //*Initializing some variables int g = nChoosek(m, m/2); int n_mar = geno.ncol(); // markers are disposed in columns diff --git a/src/calc_loglike_given_map.h b/src/calc_loglike_given_map.h index 452533c6..3ae6effc 100644 --- a/src/calc_loglike_given_map.h +++ b/src/calc_loglike_given_map.h @@ -28,9 +28,12 @@ #include #include "combinatorial.h" -RcppExport SEXP loglike_hmm(SEXP ploidyR, - SEXP genoR, - SEXP phPR, - SEXP phQR, - SEXP rfR, - SEXP verboseR); \ No newline at end of file +using namespace std; +using namespace Rcpp; + +List loglike_hmm_cpp(int m, + NumericMatrix geno, + List ph1, + List ph2, + NumericVector rf, + int verbose); \ No newline at end of file