SEXP removeHets(SEXP founders_sexp, SEXP finals_sexp, SEXP hetData_sexp)
{
BEGIN_RCPP
Rcpp::IntegerMatrix founders = Rcpp::as<Rcpp::IntegerMatrix>(founders_sexp);
Rcpp::IntegerMatrix finals = Rcpp::as<Rcpp::IntegerMatrix>(finals_sexp);
Rcpp::S4 hetData = Rcpp::as<Rcpp::S4>(hetData_sexp);
Rcpp::List hetDataList = Rcpp::as<Rcpp::List>(hetData_sexp);
int nMarkers = founders.ncol(), nFounders = founders.nrow(), nFinals = finals.nrow();
recodeDataStruct args;
Rcpp::List recodedHetData(nMarkers);
Rcpp::IntegerMatrix recodedFounders(founders.nrow(), founders.ncol()), recodedFinals(finals.nrow(), finals.ncol());
args.founders = founders;
args.finals = finals;
args.hetData = hetData;
args.recodedHetData = recodedHetData;
args.recodedFounders = recodedFounders;
args.recodedFinals = recodedFinals;
recodeFoundersFinalsHets(args);
for(int i = 0; i < nMarkers; i++)
{
int maxAllele = 0;
for(int j = 0; j < nFounders; j++) maxAllele = std::max(maxAllele, recodedFounders(j, i));
//Overwrite the recoded finals data
for(int j = 0; j < nFinals; j++)
{
if(recodedFinals(j, i) > maxAllele) recodedFinals(j, i) = NA_INTEGER;
else recodedFinals(j, i) = finals(j, i);
}
//overwrite the recoded het data
Rcpp::IntegerMatrix newHetEntry(maxAllele+1, 3);
Rcpp::IntegerMatrix oldHetEntry = Rcpp::as<Rcpp::IntegerMatrix>(hetDataList(i));
int counter = 0;
for(int j = 0; j < oldHetEntry.nrow(); j++)
{
if(oldHetEntry(j, 0) == oldHetEntry(j, 1))
{
newHetEntry(counter, 0) = newHetEntry(counter, 1) = newHetEntry(counter, 2) = oldHetEntry(j, 1);
counter++;
}
}
recodedHetData(i) = newHetEntry;
}
Rcpp::rownames(recodedFinals) = Rcpp::rownames(finals);
Rcpp::colnames(recodedFinals) = Rcpp::colnames(finals);
return Rcpp::List::create(Rcpp::Named("finals") = recodedFinals, Rcpp::Named("hetData") = recodedHetData);
END_RCPP
}
// [[Rcpp::export]]
Rcpp::IntegerMatrix quantileNorm(Rcpp::IntegerMatrix mat, Rcpp::IntegerVector ref, int nthreads=1, int seed=13){
if (mat.nrow() != ref.length()) Rcpp::stop("incompatible arrays...");
if (!std::is_sorted(ref.begin(), ref.end())) Rcpp::stop("ref must be sorted");
int ncol = mat.ncol();
int nrow = mat.nrow();
//allocate new matrix
Rcpp::IntegerMatrix res(nrow, ncol);
Mat<int> oldmat = asMat(mat);
Mat<int> newmat = asMat(res);
Vec<int> ref2 = asVec(ref);
//allocate a seed for each column
std::seed_seq sseq{seed};
std::vector<std::uint32_t> seeds(ncol);
sseq.generate(seeds.begin(), seeds.end());
#pragma omp parallel num_threads(nthreads)
{
std::vector<std::pair<int, int> > storage(nrow);//pairs <value, index>
#pragma omp for
for (int col = 0; col < ncol; ++col){
std::mt19937 gen(seeds[col]);
qtlnorm(oldmat.getCol(col), ref2, newmat.getCol(col), storage, gen);
}
}
res.attr("dimnames") = mat.attr("dimnames");
return res;
}
static Rcpp::NumericMatrix x_tilde(Rcpp::NumericMatrix X,
Rcpp::IntegerVector nk,
Rcpp::IntegerMatrix groups,
Rcpp::NumericVector d_cur,
Rcpp::NumericMatrix eta_cur)
{
int K = nk.size();
int n_tot = X.nrow();
int p = X.ncol();
int L = groups.ncol();
Rcpp::NumericMatrix result(n_tot, p * K);
int idx = 0;
for (int k = 0; k < K; k++) {
int n = nk[k];
for (int j = 0; j < p; j++) {
//calculate sum for column j
double sum = 0.0;
for (int l = 0; l < L; l++) {
if (elem(groups, j, l)) {
sum += d_cur[l] * elem(eta_cur, l, k);
}
}
//multiply column j in submatrix k of X with sum
for (int i = 0; i < n; i++) {
elem(result, idx + i, p * k + j) = elem(X, idx + i, j) * sum;
}
}
idx += n;
}
return result;
}
static Rcpp::NumericMatrix next_beta(Rcpp::IntegerVector nk,
Rcpp::IntegerMatrix groups,
Rcpp::NumericMatrix alpha_new,
Rcpp::NumericVector d_new,
Rcpp::NumericMatrix eta_new)
{
int K = nk.size();
int p = groups.nrow();
int L = groups.ncol();
Rcpp::NumericMatrix result(p, K);
for (int k = 0; k < K; k++) {
for (int j = 0; j < p; j++) {
double sum = 0.0;
for (int l = 0; l < L; l++) {
if (elem(groups, j, l)) {
sum += d_new[l] * elem(eta_new, l, k);
}
}
elem(result, j, k) = elem(alpha_new, j, k) * sum;
}
}
return result;
}
static Rcpp::NumericMatrix x_tilde_3(Rcpp::NumericMatrix X,
Rcpp::IntegerVector nk,
Rcpp::IntegerMatrix groups,
Rcpp::NumericMatrix alpha_new,
Rcpp::NumericVector d_new)
{
int K = nk.size();
int n_tot = X.nrow();
int p = X.ncol();
int L = groups.ncol();
Rcpp::NumericMatrix result(n_tot, L * K);
int idx = 0;
for (int k = 0; k < K; k++) {
int n = nk[k];
for (int l = 0; l < L; l++) {
for (int i = 0; i < n; i++) {
double sum = 0.0;
for (int j = 0; j < p; j++) {
if (elem(groups, j, l)) {
sum += elem(X, idx + i, j) * elem(alpha_new, j, k);
}
}
elem(result, idx + i, L * k + l) = d_new[l] * sum;
}
}
idx += n;
}
return result;
}
static Rcpp::NumericMatrix x_tilde_2(Rcpp::NumericMatrix X,
Rcpp::IntegerVector nk,
Rcpp::IntegerMatrix groups,
Rcpp::NumericMatrix alpha_new,
Rcpp::NumericMatrix eta_cur)
{
int K = nk.size();
int n_tot = X.nrow();
int p = X.ncol();
int L = groups.ncol();
Rcpp::NumericMatrix result(n_tot, L);
for (int l = 0; l < L; l++) {
int k = -1;
int n = 0;
for (int i = 0; i < n_tot; i++) {
if (i == n){
k +=1;
n += nk[k];
}
double sum = 0.0;
for (int j = 0; j < p; j++) {
if (elem(groups, j, l)) {
sum += elem(X, i, j) * elem(alpha_new, j, k);
}
}
elem(result, i, l) = elem(eta_cur, l, k) * sum;
}
}
return result;
}
SEXP exact(SEXP matrix_sexp, SEXP progress_sexp)
{
BEGIN_RCPP
mpz_class sum = 0;
mpz_class rowsumprod, rowsum;
Rcpp::IntegerMatrix matrix = Rcpp::as<Rcpp::IntegerMatrix>(matrix_sexp);
if(matrix.ncol() != matrix.nrow())
{
throw std::runtime_error("Matrix must be square");
}
bool progress = Rcpp::as<bool>(progress_sexp);
Rcpp::Function txtProgressBar("txtProgressBar"), setTxtProgressBar("setTxtProgressBar"), close("close");
Rcpp::RObject barHandle;
if(progress)
{
barHandle = txtProgressBar(Rcpp::Named("style") = 1, Rcpp::Named("min") = 0, Rcpp::Named("max") = 1000, Rcpp::Named("initial") = 0);
}
int dimension = matrix.nrow();
unsigned long long C = (1ULL << dimension);
for (unsigned long long k = 1ULL; k < C; k++)
{
rowsumprod = 1;
int setBits = 0;
for (int m = 0; m < dimension; m++)
{
if((k & (1ULL << m)) != 0ULL) setBits++;
}
// loop columns of submatrix #k
for (int m = 0; m < dimension; m++)
{
rowsum = 0;
// loop rows and compute rowsum
for (int p = 0; p < dimension; p++)
{
if((k & (1ULL << p)) != 0ULL)
{
rowsum += matrix(m, p);
}
}
// update product of rowsums
rowsumprod *= rowsum;
if (rowsumprod == 0) break;
}
if(setBits % 2 == 0) sum += rowsumprod;
else sum -= rowsumprod;
if(progress && k % 1000ULL == 0)
{
setTxtProgressBar.topLevelExec(barHandle, (int)((double)k*1000.0 / (double)C));
}
}
if(progress)
{
close(barHandle);
}
if(dimension % 2 != 0) sum *= -1;
return Rcpp::wrap(sum.str());
END_RCPP
}
void CEnv::SetData(Rcpp::IntegerMatrix x_, Rcpp::IntegerMatrix mcz_) {
int J = x_.nrow();
int n = x_.ncol();
int nZeroMC = mcz_.ncol();
if (mcz_.nrow() != J) { // no mcz
nZeroMC = 0;
}
intvec x = Rcpp::as<intvec>(x_);
intvec mcz = Rcpp::as<intvec>(mcz_);
Rcpp::List something(x_.attr("levels"));
intvec levels(something.size());
for (unsigned int i = 0; i < levels.size(); i++) {
SEXP exp = something[i];
Rcpp::CharacterVector v(exp);
levels[i] = v.size();
//Rprintf( "%d\n", levels[i]) ;
}
SetData(x, J, n, mcz, nZeroMC, levels);
}
// [[Rcpp::export]]
Rcpp::IntegerVector colSummary(Rcpp::IntegerMatrix mat, std::string type, int nthreads=1){
//allocate final array
Rcpp::IntegerVector ref(mat.ncol());
Mat<int> smat = asMat(mat);
Vec<int> sref = asVec(ref);
//compute function 'type' for each column
if (type == "median"){ colSummary_loop(smat, sref, median, nthreads);
} else if (type == "mean"){ colSummary_loop(smat, sref, mean, nthreads);
} else if (type == "min"){ colSummary_loop(smat, sref, min, nthreads);
} else Rcpp::stop("invalid type");
return ref;
}
unsigned int GetTag(const Rcpp::IntegerMatrix& board, const int i, const int j)
{
// static constants
const int nrow = board.nrow();
const int ncol = board.ncol();
// offset (assumes odd) -- integer divide intentional
static const int offset = (sub_board_width/2);
// data structure to hold the subboard's bits
std::bitset<sub_board_width*sub_board_width> bits;
unsigned int bit_index = (sub_board_width*sub_board_width)-1;
const int k_start = i - offset;
const int k_end = i + offset;
const int l_start = j - offset;
const int l_end = j + offset;
// fill the bitset
for (int k = k_start; k <= k_end; k++)
{
//std::cout << "k = " << k << std::endl;
for (int l = l_start; l <= l_end; l++)
{
// check row boundaries
if (k < 0 or k > (nrow-1))
{
bits.set(bit_index, false);
}
// check col boundaries
else if (l < 0 or l > (ncol-1))
{
bits.set(bit_index, false);
}
else
{
bits.set(bit_index, static_cast<bool>(board(k,l)));
}
//std::cout << "\nbits(" << bit_index << ") = " << bits[bit_index] << std::endl;
bit_index--;
}
}
return static_cast<unsigned int>(bits.to_ulong());
}
// [[Rcpp::export]]
Rcpp::IntegerVector getRef(Rcpp::IntegerMatrix mat, std::string type, int nthreads=1){
//allocate another matrix with transpose dimensions as mat
int ncol = mat.ncol();
int nrow = mat.nrow();
if (ncol*nrow == 0) Rcpp::stop("empty input is invalid");
Rcpp::IntegerMatrix mem_smat(ncol, nrow);
Mat<int> smat = asMat(mem_smat);
Mat<int> omat = asMat(mat);
//sort every column
#pragma omp parallel for num_threads(nthreads)
for (int col = 0; col < ncol; ++col){
Vec<int> ovec = omat.getCol(col);
MatRow<int> svec = smat.getRow(col);
sortCounts(ovec, svec);
}
return colSummary(mem_smat, type, nthreads);
}
// [[Rcpp::export]]
Rcpp::NumericMatrix CramersV_DF(Rcpp::IntegerMatrix dm, bool Bias_Cor) {
int iCol = dm.ncol();
int i=0,j=0;
Rcpp::NumericMatrix ResCV(iCol,iCol);
for (i=0;i<iCol;i++){
for (j=i;j<iCol;j++){
if(i==j) {ResCV(i,j)=1;}
else {
ResCV(i,j) = CramersV_C((IntegerVector)dm(_,i),(IntegerVector)dm(_,j),(bool)Bias_Cor);
ResCV(j,i) = ResCV(i,j);
}
}
}
Rcpp::List dimnms = Rcpp::List::create(VECTOR_ELT(dm.attr("dimnames"), 1),
VECTOR_ELT(dm.attr("dimnames"), 1));
ResCV.attr("dimnames")=dimnms;
return ResCV;
}
/* This function specifically checks whether the observed data is consistent with the *pedigree*. It assumes that every observed value in the finals is already valid - That is, every observed value contained in the finals is also listed as a possibility in the hetData object
*/
void estimateRFCheckFunnels(Rcpp::IntegerMatrix finals, Rcpp::IntegerMatrix founders, Rcpp::List hetData, Rcpp::S4 pedigree, std::vector<int>& intercrossingGenerations, std::vector<std::string>& warnings, std::vector<std::string>& errors, std::vector<funnelType>& allFunnels, std::vector<funnelType>& lineFunnels)
{
Rcpp::CharacterVector pedigreeLineNames = Rcpp::as<Rcpp::CharacterVector>(pedigree.slot("lineNames"));
//We make a copy of the pedigree line names and sort it (otherwise the std::find relating to pedigreeLineNames is prohibitive)
std::vector<pedigreeLineStruct> sortedLineNames;
sortPedigreeLineNames(pedigreeLineNames, sortedLineNames);
Rcpp::IntegerVector mother = Rcpp::as<Rcpp::IntegerVector>(pedigree.slot("mother"));
Rcpp::IntegerVector father = Rcpp::as<Rcpp::IntegerVector>(pedigree.slot("father"));
bool warnImproperFunnels = Rcpp::as<bool>(pedigree.slot("warnImproperFunnels"));
Rcpp::CharacterVector finalNames = Rcpp::as<Rcpp::CharacterVector>(Rcpp::as<Rcpp::List>(finals.attr("dimnames"))[0]);
Rcpp::CharacterVector markerNames = Rcpp::as<Rcpp::CharacterVector>(Rcpp::as<Rcpp::List>(finals.attr("dimnames"))[1]);
int nFinals = finals.nrow(), nFounders = founders.nrow(), nMarkers = finals.ncol();
if(nFounders != 2 && nFounders != 4 && nFounders != 8 && nFounders != 16)
{
throw std::runtime_error("Number of founders must be 2, 4, 8, or 16");
}
xMajorMatrix<int> foundersToMarkerAlleles(nFounders, nFounders, nMarkers, -1);
for(int markerCounter = 0; markerCounter < nMarkers; markerCounter++)
{
Rcpp::IntegerMatrix currentMarkerHetData = hetData(markerCounter);
for(int founderCounter1 = 0; founderCounter1 < nFounders; founderCounter1++)
{
for(int founderCounter2 = 0; founderCounter2 < nFounders; founderCounter2++)
{
int markerAllele1 = founders(founderCounter1, markerCounter);
int markerAllele2 = founders(founderCounter2, markerCounter);
for(int hetDataRowCounter = 0; hetDataRowCounter < currentMarkerHetData.nrow(); hetDataRowCounter++)
{
if(markerAllele1 == currentMarkerHetData(hetDataRowCounter, 0) && markerAllele2 == currentMarkerHetData(hetDataRowCounter, 1))
{
foundersToMarkerAlleles(founderCounter1, founderCounter2, markerCounter) = currentMarkerHetData(hetDataRowCounter, 2);
}
}
}
}
}
std::vector<long> individualsToCheckFunnels;
for(long finalCounter = 0; finalCounter < nFinals; finalCounter++)
{
individualsToCheckFunnels.clear();
std::string currentLineName = Rcpp::as<std::string>(finalNames(finalCounter));
std::vector<pedigreeLineStruct>::iterator findLineName = std::lower_bound(sortedLineNames.begin(), sortedLineNames.end(), pedigreeLineStruct(currentLineName, -1));
if(findLineName == sortedLineNames.end() || findLineName->lineName != currentLineName)
{
std::stringstream ss;
ss << "Unable to find line number " << finalCounter << " named " << finalNames(finalCounter) << " in pedigree";
throw std::runtime_error(ss.str().c_str());
}
int pedigreeRow = findLineName->index;
//This vector lists all the founders that are ancestors of the current line. This may comprise any number - E.g. if we have an AIC line descended from funnels 1,2,1,2 and 2,3,2,3 then this vector is going it contain 1,2,3
std::vector<int> representedFounders;
if(intercrossingGenerations[finalCounter] == 0)
{
individualsToCheckFunnels.push_back(pedigreeRow);
}
else
{
try
{
getAICParentLines(mother, father, pedigreeRow, intercrossingGenerations[finalCounter], individualsToCheckFunnels);
}
catch(...)
{
std::stringstream ss;
ss << "Error while attempting to trace intercrossing lines for line " << finalNames(finalCounter);
errors.push_back(ss.str());
goto nextLine;
}
}
//Now we know the lines for which we need to check the funnels from the pedigree (note: We don't necessarily have genotype data for all of these, it's purely a pedigree check)
//Fixed length arrays to store funnels. If we have less than 16 founders then part of this is garbage and we don't use that bit....
funnelType funnel, copiedFunnel;
for(std::vector<long>::iterator i = individualsToCheckFunnels.begin(); i != individualsToCheckFunnels.end(); i++)
{
try
{
getFunnel(*i, mother, father, &(funnel.val[0]), nFounders);
}
catch(...)
{
std::stringstream ss;
ss << "Attempting to trace pedigree for line " << finalNames(finalCounter) << ": Unable to get funnel for line " << pedigreeLineNames(*i);
errors.push_back(ss.str());
goto nextLine;
}
//insert these founders into the vector containing all the represented founders
representedFounders.insert(representedFounders.end(), &(funnel.val[0]), &(funnel.val[0]) + nFounders);
//Copy the funnel
memcpy(&copiedFunnel, &funnel, sizeof(funnelType));
std::sort(&(copiedFunnel.val[0]), &(copiedFunnel.val[0]) + nFounders);
if(std::unique(&(copiedFunnel.val[0]), &(copiedFunnel.val[0]) + nFounders) != &(copiedFunnel.val[0]) + nFounders)
{
//If we have intercrossing generations then having repeated founders is an error. Otherwise if warnImproperFunnels is true it's still a warning.
if(intercrossingGenerations[finalCounter] != 0 || warnImproperFunnels)
{
std::stringstream ss;
ss << "Funnel for line " << pedigreeLineNames(*i) << " contained founders {" << funnel.val[0];
if(nFounders == 2)
{
ss << ", " << funnel.val[1] << "}";
}
else if(nFounders == 4)
{
ss << ", " << funnel.val[1] << ", " << funnel.val[2] << ", " << funnel.val[3] << "}";
}
else if(nFounders == 8)
{
ss << ", " << funnel.val[1] << ", " << funnel.val[2] << ", " << funnel.val[3] << ", " << funnel.val[4] << ", " << funnel.val[5] << ", " << funnel.val[6] << ", " << funnel.val[7]<< "}";
}
else if (nFounders == 16)
{
ss << ", " << funnel.val[1] << ", " << funnel.val[2] << ", " << funnel.val[3] << ", " << funnel.val[4] << ", " << funnel.val[5] << ", " << funnel.val[6] << ", " << funnel.val[7] << ", " << funnel.val[8] << ", " << funnel.val[9] << ", " << funnel.val[10] << ", " << funnel.val[11] << ", " << funnel.val[12] << ", " << funnel.val[13] << ", " << funnel.val[14] << ", " << funnel.val[15] << "}";
}
//In this case it's an error
if(intercrossingGenerations[finalCounter] != 0)
{
ss << ". Repeated founders are only allowed with zero generations of intercrossing";
errors.push_back(ss.str());
}
//But if we have zero intercrossing generations then it's only a warning
else
{
ss << ". Did you intend to use all " << nFounders << " founders?";
warnings.push_back(ss.str());
}
}
}
allFunnels.push_back(funnel);
}
//remove duplicates in representedFounders
std::sort(representedFounders.begin(), representedFounders.end());
representedFounders.erase(std::unique(representedFounders.begin(), representedFounders.end()), representedFounders.end());
//Try and check for inconsistent generations of selfing
for(std::vector<int>::iterator i = representedFounders.begin(); i != representedFounders.end(); i++)
{
if(*i > nFounders)
{
std::stringstream ss;
ss << "Error in pedigree for line number " << finalCounter << " named " << finalNames(finalCounter) << ". Inconsistent number of generations of intercrossing";
errors.push_back(ss.str());
goto nextLine;
}
}
//Not having all the founders in the input funnels is more serious if it causes the observed marker data to be impossible. So check for this.
for(int markerCounter = 0; markerCounter < nMarkers; markerCounter++)
{
bool okMarker = false;
//If observed value is an NA then than's ok, continue
int value = finals(finalCounter, markerCounter);
if(value == NA_INTEGER) continue;
for(std::vector<int>::iterator founderIterator1 = representedFounders.begin(); founderIterator1 != representedFounders.end(); founderIterator1++)
{
for(std::vector<int>::iterator founderIterator2 = representedFounders.begin(); founderIterator2 != representedFounders.end(); founderIterator2++)
{
//Note that founderIterator comes from representedFounders, which comes from getFunnel - Which returns values starting at 1, not 0. So we have to subtract one.
if(finals(finalCounter, markerCounter) == foundersToMarkerAlleles((*founderIterator1)-1, (*founderIterator2)-1, markerCounter))
{
okMarker = true;
break;
}
}
}
if(!okMarker)
{
std::stringstream ss;
ss << "Data for marker " << markerNames(markerCounter) << " is impossible for individual " << finalNames(finalCounter) << " with given pedigree";
errors.push_back(ss.str());
if(errors.size() > 1000) return;
goto nextLine;
}
}
//In this case individualsToCheckFunnels contains one element => getFunnel was only called once => we can reuse the funnel variable
if(intercrossingGenerations[finalCounter] == 0)
{
orderFunnel(&(funnel.val[0]), nFounders);
lineFunnels.push_back(funnel);
}
else
{
//Add a dummy value in lineFunnel
for(int i = 0; i < 16; i++) funnel.val[i] = 0;
lineFunnels.push_back(funnel);
}
nextLine:
;
}
}
// Returns an n by 1 column that represents the likelihoods of
// an estimated univariate MS-AR model for each k where 1 \leq k \leq n where
// beta is switching.
// Note that even if beta is non-switching, setting beta as a s by M matrix with
// repeated column of the original beta will give you the likelihood for
// MS-AR model with non-switching beta.
// TODO: Implement the version where z_dependent/z_independent exist(lagged variables should be implemented for MSM models)
// [[Rcpp::export]]
SEXP LikelihoodsMSMAR (Rcpp::NumericVector y_rcpp,
Rcpp::NumericMatrix y_lagged_rcpp,
Rcpp::NumericMatrix z_dependent_rcpp,
Rcpp::NumericMatrix z_independent_rcpp,
Rcpp::NumericMatrix z_dependent_lagged_rcpp,
Rcpp::NumericMatrix z_independent_lagged_rcpp,
Rcpp::NumericMatrix transition_probs_rcpp,
Rcpp::NumericVector initial_dist_extended_rcpp,
Rcpp::NumericMatrix beta_rcpp,
Rcpp::NumericVector mu_rcpp,
Rcpp::NumericVector sigma_rcpp,
Rcpp::NumericMatrix gamma_dependent_rcpp,
Rcpp::NumericVector gamma_independent_rcpp,
Rcpp::IntegerMatrix state_conversion_mat_rcpp
)
{
int n = y_rcpp.size();
arma::colvec y(y_rcpp.begin(), y_rcpp.size(), false);
arma::mat y_lagged(y_lagged_rcpp.begin(),
y_lagged_rcpp.nrow(),
y_lagged_rcpp.ncol(), false);
arma::mat z_dependent(z_dependent_rcpp.begin(),
z_dependent_rcpp.nrow(),
z_dependent_rcpp.ncol(), false);
arma::mat z_dependent_lagged(z_dependent_lagged_rcpp.begin(),
z_dependent_lagged_rcpp.nrow(),
z_dependent_lagged_rcpp.ncol(), false);
arma::mat z_independent(z_independent_rcpp.begin(),
z_independent_rcpp.nrow(),
z_independent_rcpp.ncol(), false);
arma::mat z_independent_lagged(z_independent_lagged_rcpp.begin(),
z_independent_lagged_rcpp.nrow(),
z_independent_lagged_rcpp.ncol(), false);
arma::mat transition_probs(transition_probs_rcpp.begin(),
transition_probs_rcpp.nrow(),
transition_probs_rcpp.ncol(), false);
arma::colvec initial_dist_extended(initial_dist_extended_rcpp.begin(),
initial_dist_extended_rcpp.size(), false);
arma::mat beta(beta_rcpp.begin(),
beta_rcpp.nrow(), beta_rcpp.ncol(), false);
arma::colvec mu(mu_rcpp.begin(), mu_rcpp.size(), false);
arma::colvec sigma(sigma_rcpp.begin(), sigma_rcpp.size(), false);
arma::mat gamma_dependent(gamma_dependent_rcpp.begin(),
gamma_dependent_rcpp.nrow(),
gamma_dependent_rcpp.ncol(), false);
arma::colvec gamma_independent(gamma_independent_rcpp.begin(),
gamma_independent_rcpp.size(), false);
arma::imat state_conversion_mat(state_conversion_mat_rcpp.begin(),
state_conversion_mat_rcpp.nrow(),
state_conversion_mat_rcpp.ncol(), false);
arma::mat transition_probs_extended = GetExtendedTransitionProbs(
transition_probs, state_conversion_mat);
arma::mat transition_probs_extended_t = transition_probs_extended.t();
arma::colvec likelihoods(n, arma::fill::zeros);
int M_extended = transition_probs_extended_t.n_rows;
int M = gamma_dependent.n_cols;
int s = beta.n_rows;
int M_extended_block = IntPower(M, s);
arma::mat* xi_k_t = new arma::mat(M_extended, n, arma::fill::zeros); // make a transpose first for col operations.
// partition blocks
int p = gamma_dependent.n_rows;
int q = gamma_independent.size();
arma::mat* z_dependent_lagged_blocks = new arma::mat[s];
arma::mat* z_independent_lagged_blocks = new arma::mat[s];
for (int i = 0; i < s; i++)
{
int z_dependent_block_first = i * p;
int z_independent_block_first = i * q;
z_dependent_lagged_blocks[i] = z_dependent_lagged.cols(z_dependent_block_first,
z_dependent_block_first + p - 1);
z_independent_lagged_blocks[i] = z_independent_lagged.cols(z_independent_block_first,
z_independent_block_first + q - 1);
}
for (int k = 0; k < n; k++)
{
// initial setting; keep track of minimum value and its index
// to divide everything by the min. value in order to prevent
// possible numerical errors when computing posterior probs.
int min_index = -1;
double min_value = std::numeric_limits<double>::infinity();
double* ratios = new double[M_extended];
double row_sum = 0;
arma::colvec xi_past;
if (k > 0)
xi_past = transition_probs_extended_t * exp(xi_k_t->col(k-1));
else
xi_past = initial_dist_extended;
xi_past /= arma::sum(xi_past);
for (int j_M = 0; j_M < M; j_M++)
{
for (int j_extra = 0; j_extra < M_extended_block; j_extra++)
{
int j = j_M * M_extended_block + j_extra;
arma::colvec xi_k_t_jk = y.row(k);
// arma::colvec xi_k_t_jk = y.row(k) -
// z_dependent.row(k) * gamma_dependent.col(j_M) -
// z_independent.row(k) * gamma_independent - mu(j_M);
for (int lag = 0; lag < s; lag++)
{
int lagged_index = state_conversion_mat.at((lag + 1), j);
xi_k_t_jk -= beta.at(lag, j_M) *
(y_lagged.at(k, lag) -
mu(lagged_index));
xi_k_t_jk -= beta.at(lag, j_M) *
(y_lagged.at(k, lag) -
z_dependent_lagged_blocks[lag].row(k) * gamma_dependent.col(lagged_index) -
z_independent_lagged_blocks[lag].row(k) * gamma_independent -
mu(lagged_index));
}
xi_k_t->at(j,k) = xi_k_t_jk(0); // explicit gluing
xi_k_t->at(j,k) *= xi_k_t->at(j,k);
xi_k_t->at(j,k) = xi_k_t->at(j,k) / (2 * (sigma(j_M) * sigma(j_M)));
if (min_value > xi_k_t->at(j,k))
{
min_value = xi_k_t->at(j,k);
min_index = j;
}
// SQRT2PI only matters in calculation of eta;
// you can remove it in the final log-likelihood.
ratios[j] = xi_past(j) / sigma(j_M);
}
}
for (int j = 0; j < M_extended; j++)
{
if (j == min_index)
row_sum += 1.0;
else
row_sum += (ratios[j] / ratios[min_index]) *
exp(min_value - xi_k_t->at(j,k));
xi_k_t->at(j,k) += log(ratios[j]);
}
likelihoods(k) = log(row_sum) - min_value + log(ratios[min_index]) - LOG2PI_OVERTWO;
delete[] ratios; // clear memory
}
arma::exp(xi_k_t->cols(1,4)).t().print();
// clear memory for blocks
delete[] z_dependent_lagged_blocks;
delete[] z_independent_lagged_blocks;
delete xi_k_t;
return (wrap(likelihoods));
}