List log_forwardbackwardx(const arma::mat& transition_, const arma::cube& emission_, const arma::vec& init_, const arma::ucube& obs, const arma::mat& coef, const arma::mat& X, const arma::uvec& numberOfStates, bool forwardonly, unsigned int threads) { arma::vec init = log(init_); arma::mat transition = log(transition_); arma::cube emission = log(emission_); arma::mat weights = exp(X * coef).t(); weights.each_row() /= arma::sum(weights, 0); weights = log(weights); arma::mat initk(emission.n_rows, obs.n_slices); for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init + reparma(weights.col(k), numberOfStates); } arma::cube alpha(emission.n_rows, obs.n_cols, obs.n_slices); //m,n,k log_internalForwardx(transition, emission, initk, obs, alpha, threads); if (forwardonly) { return List::create(Named("forward_probs") = wrap(alpha)); } else { arma::cube beta(emission.n_rows, obs.n_cols, obs.n_slices); //m,n,k log_internalBackward(transition, emission, obs, beta, threads); return List::create(Named("forward_probs") = wrap(alpha), Named("backward_probs") = wrap(beta)); } return wrap(alpha); }
NumericVector log_logLikMixHMM(arma::mat transition, arma::cube emission, arma::vec init, const arma::ucube& obs, const arma::mat& coef, const arma::mat& X, const arma::uvec& numberOfStates, unsigned int threads) { arma::mat weights = exp(X * coef).t(); if (!weights.is_finite()) { return wrap(-arma::datum::inf); } weights.each_row() /= sum(weights, 0); weights = log(weights); transition = log(transition); emission = log(emission); init = log(init); arma::vec ll(obs.n_slices); #pragma omp parallel for if(obs.n_slices >= threads) schedule(static) num_threads(threads) \ default(none) shared(ll, obs, weights, init, emission, transition, numberOfStates) for (unsigned int k = 0; k < obs.n_slices; k++) { arma::vec alpha = init + reparma(weights.col(k), numberOfStates); for (unsigned int r = 0; r < obs.n_rows; r++) { alpha += emission.slice(r).col(obs(r, 0, k)); } arma::vec alphatmp(emission.n_rows); for (unsigned int t = 1; t < obs.n_cols; t++) { for (unsigned int i = 0; i < emission.n_rows; i++) { alphatmp(i) = logSumExp(alpha + transition.col(i)); for (unsigned int r = 0; r < obs.n_rows; r++) { alphatmp(i) += emission(i, obs(r, t, k), r); } } alpha = alphatmp; } ll(k) = logSumExp(alpha); } return wrap(ll); }
NumericVector logLikMixHMM(const arma::mat& transition, const arma::cube& emission, const arma::vec& init, const arma::ucube& obs, const arma::mat& coef, const arma::mat& X, const arma::uvec& numberOfStates, unsigned int threads) { arma::mat weights = exp(X * coef).t(); if (!weights.is_finite()) { return wrap(-arma::datum::inf); } weights.each_row() /= sum(weights, 0); arma::vec ll(obs.n_slices); arma::sp_mat transition_t(transition.t()); #pragma omp parallel for if(obs.n_slices >= threads) schedule(static) num_threads(threads) \ default(none) shared(ll, obs, weights, init, emission, transition_t, numberOfStates) for (unsigned int k = 0; k < obs.n_slices; k++) { arma::vec alpha = init % reparma(weights.col(k), numberOfStates); for (unsigned int r = 0; r < obs.n_rows; r++) { alpha %= emission.slice(r).col(obs(r, 0, k)); } double tmp = sum(alpha); ll(k) = log(tmp); alpha /= tmp; for (unsigned int t = 1; t < obs.n_cols; t++) { alpha = transition_t * alpha; for (unsigned int r = 0; r < obs.n_rows; r++) { alpha %= emission.slice(r).col(obs(r, t, k)); } tmp = sum(alpha); ll(k) += log(tmp); alpha /= tmp; } } return wrap(ll); }
List objectivex(const arma::mat& transition, const arma::cube& emission, const arma::vec& init, const arma::ucube& obs, const arma::umat& ANZ, const arma::ucube& BNZ, const arma::uvec& INZ, const arma::uvec& nSymbols, const arma::mat& coef, const arma::mat& X, arma::uvec& numberOfStates, unsigned int threads) { unsigned int q = coef.n_rows; arma::vec grad( arma::accu(ANZ) + arma::accu(BNZ) + arma::accu(INZ) + (numberOfStates.n_elem- 1) * q, arma::fill::zeros); arma::mat weights = exp(X * coef).t(); if (!weights.is_finite()) { grad.fill(-arma::datum::inf); return List::create(Named("objective") = arma::datum::inf, Named("gradient") = wrap(grad)); } weights.each_row() /= sum(weights, 0); arma::mat initk(emission.n_rows, obs.n_slices); for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init % reparma(weights.col(k), numberOfStates); } arma::uvec cumsumstate = arma::cumsum(numberOfStates); unsigned int error = 0; double ll = 0; #pragma omp parallel for if(obs.n_slices >= threads) schedule(static) reduction(+:ll) num_threads(threads) \ default(none) shared(q, grad, nSymbols, ANZ, BNZ, INZ, \ numberOfStates, cumsumstate, obs, init, initk, X, weights, transition, emission, error) for (unsigned int k = 0; k < obs.n_slices; k++) { if (error == 0) { arma::mat alpha(emission.n_rows, obs.n_cols); //m,n arma::vec scales(obs.n_cols); //n arma::sp_mat sp_trans(transition); uvForward(sp_trans.t(), emission, initk.col(k), obs.slice(k), alpha, scales); arma::mat beta(emission.n_rows, obs.n_cols); //m,n uvBackward(sp_trans, emission, obs.slice(k), beta, scales); int countgrad = 0; arma::vec grad_k(grad.n_elem, arma::fill::zeros); // transitionMatrix if (arma::accu(ANZ) > 0) { for (unsigned int jj = 0; jj < numberOfStates.n_elem; jj++) { arma::vec gradArow(numberOfStates(jj)); arma::mat gradA(numberOfStates(jj), numberOfStates(jj)); int ind_jj = cumsumstate(jj) - numberOfStates(jj); for (unsigned int i = 0; i < numberOfStates(jj); i++) { arma::uvec ind = arma::find(ANZ.row(ind_jj + i).subvec(ind_jj, cumsumstate(jj) - 1)); if (ind.n_elem > 0) { gradArow.zeros(); gradA.eye(); gradA.each_row() -= transition.row(ind_jj + i).subvec(ind_jj, cumsumstate(jj) - 1); gradA.each_col() %= transition.row(ind_jj + i).subvec(ind_jj, cumsumstate(jj) - 1).t(); for (unsigned int j = 0; j < numberOfStates(jj); j++) { for (unsigned int t = 0; t < (obs.n_cols - 1); t++) { double tmp = alpha(ind_jj + i, t); for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(ind_jj + j, obs(r, t + 1, k), r); } gradArow(j) += tmp * beta(ind_jj + j, t + 1); } } gradArow = gradA * gradArow; grad_k.subvec(countgrad, countgrad + ind.n_elem - 1) = gradArow.rows(ind); countgrad += ind.n_elem; } } } } if (arma::accu(BNZ) > 0) { // emissionMatrix for (unsigned int r = 0; r < obs.n_rows; r++) { arma::vec gradBrow(nSymbols(r)); arma::mat gradB(nSymbols(r), nSymbols(r)); for (unsigned int i = 0; i < emission.n_rows; i++) { arma::uvec ind = arma::find(BNZ.slice(r).row(i)); if (ind.n_elem > 0) { gradBrow.zeros(); gradB.eye(); gradB.each_row() -= emission.slice(r).row(i).subvec(0, nSymbols(r) - 1); gradB.each_col() %= emission.slice(r).row(i).subvec(0, nSymbols(r) - 1).t(); for (unsigned int j = 0; j < nSymbols(r); j++) { if (obs(r, 0, k) == j) { double tmp = initk(i, k); for (unsigned int r2 = 0; r2 < obs.n_rows; r2++) { if (r2 != r) { tmp *= emission(i, obs(r2, 0, k), r2); } } gradBrow(j) += tmp * beta(i, 0); } for (unsigned int t = 0; t < (obs.n_cols - 1); t++) { if (obs(r, t + 1, k) == j) { double tmp = beta(i, t + 1); for (unsigned int r2 = 0; r2 < obs.n_rows; r2++) { if (r2 != r) { tmp *= emission(i, obs(r2, t + 1, k), r2); } } gradBrow(j) += arma::dot(alpha.col(t), transition.col(i)) * tmp; } } } gradBrow = gradB * gradBrow; grad_k.subvec(countgrad, countgrad + ind.n_elem - 1) = gradBrow.rows(ind); countgrad += ind.n_elem; } } } } if (arma::accu(INZ) > 0) { for (unsigned int i = 0; i < numberOfStates.n_elem; i++) { int ind_i = cumsumstate(i) - numberOfStates(i); arma::uvec ind = arma::find( INZ.subvec(ind_i, cumsumstate(i) - 1)); if (ind.n_elem > 0) { arma::vec gradIrow(numberOfStates(i), arma::fill::zeros); for (unsigned int j = 0; j < numberOfStates(i); j++) { double tmp = weights(i, k); for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(ind_i + j, obs(r, 0, k), r); } gradIrow(j) += tmp * beta(ind_i + j, 0); } arma::mat gradI(numberOfStates(i), numberOfStates(i), arma::fill::zeros); gradI.eye(); gradI.each_row() -= init.subvec(ind_i, cumsumstate(i) - 1).t(); gradI.each_col() %= init.subvec(ind_i, cumsumstate(i) - 1); gradIrow = gradI * gradIrow; grad_k.subvec(countgrad, countgrad + ind.n_elem - 1) = gradIrow.rows(ind); countgrad += ind.n_elem; } } } for (unsigned int jj = 1; jj < numberOfStates.n_elem; jj++) { unsigned int ind_jj = (cumsumstate(jj) - numberOfStates(jj)); for (unsigned int j = 0; j < emission.n_rows; j++) { double tmp = 1.0; for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(j, obs(r, 0, k), r); } if ((j >= ind_jj) & (j < cumsumstate(jj))) { grad_k.subvec(countgrad + q * (jj - 1), countgrad + q * jj - 1) += tmp * beta(j, 0) * initk(j, k) * X.row(k).t() * (1.0 - weights(jj, k)); } else { grad_k.subvec(countgrad + q * (jj - 1), countgrad + q * jj - 1) -= tmp * beta(j, 0) * initk(j, k) * X.row(k).t() * weights(jj, k); } } } if (!scales.is_finite() || !beta.is_finite()) { #pragma omp atomic error++; } else { ll -= arma::sum(log(scales)); #pragma omp critical grad += grad_k; } } } if(error > 0){ ll = -arma::datum::inf; grad.fill(-arma::datum::inf); } return List::create(Named("objective") = -ll, Named("gradient") = wrap(-grad)); }
List log_EMx(const arma::mat& transition_, const arma::cube& emission_, const arma::vec& init_, const arma::ucube& obs, const arma::uvec& nSymbols, const arma::mat& coef_, const arma::mat& X, const arma::uvec& numberOfStates, int itermax, double tol, int trace, unsigned int threads) { // Make sure we don't alter the original vec/mat/cube // needed for cube, in future maybe in other cases as well arma::cube emission = log(emission_); arma::mat transition = log(transition_); arma::vec init = log(init_); arma::mat coef(coef_); coef.col(0).zeros(); arma::mat weights = exp(X * coef).t(); if (!weights.is_finite()) { return List::create(Named("error") = 3); } weights.each_row() /= sum(weights, 0); weights = log(weights); arma::mat initk(emission.n_rows, obs.n_slices); for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init + reparma(weights.col(k), numberOfStates); } arma::cube alpha(emission.n_rows, obs.n_cols, obs.n_slices); //m,n,k arma::cube beta(emission.n_rows, obs.n_cols, obs.n_slices); //m,n,k log_internalForwardx(transition, emission, initk, obs, alpha, threads); log_internalBackward(transition, emission, obs, beta, threads); arma::vec ll(obs.n_slices); #pragma omp parallel for if(obs.n_slices >= threads) schedule(static) num_threads(threads) \ default(none) shared(obs, alpha, ll) for (unsigned int k = 0; k < obs.n_slices; k++) { ll(k) = logSumExp(alpha.slice(k).col(obs.n_cols - 1)); } double sumlogLik = sum(ll); if (trace > 0) { Rcout << "Log-likelihood of initial model: " << sumlogLik << std::endl; } // // //EM-algorithm begins // double change = tol + 1.0; int iter = 0; arma::uvec cumsumstate = cumsum(numberOfStates); while ((change > tol) & (iter < itermax)) { iter++; arma::mat ksii(emission.n_rows, emission.n_rows, arma::fill::zeros); arma::cube gamma(emission.n_rows, emission.n_cols, emission.n_slices, arma::fill::zeros); arma::vec delta(emission.n_rows, arma::fill::zeros); for (unsigned int k = 0; k < obs.n_slices; k++) { delta += exp(alpha.slice(k).col(0) + beta.slice(k).col(0) - ll(k)); } #pragma omp parallel for if(obs.n_slices>=threads) schedule(static) num_threads(threads) \ default(none) shared(transition, obs, ll, alpha, beta, emission, ksii, gamma, nSymbols) for (unsigned int k = 0; k < obs.n_slices; k++) { if (obs.n_cols > 1) { for (unsigned int j = 0; j < emission.n_rows; j++) { for (unsigned int i = 0; i < emission.n_rows; i++) { if (transition(i, j) > -arma::datum::inf) { arma::vec tmpnm1(obs.n_cols - 1); for (unsigned int t = 0; t < (obs.n_cols - 1); t++) { tmpnm1(t) = alpha(i, t, k) + transition(i, j) + beta(j, t + 1, k); for (unsigned int r = 0; r < obs.n_rows; r++) { tmpnm1(t) += emission(j, obs(r, t + 1, k), r); } } #pragma omp atomic ksii(i, j) += exp(logSumExp(tmpnm1) - ll(k)); } } } } for (unsigned int r = 0; r < emission.n_slices; r++) { for (unsigned int l = 0; l < nSymbols[r]; l++) { for (unsigned int i = 0; i < emission.n_rows; i++) { if (emission(i, l, r) > -arma::datum::inf) { arma::vec tmpn(obs.n_cols); for (unsigned int t = 0; t < obs.n_cols; t++) { if (l == (obs(r, t, k))) { tmpn(t) = alpha(i, t, k) + beta(i, t, k); } else tmpn(t) = -arma::datum::inf; } #pragma omp atomic gamma(i, l, r) += exp(logSumExp(tmpn) - ll(k)); } } } } } unsigned int error = log_optCoef(weights, obs, emission, initk, beta, ll, coef, X, cumsumstate, numberOfStates, trace); if (error != 0) { return List::create(Named("error") = error); } if (obs.n_cols > 1) { ksii.each_col() /= sum(ksii, 1); transition = log(ksii); } for (unsigned int r = 0; r < emission.n_slices; r++) { gamma.slice(r).cols(0, nSymbols(r) - 1).each_col() /= sum( gamma.slice(r).cols(0, nSymbols(r) - 1), 1); emission.slice(r).cols(0, nSymbols(r) - 1) = log(gamma.slice(r).cols(0, nSymbols(r) - 1)); } for (unsigned int i = 0; i < numberOfStates.n_elem; i++) { delta.subvec(cumsumstate(i) - numberOfStates(i), cumsumstate(i) - 1) /= arma::as_scalar( arma::accu(delta.subvec(cumsumstate(i) - numberOfStates(i), cumsumstate(i) - 1))); } init = log(delta); for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init + reparma(weights.col(k), numberOfStates); } log_internalForwardx(transition, emission, initk, obs, alpha, threads); log_internalBackward(transition, emission, obs, beta, threads); for (unsigned int k = 0; k < obs.n_slices; k++) { ll(k) = logSumExp(alpha.slice(k).col(obs.n_cols - 1)); } double tmp = sum(ll); change = (tmp - sumlogLik) / (std::abs(sumlogLik) + 0.1); sumlogLik = tmp; if (!arma::is_finite(sumlogLik)) { return List::create(Named("error") = 6); } if (trace > 1) { Rcout << "iter: " << iter; Rcout << " logLik: " << sumlogLik; Rcout << " relative change: " << change << std::endl; } } if (trace > 0) { if (iter == itermax) { Rcpp::Rcout << "EM algorithm stopped after reaching the maximum number of " << iter << " iterations." << std::endl; } else { Rcpp::Rcout << "EM algorithm stopped after reaching the relative change of " << change; Rcpp::Rcout << " after " << iter << " iterations." << std::endl; } Rcpp::Rcout << "Final log-likelihood: " << sumlogLik << std::endl; } return List::create(Named("coefficients") = wrap(coef), Named("initialProbs") = wrap(exp(init)), Named("transitionMatrix") = wrap(exp(transition)), Named("emissionArray") = wrap(exp(emission)), Named("logLik") = sumlogLik, Named("iterations") = iter, Named("change") = change, Named("error") = 0); }
List objectivex(const arma::mat& transition, NumericVector emissionArray, const arma::vec& init, IntegerVector obsArray, const arma::imat& ANZ, IntegerVector emissNZ, const arma::ivec& INZ, const arma::ivec& nSymbols, const arma::mat& coef, const arma::mat& X, arma::ivec& numberOfStates, int threads) { IntegerVector eDims = emissionArray.attr("dim"); //m,p,r IntegerVector oDims = obsArray.attr("dim"); //k,n,r arma::cube emission(emissionArray.begin(), eDims[0], eDims[1], eDims[2], false, true); arma::icube obs(obsArray.begin(), oDims[0], oDims[1], oDims[2], false, true); arma::icube BNZ(emissNZ.begin(), emission.n_rows, emission.n_cols - 1, emission.n_slices, false, true); unsigned int q = coef.n_rows; arma::vec grad( arma::accu(ANZ) + arma::accu(BNZ) + arma::accu(INZ) + (numberOfStates.n_elem- 1) * q, arma::fill::zeros); arma::mat weights = exp(X * coef).t(); if (!weights.is_finite()) { grad.fill(-arma::math::inf()); return List::create(Named("objective") = arma::math::inf(), Named("gradient") = wrap(grad)); } weights.each_row() /= sum(weights, 0); arma::mat initk(emission.n_rows, obs.n_slices); for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init % reparma(weights.col(k), numberOfStates); } arma::cube alpha(emission.n_rows, obs.n_cols, obs.n_slices); //m,n,k arma::cube beta(emission.n_rows, obs.n_cols, obs.n_slices); //m,n,k arma::mat scales(obs.n_cols, obs.n_slices); //m,n,k arma::sp_mat sp_trans(transition); internalForwardx(sp_trans.t(), emission, initk, obs, alpha, scales, threads); if (!scales.is_finite()) { grad.fill(-arma::math::inf()); return List::create(Named("objective") = arma::math::inf(), Named("gradient") = wrap(grad)); } internalBackwardx(sp_trans, emission, obs, beta, scales, threads); if (!beta.is_finite()) { grad.fill(-arma::math::inf()); return List::create(Named("objective") = arma::math::inf(), Named("gradient") = wrap(grad)); } arma::ivec cumsumstate = arma::cumsum(numberOfStates); arma::mat gradmat( arma::accu(ANZ) + arma::accu(BNZ) + arma::accu(INZ) + (numberOfStates.n_elem- 1) * q, obs.n_slices, arma::fill::zeros); #pragma omp parallel for if(obs.n_slices >= threads) schedule(static) num_threads(threads) \ default(none) shared(q, alpha, beta, scales, gradmat, nSymbols, ANZ, BNZ, INZ, \ numberOfStates, cumsumstate, obs, init, initk, X, weights, transition, emission) for (int k = 0; k < obs.n_slices; k++) { int countgrad = 0; // transitionMatrix if (arma::accu(ANZ) > 0) { for (int jj = 0; jj < numberOfStates.n_elem; jj++) { arma::vec gradArow(numberOfStates(jj)); arma::mat gradA(numberOfStates(jj), numberOfStates(jj)); int ind_jj = cumsumstate(jj) - numberOfStates(jj); for (int i = 0; i < numberOfStates(jj); i++) { arma::uvec ind = arma::find(ANZ.row(ind_jj + i).subvec(ind_jj, cumsumstate(jj) - 1)); if (ind.n_elem > 0) { gradArow.zeros(); gradA.eye(); gradA.each_row() -= transition.row(ind_jj + i).subvec(ind_jj, cumsumstate(jj) - 1); gradA.each_col() %= transition.row(ind_jj + i).subvec(ind_jj, cumsumstate(jj) - 1).t(); for (int j = 0; j < numberOfStates(jj); j++) { for (unsigned int t = 0; t < (obs.n_cols - 1); t++) { double tmp = alpha(ind_jj + i, t, k); for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(ind_jj + j, obs(r, t + 1, k), r); } gradArow(j) += tmp * beta(ind_jj + j, t + 1, k) / scales(t + 1, k); } } gradArow = gradA * gradArow; gradmat.col(k).subvec(countgrad, countgrad + ind.n_elem - 1) = gradArow.rows(ind); countgrad += ind.n_elem; } } } } if (arma::accu(BNZ) > 0) { // emissionMatrix for (unsigned int r = 0; r < obs.n_rows; r++) { arma::vec gradBrow(nSymbols(r)); arma::mat gradB(nSymbols(r), nSymbols(r)); for (unsigned int i = 0; i < emission.n_rows; i++) { arma::uvec ind = arma::find(BNZ.slice(r).row(i)); if (ind.n_elem > 0) { gradBrow.zeros(); gradB.eye(); gradB.each_row() -= emission.slice(r).row(i).subvec(0, nSymbols(r) - 1); gradB.each_col() %= emission.slice(r).row(i).subvec(0, nSymbols(r) - 1).t(); for (int j = 0; j < nSymbols(r); j++) { if (obs(r, 0, k) == j) { double tmp = initk(i, k); for (unsigned int r2 = 0; r2 < obs.n_rows; r2++) { if (r2 != r) { tmp *= emission(i, obs(r2, 0, k), r2); } } gradBrow(j) += tmp * beta(i, 0, k) / scales(0, k); } for (unsigned int t = 0; t < (obs.n_cols - 1); t++) { if (obs(r, t + 1, k) == j) { double tmp = beta(i, t + 1, k) / scales(t + 1, k); for (unsigned int r2 = 0; r2 < obs.n_rows; r2++) { if (r2 != r) { tmp *= emission(i, obs(r2, t + 1, k), r2); } } gradBrow(j) += arma::dot(alpha.slice(k).col(t), transition.col(i)) * tmp; } } } gradBrow = gradB * gradBrow; gradmat.col(k).subvec(countgrad, countgrad + ind.n_elem - 1) = gradBrow.rows(ind); countgrad += ind.n_elem; } } } } if (arma::accu(INZ) > 0) { for (int i = 0; i < numberOfStates.n_elem; i++) { int ind_i = cumsumstate(i) - numberOfStates(i); arma::uvec ind = arma::find( INZ.subvec(ind_i, cumsumstate(i) - 1)); if (ind.n_elem > 0) { arma::vec gradIrow(numberOfStates(i), arma::fill::zeros); for (int j = 0; j < numberOfStates(i); j++) { double tmp = weights(i, k); for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(ind_i + j, obs(r, 0, k), r); } gradIrow(j) += tmp * beta(ind_i + j, 0, k) / scales(0, k); } arma::mat gradI(numberOfStates(i), numberOfStates(i), arma::fill::zeros); gradI.eye(); gradI.each_row() -= init.subvec(ind_i, cumsumstate(i) - 1).t(); gradI.each_col() %= init.subvec(ind_i, cumsumstate(i) - 1); gradIrow = gradI * gradIrow; gradmat.col(k).subvec(countgrad, countgrad + ind.n_elem - 1) = gradIrow.rows(ind); countgrad += ind.n_elem; } } } for (int jj = 1; jj < numberOfStates.n_elem; jj++) { int ind_jj = (cumsumstate(jj) - numberOfStates(jj)); for (int j = 0; j < emission.n_rows; j++) { double tmp = 1.0; for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(j, obs(r, 0, k), r); } if ((j >= ind_jj) & (j < cumsumstate(jj))) { gradmat.col(k).subvec(countgrad + q * (jj - 1), countgrad + q * jj - 1) += tmp * beta(j, 0, k) / scales(0, k) * initk(j, k) * X.row(k).t() * (1.0 - weights(jj, k)); } else { gradmat.col(k).subvec(countgrad + q * (jj - 1), countgrad + q * jj - 1) -= tmp * beta(j, 0, k) / scales(0, k) * initk(j, k) * X.row(k).t() * weights(jj, k); } } } } return List::create(Named("objective") = -arma::accu(log(scales)), Named("gradient") = wrap(-sum(gradmat, 1))); }
// [[Rcpp::export]] Rcpp::List EMx(const arma::mat& transition_, const arma::cube& emission_, const arma::vec& init_, const arma::ucube& obs, const arma::uvec& nSymbols, const arma::mat& coef_, const arma::mat& X, const arma::uvec& numberOfStates, int itermax, double tol, int trace, unsigned int threads) { // Make sure we don't alter the original vec/mat/cube // needed for cube, in future maybe in other cases as well arma::cube emission(emission_); arma::mat transition(transition_); arma::vec init(init_); arma::mat coef(coef_); coef.col(0).zeros(); arma::mat weights = exp(X * coef).t(); if (!weights.is_finite()) { return Rcpp::List::create(Rcpp::Named("error") = 3); } weights.each_row() /= sum(weights, 0); arma::mat initk(emission.n_rows, obs.n_slices); for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init % reparma(weights.col(k), numberOfStates); } // // //EM-algorithm begins // double change = tol + 1.0; int iter = 0; arma::uvec cumsumstate = arma::cumsum(numberOfStates); double sumlogLik_new = 0; double sumlogLik = -1e150; while ((change > tol) & (iter < itermax)) { iter++; arma::mat ksii(emission.n_rows, emission.n_rows, arma::fill::zeros); arma::cube gamma(emission.n_rows, emission.n_cols, emission.n_slices, arma::fill::zeros); arma::vec delta(emission.n_rows, arma::fill::zeros); arma::mat bsi(emission.n_rows, obs.n_slices); sumlogLik_new = 0; double max_sf = 1; unsigned int error_code = 0; #pragma omp parallel for if(obs.n_slices >= threads) schedule(static) reduction(+:sumlogLik_new) num_threads(threads) \ default(shared) //shared(bsi, initk, transition, obs, emission, delta, ksii, gamma, nSymbols, error_code, max_sf, arma::fill::zeros) for (unsigned int k = 0; k < obs.n_slices; k++) { if (error_code == 0) { arma::mat alpha(emission.n_rows, obs.n_cols); //m,n,k arma::vec scales(obs.n_cols); arma::sp_mat sp_trans(transition); uvForward(sp_trans.t(), emission, initk.col(k), obs.slice(k), alpha, scales); arma::mat beta(emission.n_rows, obs.n_cols); //m,n,k uvBackward(sp_trans, emission, obs.slice(k), beta, scales); sumlogLik_new -= arma::sum(log(scales)); arma::mat ksii_k(emission.n_rows, emission.n_rows, arma::fill::zeros); arma::cube gamma_k(emission.n_rows, emission.n_cols, emission.n_slices, arma::fill::zeros); arma::vec delta_k(emission.n_rows); delta_k = alpha.col(0) % beta.col(0) / scales(0); for (unsigned int i = 0; i < emission.n_rows; i++) { for (unsigned int j = 0; j < emission.n_rows; j++) { if (transition(i, j) > 0.0) { for (unsigned int t = 0; t < (obs.n_cols - 1); t++) { double tmp = alpha(i, t) * transition(i, j) * beta(j, t + 1); for (unsigned int r = 0; r < obs.n_rows; r++) { tmp *= emission(j, obs(r, t + 1, k), r); } ksii_k(i, j) += tmp; } } } } for (unsigned int r = 0; r < emission.n_slices; r++) { for (unsigned int l = 0; l < nSymbols(r); l++) { for (unsigned int i = 0; i < emission.n_rows; i++) { if (emission(i, l, r) > 0.0) { for (unsigned int t = 0; t < obs.n_cols; t++) { if (l == (obs(r, t, k))) { double tmp = alpha(i, t) * beta(i, t) / scales(t); gamma_k(i, l, r) += tmp; } } } } } } for (unsigned int j = 0; j < emission.n_rows; j++) { bsi(j, k) = beta(j, 0) * initk(j, k); } #pragma omp critical { if(!scales.is_finite()) { error_code = 1; } if(!beta.is_finite()) { error_code = 2; } max_sf = std::min(max_sf, scales.max()); delta += delta_k; ksii += ksii_k; gamma += gamma_k; } } } if(error_code == 1) { return Rcpp::List::create(Rcpp::Named("error") = 1); } if(error_code == 2) { return Rcpp::List::create(Rcpp::Named("error") = 2); } if (max_sf > 1e150) { Rcpp::warning("Largest scaling factor was %e, results can be numerically unstable.", max_sf); } change = (sumlogLik_new - sumlogLik) / (std::abs(sumlogLik) + 0.1); sumlogLik = sumlogLik_new; if (trace > 0) { if(iter == 0) { Rcpp::Rcout << "Log-likelihood of initial model: " << sumlogLik << std::endl; } else { if (trace > 1) { Rcpp::Rcout << "iter: " << iter; Rcpp::Rcout << " logLik: " << sumlogLik; Rcpp::Rcout << " relative change: " << change << std::endl; } } } if (change > tol) { unsigned int error = optCoef(weights, obs, emission, bsi, coef, X, cumsumstate, numberOfStates, trace); if (error != 0) { return Rcpp::List::create(Rcpp::Named("error") = error); } if (obs.n_cols > 1) { ksii.each_col() /= sum(ksii, 1); transition = ksii; } for (unsigned int r = 0; r < emission.n_slices; r++) { gamma.slice(r).cols(0, nSymbols(r) - 1).each_col() /= sum( gamma.slice(r).cols(0, nSymbols(r) - 1), 1); emission.slice(r).cols(0, nSymbols(r) - 1) = gamma.slice(r).cols(0, nSymbols(r) - 1); } for (unsigned int i = 0; i < numberOfStates.n_elem; i++) { delta.subvec(cumsumstate(i) - numberOfStates(i), cumsumstate(i) - 1) /= arma::as_scalar( arma::accu(delta.subvec(cumsumstate(i) - numberOfStates(i), cumsumstate(i) - 1))); } init = delta; for (unsigned int k = 0; k < obs.n_slices; k++) { initk.col(k) = init % reparma(weights.col(k), numberOfStates); } } } if (trace > 0) { if (iter == itermax) { Rcpp::Rcout << "EM algorithm stopped after reaching the maximum number of " << iter << " iterations." << std::endl; } else { Rcpp::Rcout << "EM algorithm stopped after reaching the relative change of " << change; Rcpp::Rcout << " after " << iter << " iterations." << std::endl; } Rcpp::Rcout << "Final log-likelihood: " << sumlogLik << std::endl; } return Rcpp::List::create(Rcpp::Named("coefficients") = Rcpp::wrap(coef), Rcpp::Named("initialProbs") = Rcpp::wrap(init), Rcpp::Named("transitionMatrix") = Rcpp::wrap(transition), Rcpp::Named("emissionArray") = Rcpp::wrap(emission), Rcpp::Named("logLik") = sumlogLik, Rcpp::Named("iterations") = iter, Rcpp::Named("change") = change, Rcpp::Named("error") = 0); }