void CosineTreeBuilder::CTNode(arma::mat A, CosineTree& root) { A = A.t(); Log::Info<<"CTNode"<<std::endl; //Calculating Centroid arma::rowvec centroid = CalculateCentroid(A); //Calculating sampling probabilities arma::vec probabilities = arma::zeros<arma::vec>(A.n_rows,1); LSSampling(A,probabilities); //Setting Values root.Probabilities(probabilities); root.Data(A); root.Centroid(centroid); }
// [[Rcpp::export]] arma::vec innerLoop(arma::vec resp, arma::vec beta, double intercept, double tol, int max_iter, arma::mat x_mat, int n, arma::vec weights) { bool converge = false; int counter = 0; arma::vec temp_resp; arma::vec beta_new = beta; double intercept_new; while(!converge && counter < max_iter) { temp_resp = x_mat.t() * ((resp - intercept) / n); // The argmin is hence equivalent to that of // (1/2) * ||v - beta||_2^2 + 4 * lam * Pen(beta). // In main func weights will be weights.col(i) beta_new = GetProxOne(temp_resp, 4 * weights); intercept_new = mean(resp - x_mat * beta_new); double change1 = pow(intercept_new - intercept, 2) + sum(square(beta_new - beta)); double change2 = pow(intercept_new, 2) + sum(square(beta_new));; if( pow(change1, 0.5) / pow(change2, 0.5) < tol ) { beta = beta_new; intercept = intercept_new; converge = true; } else { beta = beta_new; intercept = intercept_new; counter = counter + 1; if(counter == max_iter) { beta = beta_new; intercept = intercept_new; Function warning("warning"); warning("Function did not converge for inner loop for some lambda."); } } } arma::vec inter_vec(1); inter_vec(0) = intercept; return join_vert(inter_vec, beta); }
// [[Rcpp::export]] arma::mat expskewC(arma::mat M){ /*This function takes a 3-by-3 skew symmetric matrix (in so(3)) and returns the exponential, a 3-by-3 rotations (in SO(3))*/ double MMt = sum(sum(M-M.t())); if(fabs(MMt)>0.01){ throw Rcpp::exception("The exp.skew function is expecting a 3-by-3 skew symmetric matrix"); } arma::mat expM(3,3); expM.eye(); double a = pow(0.5*trace(M.t()*M),0.5); if(a < 0.000001 && a > -0.000001){ return expM; } expM = expM + (sin(a)/a) * M + (1-cos(a))*pow(a,-2)*M*M; return expM; }
//evaluate Hessian operator on Z //eucH is the ordinary Hessian matrix on Z in the ambient space //return <Z, Hessian*Z>_Y double specialLinear::evalHessian(const arma::mat & eucH,const arma::mat & Z){ arma::mat YU,eucH_proj,Weingarten,Weingarten_part,temp; //project euclidian Hessian onto tangent space YU=eucH*Y.i(); YU=1.0/n*(arma::trace(YU))*Y; eucH_proj=eucH-YU; //Weingarten Map Weingarten=-1.0/n*(arma::dot(eucH.t(),Y.i()))*Z; Weingarten_part=1.0/n*eucH*Y.i()*Z; temp=1.0/n*(arma::dot(Weingarten_part.t(),Y.i()))*Y; Weingarten_part-=temp; Weingarten+=Weingarten_part; hessian_Z=eucH_proj+Weingarten; Z_hessian_Z=arma::dot(hessian_Z,Z); return Z_hessian_Z; }
arma::vec cpp_UpdateGamma (arma::mat x_big, arma::vec weights_big, arma::vec y_big, arma::vec gamma, arma::vec beta, double lambda) { // Another helper function used by the main algorithm. // In this algorithm we loop through and do a coordinate wise update of // gamma. // // Agrs: // beta/gamma: The 'current' parameter vectors. // x/weights/y_big: Design, weights and response for the big population. // lambda: The value of the penalty parameter. // Returns: // gamma: The updated gamma vector. // Obtain value of dimension. int p = gamma.size(); // Initialize matrix X * beta. arma::mat x_beta = x_big * beta; // We need the diagonal entries of X^T * W * X. // This is easy when W is a diagonal matrix. arma::mat W_times_X(x_big.begin(), x_big.n_rows, x_big.n_cols, true); W_times_X.each_col() %= weights_big; // We obtain the diagonal entries of X^T * W * X for the denominators. arma::mat Xt_W_X = x_big.t() * W_times_X; arma::vec denoms = Xt_W_X.diag(); // Some temporary vectors which we use later. arma::vec temp_gamma(gamma.begin(), gamma.size(), true); double temp1; // Loop through the different gamma values which need to be updated. for(int i = 0; i < p; i++) { // Instead of excluding a column we simply set gamma_j = 0 to get the fitted // value without the effect of gamma_j. temp_gamma(i) = 0; temp1 = as_scalar(x_big.col(i).t() * (weights_big % (y_big - x_beta - x_big * temp_gamma))); gamma(i) = (cpp_sign(temp1) * cpp_max(abs(temp1) - lambda, 0.0))/denoms(i); temp_gamma(i) = gamma(i); } return gamma; }
// [[Rcpp::export]] arma::mat logSO3C(arma::mat R){ arma::mat I(3,3), logR(3,3); I.eye(); double theta = acos(0.5*trace(R)-0.5); if(theta < 0.0001){ logR.zeros(); return logR; } logR = (R-R.t())*theta/(2*sin(theta)); return logR; }
// Uses singular value decomposition function svd() from Armadillo. // Thus, be sure to define the following in /path/to/armadillo/include/armadillo_bits/config.hpp: // ARMA_USE_LAPACK // ARMA_USE_BLAS // ARMA_BLAS_UNDERSCORE int PCA::Run(const DataUnlabeledNormalized &data_unlabeled_normalized) { const int kNumTrainEx = data_unlabeled_normalized.num_train_ex(); assert(kNumTrainEx >= 1); const arma::mat kTrainingFeatures = \ data_unlabeled_normalized.training_features_normalized(); const arma::mat kCovMat = \ (1.0/(float)kNumTrainEx)*kTrainingFeatures.t()*kTrainingFeatures; const int kNumRows = kCovMat.n_rows; arma::mat left_sing_vec = arma::zeros<arma::mat>(kNumRows,kNumRows); arma::vec sing_val = arma::zeros<arma::vec>(kNumRows,1); arma::mat right_sing_vec = arma::zeros<arma::mat>(kNumRows,kNumRows); arma::svd(left_sing_vec,sing_val,right_sing_vec,kCovMat); this->set_left_sing_vec(left_sing_vec); this->set_sing_val(sing_val); return 0; }
// // [[Rcpp::export()]] arma::mat getEx2x2_ordIRT(const arma::mat &Ex, const arma::mat &Vx, const int N) { arma::mat Ex2x2(2, 2, arma::fill::zeros) ; arma::mat tmp(1, 1) ; tmp.fill(N) ; arma::mat S = tmp % Vx + Ex.t() * Ex ; Ex2x2(0, 0) = N ; Ex2x2(1, 1) = S(0,0) ; arma::mat sums = sum(Ex, 0) ; Ex2x2(1, 0) = sums(0,0) ; Ex2x2(0, 1) = sums(0,0) ; return(Ex2x2) ; }
double HMM::forwardProcedureCached() { //initialisation alpha_.col(0) = arma::trans(pi_ % B_.row(0)); c_(0) = arma::accu(alpha_.col(0)); alpha_.col(0) /= arma::as_scalar(c_(0)); //alpha_.print("alpha"); //c_.print("scale"); //iteration for(unsigned int t = 1; t < T_; ++t) { alpha_.col(t) = (A_.t() * alpha_.col(t-1)) % arma::trans(B_.row(t)); c_(t) = arma::accu(alpha_.col(t)); alpha_.col(t) /= arma::as_scalar(c_(t)); } pprob_ = arma::accu(arma::log(c_)); return pprob_; }
// [[Rcpp::export]] arma::rowvec meanQ4C(arma::mat Q) { //Compute the projected mean of the sample Q NumericMatrix Qss = as<NumericMatrix>(wrap(Q)); int cq4 = checkQ4(Qss); if(cq4){ throw Rcpp::exception("The data are not in Q4."); } arma::mat Qsq=Q.t()*Q; arma::mat eigvec; arma::vec eigval; arma::eig_sym(eigval,eigvec,Qsq); arma::vec qhat=eigvec.col(3); if(qhat[0]<0){ qhat = -qhat; } return qhat.t(); //Want to return it in a row vector so transpose it }
/** * Compute * * alpha = min(1, tau * alphahat(A, dA)) * * where * * alphahat = sup{ alphahat : A + dA is psd } * * See (2.18) of [AHO98] for more details. */ static inline double Alpha(const arma::mat& A, const arma::mat& dA, double tau) { // On Armadillo < 4.500, the "lower" option isn't available. #if (ARMA_VERSION_MAJOR < 4) || \ ((ARMA_VERSION_MAJOR == 4) && (ARMA_VERSION_MINOR < 500)) const arma::mat L = arma::chol(A).t(); // This is less efficient. #else const arma::mat L = arma::chol(A, "lower"); #endif const arma::mat Linv = arma::inv(arma::trimatl(L)); // TODO(stephentu): We only want the top eigenvalue, we should // be able to do better than full eigen-decomposition. const arma::vec evals = arma::eig_sym(-Linv * dA * Linv.t()); const double alphahatinv = evals(evals.n_elem - 1); double alphahat = 1. / alphahatinv; if (alphahat < 0.) // dA is PSD already alphahat = 1.; return std::min(1., tau * alphahat); }
// [[Rcpp::export]] arma::rowvec HnCpp(arma::mat Qs){ //Compute the Hn tests statistics int n = Qs.n_rows, i=0; arma::mat T = Qs.t()*Qs; arma::mat eigvec, eigvecJ; arma::vec eigval, eigvalJ; arma::eig_sym(eigval,eigvec,T); arma::rowvec Hn(n); arma::rowvec Qj; arma::mat Tj; for(i = 0;i<n; i++){ Qj = Qs.row(i); Tj = T-Qj.t()*Qj; arma::eig_sym(eigvalJ,eigvecJ,Tj); Hn(i)=(n-2)*(1+eigvalJ(3)-eigval(3))/(n-1-eigvalJ(3)); } return Hn; }
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); }
QUIC_SVD::QUIC_SVD(const arma::mat& dataset, arma::mat& u, arma::mat& v, arma::mat& sigma, const double epsilon, const double delta) : dataset(dataset) { // Since columns are sample in the implementation, the matrix is transposed if // necessary for maximum speedup. CosineTree* ctree; if (dataset.n_cols > dataset.n_rows) ctree = new CosineTree(dataset, epsilon, delta); else ctree = new CosineTree(dataset.t(), epsilon, delta); // Get subspace basis by creating the cosine tree. ctree->GetFinalBasis(basis); // Use the ExtractSVD algorithm mentioned in the paper to extract the SVD of // the original dataset in the obtained subspace. ExtractSVD(u, v, sigma); }
// // [[Rcpp::export()]] arma::mat getEx2x2(const arma::mat &Ex, const arma::mat &Vx, const int N, const int D ) { arma::mat Ex2x2(D + 1, D + 1, arma::fill::zeros) ; arma::mat tmp(D, D) ; tmp.fill(N) ; arma::mat S = tmp % Vx + Ex.t() * Ex ; // S.print("S") ; // (tmp % Vx).print("tmp") ; Ex2x2(0, 0) = N ; Ex2x2.submat(1, 1, D, D) = S ; arma::mat sums = sum(Ex, 0) ; for (int d = 0; d < D ; d++) { Ex2x2(d + 1, 0) = sums(0,d) ; Ex2x2(0, d + 1) = sums(0,d) ; } return(Ex2x2) ; }
// [[Rcpp::depends(RcppArmadillo)]] // [[Rcpp::export]] arma::mat FFBS(int t_T, double a2, arma::vec delta, arma::vec m0, arma::mat C0, Rcpp::List FF, arma::mat GG, Rcpp::List Eta_k) { int p = C0.n_rows; //create vectors for m, a arma::mat Alpha_k(p,t_T); arma::mat m(p,t_T); arma::mat a(p,t_T); Rcpp::List C; Rcpp::List R_inv; double a2_inv = (1.0/a2); for(int t = 0; t<t_T; t++) { arma::mat F_t = FF[t]; arma::vec Eta_kt = Eta_k[t]; arma::mat P_star(p,p); if(t == 0 ) { a.col(t) = GG*m0; P_star = GG*C0*GG.t(); } else { arma::mat C_tm1 = C[t - 1]; a.col(t) = GG*m.col(t - 1); P_star = GG*C_tm1*GG.t(); } //Rcpp::Rcout << "C_{t-1}: " << P_star << std::endl; arma::mat P_inv = P_star.i(); arma::vec f_t = F_t * a.col(t); arma::mat R_t = P_star; //if i were to think about not discounting it would be here R_t = P_t + W_t R_t.diag() = R_t.diag() + delta; arma::mat R_t_inv = R_t.i(); R_inv.push_back( R_t_inv ); // and here. W_t = diag( (1-delta)/delta C_{t-1}[1,1], .00001) //Rcpp::Rcout << "R_t: " << R_t << std::endl; arma::mat Q_t = F_t * R_t * F_t.t(); Q_t.diag() = Q_t.diag() + a2; //Woodbury Sherman Matrix Inversion arma::mat Q_inv_t = - a2_inv * F_t * arma::inv(R_t_inv + a2_inv * F_t.t() * F_t ) * a2_inv * F_t.t(); Q_inv_t.diag() = Q_inv_t.diag() + a2_inv; arma::mat A_t = R_t * F_t.t() * Q_inv_t; //Rcpp::Rcout << "A_t: " << A_t << std::endl; //Rcpp::Rcout << "R_t: " << R_t << std::endl; arma::mat C_t = R_t - A_t * Q_t * A_t.t(); C.push_back(C_t); m.col(t) = a.col(t) + A_t * (Eta_kt - f_t ); } //now do backward sampling for(int t = (t_T - 1); t>=0; t--) { arma::mat C_t = C[t]; if(t == (t_T - 1) ) { Alpha_k.col(t) = m.col(t) + arma::trans( arma::randn(1,p) * arma::chol(C_t) ); } else { arma::mat R_inv_tp1 = R_inv[t + 1]; arma::vec b = m.col(t) + C_t*GG.t()* R_inv_tp1 * (Alpha_k.col(t + 1) - a.col( t + 1) ); arma::mat B = C_t - C_t*GG.t()*R_inv_tp1*GG*C_t; Alpha_k.col(t) = b + arma::trans( arma::randn(1,p) * arma::chol(B) ); } }//end of backward sampling return Alpha_k; }
// **********************************************************// // Transpose // // **********************************************************// // [[Rcpp::export]] arma::mat transpose (arma::mat x) { return x.t(); }
void RandomizedSVD::Apply(const arma::mat& data, arma::mat& u, arma::vec& s, arma::mat& v, const size_t rank) { if (iteratedPower == 0) iteratedPower = rank + 2; // Center the data into a temporary matrix. arma::vec rowMean = arma::sum(data, 1) / data.n_cols; arma::mat R, Q, Qdata; ann::RandomInitialization randomInit; // Apply the centered data matrix to a random matrix, obtaining Q. if (data.n_cols >= data.n_rows) { randomInit.Initialize(R, data.n_rows, iteratedPower); Q = (data.t() * R) - arma::repmat(arma::trans(R.t() * rowMean), data.n_cols, 1); } else { randomInit.Initialize(R, data.n_cols, iteratedPower); Q = (data * R) - (rowMean * (arma::ones(1, data.n_cols) * R)); } // Form a matrix Q whose columns constitute a // well-conditioned basis for the columns of the earlier Q. if (maxIterations == 0) { arma::qr_econ(Q, v, Q); } else { arma::lu(Q, v, Q); } // Perform normalized power iterations. for (size_t i = 0; i < maxIterations; ++i) { if (data.n_cols >= data.n_rows) { Q = (data * Q) - rowMean * (arma::ones(1, data.n_cols) * Q); arma::lu(Q, v, Q); Q = (data.t() * Q) - arma::repmat(rowMean.t() * Q, data.n_cols, 1); } else { Q = (data.t() * Q) - arma::repmat(rowMean.t() * Q, data.n_cols, 1); arma::lu(Q, v, Q); Q = (data * Q) - (rowMean * (arma::ones(1, data.n_cols) * Q)); } // Computing the LU decomposition is more efficient than computing the QR // decomposition, so we only use in the last iteration, a pivoted QR // decomposition which renormalizes Q, ensuring that the columns of Q are // orthonormal. if (i < (maxIterations - 1)) { arma::lu(Q, v, Q); } else { arma::qr_econ(Q, v, Q); } } // Do economical singular value decomposition and compute only the // approximations of the left singular vectors by using the centered data // applied to Q. if (data.n_cols >= data.n_rows) { Qdata = (data * Q) - rowMean * (arma::ones(1, data.n_cols) * Q); arma::svd_econ(u, s, v, Qdata); v = Q * v; } else { Qdata = (Q.t() * data) - arma::repmat(Q.t() * rowMean, 1, data.n_cols); arma::svd_econ(u, s, v, Qdata); u = Q * u; } }
/* Set and get methods for the Kalman filter */ void kalmanFilter::setTransistion(arma::mat T) { transistionMatrix = T; transistionMatrixT = T.t(); }
int main() { // LOAD DATA arma::mat X; // A) Toy Data // char inputFile[] = "../data_files/toyclusters/toyclusters.dat"; // B) X4.dat //char inputFile[] = "./X4.dat"; // C) fisher data //char inputFile[] = "./fisher.dat"; // D) MNIST data //char inputFile[] = "../data_files/MNIST/MNIST.dat"; // E) Reduced MNIST (5000x400) //char inputFile[] = "../data_files/MNIST/MNISTreduced.dat"; // F) Reduced MNIST (0 and 1) (1000x400) //char inputFile[] = "../data_files/MNIST/MNISTlittle.dat"; // G) Girl.png (512x768, RGB, already unrolled) //char inputFile[] = "girl.dat"; // H) Pool.png (383x512, RGB, already unrolled) //char inputFile[] = "pool.dat"; // I) Cat.png (733x490, RGB, unrolled) //char inputFile[] = "cat.dat"; // J) Airplane.png (512x512, RGB, unrolled) //char inputFile[] = "airplane.dat"; // K) Monarch.png (512x768, RGB, unrolled) //char inputFile[] = "monarch.dat"; // L) tulips.png (512x768 ,RGB, unrolled) //char inputFile[] = "tulips.dat"; // M) demo.dat (2d data) char inputFile[] = "demo.dat"; // INITIALIZE PARAMETERS X.load(inputFile); const arma::uword N = X.n_rows; const arma::uword D = X.n_cols; arma::umat ids(N,1); // needed to shuffle indices later arma::umat shuffled_ids(N,1); for (arma::uword i = 0; i < N; ++i) { ids(i,0) = i; } arma::arma_rng::set_seed_random(); // set arma rng // int seed = time(NULL); // set RNG seed to current time // srand(seed); arma::uword initial_K = 32; // initial number of clusters arma::uword K = initial_K; arma::umat clusters(N,1); // contains cluster assignments for each data point for (arma::uword i = 0; i < N; ++i) { clusters(i, 0) = i%K; // initialize as [0,1,...,K-1,0,1,...,K-1,0,...] } arma::umat cluster_sizes(N,1,arma::fill::zeros); // contains num data points in cluster k for (arma::uword i = 0; i < N; ++i) { cluster_sizes(clusters(i,0), 0) += 1; } arma::mat mu(N, D, arma::fill::zeros); // contains cluster mean parameters arma::mat filler(D,D,arma::fill::eye); std::vector<arma::mat> sigma(N,filler); // contains cluster covariance parameters if (K < N) { // set parameters not belonging to any cluster to -999 mu.rows(K,N-1).fill(-999); for (arma::uword k = K; k < N; ++k) { sigma[k].fill(-999); } } arma::umat uword_dummy(1,1); // dummy 1x1 matrix; // for (arma::uword i = 0; i <N; ++i) { // std::cout << sigma[i] << std::endl; // } // std::cout << X << std::endl // << N << std::endl // << D << std::endl // << K << std::endl // << clusters << std::endl // << cluster_sizes << std::endl // << ids << std::endl; // INITIALIZE HYPER PARAMETERS // Dirichlet Process concentration parameter is alpha: double alpha = 1; // Dirichlet Process base distribution (i.e. prior) is // H(mu,sigma) = NIW(mu,Sigma|m_0,k_0,S_0,nu_0) = N(mu|m_0,Sigma/k_0)IW(Sigma|S_0,nu_0) arma::mat perturbation(D,D,arma::fill::eye); perturbation *= 0.000001; //const arma::mat S_0 = arma::cov(X,X,1) + perturbation; // S_xbar / N const arma::mat S_0(D,D,arma::fill::eye); const double nu_0 = D + 2; const arma::mat m_0 = mean(X).t(); const double k_0 = 0.01; // std::cout << "S_0" << S_0 << std::endl; // std::cout << S_0 << std::endl // << nu_0 << std::endl // << m_0 << std::endl // << k_0 << std::endl; // INITIALIZE SAMPLING PARAMETERS arma::uword NUM_SWEEPS = 250; // number of Gibbs iterations bool SAVE_CHAIN = false; // save output of each Gibbs iteration? // arma::uword BURN_IN = NUM_SWEEPS - 10; // arma::uword CHAINSIZE = NUM_SWEEPS - BURN_IN; // std::vector<arma::uword> chain_K(CHAINSIZE, K); // Initialize chain variable to initial parameters for convinience // std::vector<arma::umat> chain_clusters(CHAINSIZE, clusters); // std::vector<arma::umat> chain_clusterSizes(CHAINSIZE, cluster_sizes); // std::vector<arma::mat> chain_mu(CHAINSIZE, mu); // std::vector<std::vector<arma::mat> > chain_sigma(CHAINSIZE, sigma); // for (arma::uword sweep = 0; sweep < CHAINSIZE; ++sweep) { // std::cout << sweep << " K\n" << chain_K[sweep] << std::endl // << sweep << " clusters\n" << chain_clusters[sweep] << std::endl // << sweep << " sizes\n" << chain_clusterSizes[sweep] << std::endl // << sweep << " mu\n" << chain_mu[sweep] << std::endl; // for (arma::uword i = 0; i < N; ++i) { // std::cout << sweep << " " << i << " sigma\n" << chain_sigma[sweep][i] << std::endl; // } // } // START CHAIN std::cout << "Starting Algorithm with K = " << K << std::endl; for (arma::uword sweep = 0; sweep < NUM_SWEEPS; ++sweep) { // shuffle indices shuffled_ids = shuffle(ids); // std::cout << shuffled_ids << std::endl; // SAMPLE CLUSTERS for (arma::uword j = 0; j < N; ++j){ // std::cout << "j = " << j << std::endl; arma::uword i = shuffled_ids(j); arma::mat x = X.row(i).t(); // current data point // Remove i's statistics and any empty clusters arma::uword c = clusters(i,0); // current cluster cluster_sizes(c,0) -= 1; //std::cout << "old c = " << c << std::endl; if (cluster_sizes(c,0) == 0) { // remove empty cluster cluster_sizes(c,0) = cluster_sizes(K-1,0); // move entries for K onto position c mu.row(c) = mu.row(K-1); sigma[c] = sigma[K-1]; uword_dummy(0,0) = c; arma::uvec idx = find(clusters == K - 1); clusters.each_row(idx) = uword_dummy; cluster_sizes(K-1,0) = 0; mu.row(K-1).fill(-999); sigma[K-1].fill(-999); --K; } // quick test of logMvnPdf: // arma::mat m_(2,1); // arma::mat s_(2,2); // arma::mat t_(2,1); // m_ << 1 << arma::endr << 2; // s_ << 3 << -0.2 << arma::endr << -0.2 << 1; // t_ << -3 << arma::endr << -3; // double lpdf = logMvnPdf(t_, m_, s_); // std::cout << lpdf << std::endl; // śhould be -19.1034 (works) // Find categorical distribution over clusters (tested) arma::mat logP(K+1, 1, arma::fill::zeros); // quick test of logInvWishPdf // arma::mat si_(2,2), s_(2,2); // double nu_ = 4; // si_ << 1 << 0.5 << arma::endr << 0.5 << 4; // s_ << 3 << -0.2 << arma::endr << -0.2 << 1; // double lpdf = logInvWishPdf(si_, s_, nu_); // std::cout << lpdf << std::endl; // should be -7.4399 (it is) // quick test for logNormInvWishPdf // arma::mat si_(2,2), s_(2,2); // arma :: mat mu_(2,1), m_(2,1); // double k_ = 0.5, nu_ = 4; // si_ << 1 << 0.5 << arma::endr << 0.5 << 4; // s_ << 3 << -0.2 << arma::endr << -0.2 << 1; // mu_ << -3 << arma::endr << -3; // m_ << 1 << arma::endr << 2; // double lp = logNormInvWishPdf(mu_,si_,m_,k_,s_,nu_); // std::cout << lp << std::endl; // should equal -15.2318 (it is) // p(existing clusters) (tested) for (arma::uword k = 0; k < K; ++k) { arma::mat m_ = mu.row(k).t(); arma::mat s_ = sigma[k]; logP(k,0) = log(cluster_sizes(k,0)) - log(N-1+alpha) + logMvnPdf(x,m_,s_); } // p(new cluster): find partition function (tested) // arma::mat dummy_mu(D, 1, arma::fill::zeros); // arma::mat dummy_sigma(D, D, arma::fill::eye); // double logPrior, logLklihd, logPstr, logPartition; // posterior hyperparameters (tested) arma::mat m_1(D,1), S_1(D,D); double k_1, nu_1; k_1 = k_0 + 1; nu_1 = nu_0 + 1; m_1 = (k_0*m_0 + x) / k_1; S_1 = S_0 + x * x.t() + k_0 * (m_0 * m_0.t()) - k_1 * (m_1 * m_1.t()); // std::cout << k_1 << std::endl // << nu_1 << std::endl // << m_1 << std::endl // << S_1 << std::endl; // // partition = likelihood*prior/posterior (tested) // // (perhaps a direct computation of the partition function would be better) // logPrior = logNormInvWishPdf(dummy_mu, dummy_sigma, m_0, k_0, S_0, nu_0); // logLklihd = logMvnPdf(x, dummy_mu, dummy_sigma); // logPstr = logNormInvWishPdf(dummy_mu, dummy_sigma, m_1, k_1, S_1, nu_1); // logPartition = logPrior + logLklihd - logPstr; // std::cout << "log Prior = " << logPrior << std::endl // << "log Likelihood = " << logLklihd << std::endl // << "log Posterior = " << logPstr << std::endl // << "log Partition = " << logPartition << std::endl; // Computing partition directly double logS0,signS0,logS1,signS1; arma::log_det(logS0,signS0,S_0); arma::log_det(logS1,signS1,S_1); /*std::cout << "log(det(S_0)) = " << logS0 << std::endl << "log(det(S_1)) = " << logS1 << std::endl;*/ double term1 = 0.5*D*(log(k_0)-log(k_1)); double term2 = -0.5*D*log(arma::datum::pi); double term3 = 0.5*(nu_0*logS0 - nu_1*logS1); double term4 = lgamma(0.5*nu_1); double term5 = -lgamma(0.5*(nu_1-D)); double logPartition = term1+term2+term3+term4+term5; /*double logPartition = 0.5*D*(log(k_0)-log(k_1)-log(arma::datum::pi)) \ /+0.5*(nu_0*logS0 - nu_1*logS1) + lgamma(0.5*nu_1) - lgamma(0.5*(nu_1-D));*/ /* std::cout << "term1 = " << term1 << std::endl << "term2 = " << term2 << std::endl << "term3 = " << term3 << std::endl << "term4 = " << term4 << std::endl << "term5 = " << term5 << std::endl;*/ //std::cout << "logP = " << logPartition << std::endl; // p(new cluster): (tested) logP(K,0) = log(alpha) - log(N - 1 + alpha) + logPartition; // std::cout << "logP(new cluster) = " << logP(K,0) << std::endl; //if(i == 49) //assert(false); // sample cluster for i arma::uword c_ = logCatRnd(logP); clusters(i,0) = c_; //if (j % 10 == 0){ //std::cout << "New c = " << c_ << std::endl; //std::cout << "logP = \n" << logP << std::endl; //} // quick test for mvnRnd // arma::mat mu, si; // mu << 1 << arma::endr << 2; // si << 1 << 0.9 << arma::endr << 0.9 << 1; // arma::mat m = mvnRnd(mu, si); // std::cout << m << std::endl; // quick test for invWishRnd // double df = 4; // arma::mat si(2,2); // si << 1 << 1 << arma::endr << 1 << 1; // arma::mat S = invWishRnd(si,df); // std::cout << S << std::endl; if (c_ == K) { // Sample parameters for any new-born clusters from posterior cluster_sizes(K, 0) = 1; arma::mat si_ = invWishRnd(S_1, nu_1); //arma::mat si_ = S_1; arma::mat mu_ = mvnRnd(m_1, si_/k_1); //arma::mat mu_ = m_1; mu.row(K) = mu_.t(); sigma[K] = si_; K += 1; } else { cluster_sizes(c_,0) += 1; } // if (sweep == 0) // std::cout << " K = " << K << std::endl; // // if (j == N-1) { // // std::cout << logP << std::endl; // // std::cout << K << std::endl; // // assert(false); // // } // std::cout << "K = " << K << "\n" << std::endl; } // sample CLUSTER PARAMETERS FROM POSTERIOR for (arma::uword k = 0; k < K; ++k) { // std::cout << "k = " << k << std::endl; // cluster data arma::mat Xk = X.rows(find(clusters == k)); arma::uword Nk = cluster_sizes(k,0); // posterior hyperparameters arma::mat m_Nk(D,1), S_Nk(D,D); double k_Nk, nu_Nk; arma::mat sum_k = sum(Xk,0).t(); arma::mat cov_k(D, D, arma::fill::zeros); for (arma::uword l = 0; l < Nk; ++l) { cov_k += Xk.row(l).t() * Xk.row(l); } k_Nk = k_0 + Nk; nu_Nk = nu_0 + Nk; m_Nk = (k_0 * m_0 + sum_k) / k_Nk; S_Nk = S_0 + cov_k + k_0 * (m_0 * m_0.t()) - k_Nk * (m_Nk * m_Nk.t()); // sample fresh parameters arma::mat si_ = invWishRnd(S_Nk, nu_Nk); //arma::mat si_ = S_Nk; arma::mat mu_ = mvnRnd(m_Nk, si_/k_Nk); //arma::mat mu_ = m_Nk; mu.row(k) = mu_.t(); sigma[k] = si_; } std::cout << "Iteration " << sweep + 1 << "/" << NUM_SWEEPS<< " done. K = " << K << std::endl; // // STORE CHAIN // if (SAVE_CHAIN) { // if (sweep >= BURN_IN) { // chain_K[sweep - BURN_IN] = K; // chain_clusters[sweep - BURN_IN] = clusters; // chain_clusterSizes[sweep - BURN_IN] = cluster_sizes; // chain_mu[sweep - BURN_IN] = mu; // chain_sigma[sweep - BURN_IN] = sigma; // } // } } std::cout << "Final cluster sizes: " << std::endl << cluster_sizes.rows(0, K-1) << std::endl; // WRITE OUPUT DATA TO FILE arma::mat MU = mu.rows(0,K-1); arma::mat SIGMA(D*K,D); for (arma::uword k = 0; k < K; ++k) { SIGMA.rows(k*D,(k+1)*D-1) = sigma[k]; } arma::umat IDX = clusters; // A) toycluster data // char MuFile[] = "../data_files/toyclusters/dpmMU.out"; // char SigmaFile[] = "../data_files/toyclusters/dpmSIGMA.out"; // char IdxFile[] = "../data_files/toyclusters/dpmIDX.out"; // B) X4.dat char MuFile[] = "dpmMU.out"; char SigmaFile[] = "dpmSIGMA.out"; char IdxFile[] = "dpmIDX.out"; std::ofstream KFile("K.out"); MU.save(MuFile, arma::raw_ascii); SIGMA.save(SigmaFile, arma::raw_ascii); IDX.save(IdxFile, arma::raw_ascii); KFile << "K = " << K << std::endl; if (SAVE_CHAIN) {} // std::ofstream chainKFile("chainK.out"); // std::ofstream chainClustersFile("chainClusters.out"); // std::ofstream chainClusterSizesFile("chainClusterSizes.out"); // std::ofstream chainMuFile("chainMu.out"); // std::ofstream chainSigmaFile("chainSigma.out"); // chainKFile << "Dirichlet Process Mixture Model.\nInput: " << inputFile << std::endl // << "Number of iterations of Gibbs Sampler: " << NUM_SWEEPS << std::endl // << "Burn-In: " << BURN_IN << std::endl // << "Initial number of clusters: " << initial_K << std::endl // << "Output: Number of cluster (K)\n" << std::endl; // chainClustersFile << "Dirichlet Process Mixture Model.\nInput: " << inputFile << std::endl // << "Number of iterations of Gibbs Sampler: " << NUM_SWEEPS << std::endl // << "Burn-In: " << BURN_IN << std::endl // << "Initial number of clusters: " << initial_K << std::endl // << "Output: Cluster identities (clusters)\n" << std::endl; // chainClusterSizesFile << "Dirichlet Process Mixture Model.\nInput: " << inputFile << std::endl // << "Number of iterations of Gibbs Sampler: " << NUM_SWEEPS << std::endl // << "Burn-In: " << BURN_IN << std::endl // << "Initial number of clusters: " << initial_K << std::endl // << "Output: Size of clusters (cluster_sizes)\n" << std::endl; // chainMuFile << "Dirichlet Process Mixture Model.\nInput: " << inputFile << std::endl // << "Number of iterations of Gibbs Sampler: " << NUM_SWEEPS << std::endl // << "Burn-In: " << BURN_IN << std::endl // << "Initial number of clusters: " << initial_K << std::endl // << "Output: Samples for cluster mean parameters (mu. Note: means stored in rows)\n" << std::endl; // chainSigmaFile << "Dirichlet Process Mixture Model.\nInput: " << inputFile << std::endl // << "Number of iterations of Gibbs Sampler: " << NUM_SWEEPS << std::endl // << "Burn-In " << BURN_IN << std::endl // << "Initial number of clusters: " << initial_K << std::endl // << "Output: Samples for cluster covariances (sigma)\n" << std::endl; // for (arma::uword sweep = 0; sweep < CHAINSIZE; ++sweep) { // arma::uword K = chain_K[sweep]; // chainKFile << "Sweep #" << BURN_IN + sweep + 1 << "\n" << chain_K[sweep] << std::endl; // chainClustersFile << "Sweep #" << BURN_IN + sweep + 1 << "\n" << chain_clusters[sweep] << std::endl; // chainClusterSizesFile << "Sweep #" << BURN_IN + sweep + 1 << "\n" << chain_clusterSizes[sweep].rows(0, K - 1) << std::endl; // chainMuFile << "Sweep #" << BURN_IN + sweep + 1 << "\n" << chain_mu[sweep].rows(0, K - 1) << std::endl; // chainSigmaFile << "Sweep #" << BURN_IN + sweep + 1<< "\n"; // for (arma::uword i = 0; i < K; ++i) { // chainSigmaFile << chain_sigma[sweep][i] << std::endl; // } // chainSigmaFile << std::endl; // } // } return 0; }
// The number of users should always be a positive integer. // The number of movies should always be a positive integer. // The number of features should always be a positive integer. int CollaborativeFiltering::ComputeGradient(const DataUnlabeled &ratings_data, const DataUnlabeled &indicator_data,int num_users,int num_movies, int num_features) { assert(num_users >= 1); assert(num_movies >= 1); assert(num_features >= 1); const int kTotalNumFeatures = num_features*(num_users+num_movies); const arma::vec kCurrentTheta = theta(); arma::mat features_cvec = arma::zeros<arma::mat>(num_movies*num_features,1); arma::mat params_cvec = arma::zeros<arma::mat>(num_users*num_features,1); for(int feature_index=0; feature_index<kTotalNumFeatures; feature_index++) { if (feature_index < (num_users*num_features)) { params_cvec(feature_index) = kCurrentTheta[feature_index]; } else { features_cvec(feature_index-(num_users*num_features)) = \ kCurrentTheta[feature_index]; } } arma::mat features_cvec_squared = arma::square(features_cvec); arma::mat params_cvec_squared = arma::square(params_cvec); arma::mat params_mat = arma::reshape(params_cvec,num_users,num_features); arma::mat features_mat = \ arma::reshape(features_cvec,num_movies,num_features); const arma::mat kSubsetIndicatorMat = \ indicator_data.training_features().submat(0,0,num_movies-1,num_users-1); const arma::mat kSubsetRatingsMat = \ ratings_data.training_features().submat(0,0,num_movies-1,num_users-1); const arma::mat kYMat = \ (arma::ones<arma::mat>(num_users,num_movies)-kSubsetIndicatorMat.t()) % \ (params_mat*features_mat.t())+kSubsetRatingsMat.t(); const arma::mat kDiffMat = (params_mat*features_mat.t()-kYMat).t(); arma::mat grad_params_arr = arma::zeros<arma::mat>(num_users*num_features,1); arma::mat grad_params_arr_reg = \ arma::zeros<arma::mat>(num_users*num_features,1); for(int grad_index=0; grad_index<(num_users*num_features); grad_index++) { int user_index = 1+(grad_index % num_users); int feature_index = 1+((grad_index-(grad_index % num_users))/num_users); grad_params_arr(grad_index) = \ arma::as_scalar(sum(kDiffMat.col(user_index-1) % \ features_mat.col(feature_index-1))); grad_params_arr_reg(grad_index) = \ grad_params_arr(grad_index)+lambda_*params_cvec(grad_index); } arma::mat grad_features_arr = \ arma::zeros<arma::mat>(num_movies*num_features,1); arma::mat grad_features_arr_reg = \ arma::zeros<arma::mat>(num_movies*num_features,1); for(int grad_index=0; grad_index<(num_movies*num_features); grad_index++) { int movie_index = 1+(grad_index % num_movies); int feature_index = 1+((grad_index-(grad_index % num_movies))/num_movies); grad_features_arr(grad_index) = \ arma::as_scalar(sum(kDiffMat.row(movie_index-1) % \ (params_mat.col(feature_index-1)).t())); grad_features_arr_reg(grad_index) = \ grad_features_arr(grad_index)+lambda_*features_cvec(grad_index); } arma::vec gradient_array_reg = arma::zeros<arma::vec>(kTotalNumFeatures); gradient_array_reg.subvec(0,(num_users*num_features-1)) = \ grad_params_arr_reg; gradient_array_reg.subvec(num_users*num_features,kTotalNumFeatures-1) = \ grad_features_arr_reg; set_gradient(gradient_array_reg); return 0; }
/** Internal function that gives the output in c++ way (writes into allocated memory). * See glm_ridge_c for a wrapper that is being called from R. */ void glm_ridge( vec& beta, // output: regression coefficients (contains intercept) double& loss, // output: value of the loss function vec& w, // output: weights of the pseudo-gaussian observations at the optimum (needed for Student-t model) int& qau, // output: number of quadratic approximation updates arma::mat x, Function pseudo_obs, double lambda, bool intercept, arma::vec penalty, // relative penalties for the variables double thresh, int qa_updates_max, int ls_iter_max=50, bool debug=false) { if (intercept) { // add a vector of ones to x and set zero penalty for the intercept x = join_horiz(ones<vec>(x.n_rows), x); penalty = join_vert(zeros<vec>(1), penalty); } int n = x.n_rows; int D = x.n_cols; int ls_iter; // counts linesearch iterations int j; double t; // step size in line search double a = 0.1; // backtracking line search parameters a and b (see Boyd and Vandenberghe, 2004) double b = 0.5; // initialization vec beta_new(D); beta_new.zeros(); vec dbeta(D); dbeta.zeros(); vec grad(D); grad.zeros(); // gradient of the negative log likelihood w.r.t. the regression coefficients vec grad_f(n); grad_f.zeros(); // pointwise gradient of the negative log likelihood w.r.t. the latent values f vec f = x*beta; mat xw(n,D); // this will be the weighted x mat regmat = lambda*diagmat(penalty);//eye(D,D); // regularization matrix // initial quadratic approximation List obs = pseudo_obs(f,w); vec z = as<vec>(obs["z"]); w = as<vec>(obs["w"]); grad_f = as<vec>(obs["grad"]); double loss_initial = ((double) obs["loss"]) + elnet_penalty(beta, lambda, 0, penalty); double loss_old = loss_initial; // will be updated iteratively loss = loss_initial; // will be updated iteratively double tol = thresh*fabs(loss_initial); // threshold for convergence double decrement = 0; // newton decrement, used to monitor convergence qau = 0; while (qau < qa_updates_max) { // weight the observations for (j=0; j<D; ++j) xw.col(j) = x.col(j) % sqrt(w); // weighted least squares solution beta_new = solve( xw.t()*xw + regmat, xw.t()*(sqrt(w)%z) ); dbeta = beta_new - beta; grad = x.t()*grad_f + lambda*penalty%beta; // gradient of negative log likelihood + gradient of penalty decrement = -sum(grad%dbeta); // newton decrement // check for convergence if (decrement < tol) break; // backtracking line search t = 1.0/b; ls_iter = 0; while (ls_iter < ls_iter_max) { t = b*t; f = x*(beta+t*dbeta); obs = pseudo_obs(f,w); loss = ((double) obs["loss"]) + elnet_penalty(beta+t*dbeta, lambda, 0, penalty); ++ls_iter; if (std::isnan(loss)) continue; if (decrement > 0) { if (loss < loss_old - a*t*decrement ) break; } else { Rcpp::Rcout << "The search direction is not a descent direction "; Rcpp::Rcout << "(newton decrement = " << decrement << ", should be positive), "; Rcpp::Rcout << ", this is likely a bug. Please report to the developers." << '\n'; } } if (ls_iter == ls_iter_max && ls_iter_max > 1) { // beta.print("beta = "); // dbeta.print("dbeta = "); // grad.print("grad = "); // Rcpp::Rcout << "loss = " << loss << "\n"; // Rcpp::Rcout << "loss_initial = " << loss_initial << "\n"; // Rcpp::Rcout << "tol = " << tol << "\n"; // Rcpp::Rcout << "decrement = " << decrement << "\n"; // Rcpp::Rcout << "\n\n"; Rcpp::Rcout << "glm_ridge warning: maximum number of line search iterations reached. The optimization can be ill-behaved.\n"; break; } // update the solution beta = beta + t*dbeta; z = as<vec>(obs["z"]); w = as<vec>(obs["w"]); grad_f = as<vec>(obs["grad"]); loss_old = loss; ++qau; } if (qau == qa_updates_max && qa_updates_max > 1) { if (decrement/fabs(loss_initial) > 100*tol) { // warn the user if the max number of iterations is reached and we are relatively far // (two orders of magnitude) from the given convergence threshold Rcpp::Rcout << "glm_ridge warning: maximum number of quadratic approximation updates reached, within "; Rcpp::Rcout << decrement << " from optimum (tolerance = " << thresh << ").\n"; } } }
// funcao FFBS para regressao com V constante e fator de desconto Rcpp::List drmOnly1FFBSdiscW(arma::mat Y, arma::mat X, arma::mat dV, double discW, arma::vec m0, arma::mat ZC0) { int T = Y.n_rows; // ATENCAO: matriz de dados deve entrar T x q!! int q = Y.n_cols; int r = q*X.n_cols; // ATENCAO: matriz de exogenas deve entrar sendo T x p mat Yt = Y.t(); mat I_q = diagmat(ones(q)); // FORWARD FILTERING mat mm(r, T+1); vec aa(r);//nao e' preciso armazenar aa_t mat RR(r, r);//nao e' preciso armazenar RR_t vec ff(q); //nao e' preciso armazenar ff mat QQ(q, q); //nao e' preciso armazenar seus valores mat AA; mat ee; mat FF; //para previsao, e' preciso armazenar W_{T+1} mat dVInv = inv(dV); //parametros para forma quadrada mat ZR; mat ZC(r, r); //utilizado para fazer a amostragem retrospectiva //objetos para decomposicao em valores singulares e espectral mat L, Eigvec; vec eigval; double sqrtDiscW = sqrt(discW); double sqrt1mDiscW = sqrt(1-discW); //para evitar o loop da amostragem retrospectiva, recorri a uma propriedade //do FFBS com o uso do fator de desconto. //O que observei e' que //th_{t-k} = (1-delta) \sum delta^j m_{t-k+j} + delta^k m_T + \sum delta^j e_{T-k+j} //IntegerVector seq0toT = seq_len(T+1)-1; //vec powDiscW = exp(log(discW)*as<NumericVector>(seq0toT)); //mat Dmat(T+1, T+1); Dmat.zeros(); //valores aleatorios gerados mat th = randn(r, T+1); mm.col(0) = m0; ZC = ZC0; th.col(0) = sqrt1mDiscW*ZC*th.col(0); //Dmat.submat(0, 0, T, 0) = powDiscW.subvec(0, T); for (int k = 1; k < (T+1); k++) { //evolucao aa = mm.col(k-1); ZR = ZC/sqrtDiscW; RR = ZR * ZR.t(); //predicao FF = kron(I_q, X.row(k-1)).t(); ff = FF.t()*aa; QQ = symmatu(FF.t() * RR * FF + dV); //atualizacao L = ZR.t()*FF; //forma raiz quadrada eig_sym(eigval, Eigvec, L * dVInv * L.t()); ZC = ZR * Eigvec * diagmat(1.0/sqrt(eigval + 1.0)); AA = ZC*ZC.t()*FF*dVInv; //p.105 West & Harrison (1997) ee = Yt.col(k-1) - ff; mm.col(k) = aa + AA*ee; th.col(k) = sqrt1mDiscW*ZC*th.col(k); mm.col(k-1) -= discW*mm.col(k-1); //mm agora representa mm* //Dmat.submat(k, k, T, k) = powDiscW.subvec(0, T-k); } // BACKWARD SAMPLING //simulacao dos estados sem loop /* th = (mm+th)*Dmat; rowvec oneP = ones(X.n_cols); mat Mu = kron(I_q, oneP) * (th.cols(1, T) % repmat(X.t(), q, 1)); */ mat Mu(q, T); th.col(T) += mm.col(T); for(int k = 0; k < T; k++) { th.col(T-1-k) += mm.col(T-1-k) + discW*th.col(T-k); Mu.col(T-1-k) = kron(I_q, X.row(T-1-k))*th.col(T-k); } return Rcpp::List::create(Named("th") = th, Named("Mu") = Mu.t(), Named("ZW") = sqrt((1-discW)/discW)*ZC); }
// [[Rcpp::export]] Rcpp::List getWEXPcutoff(arma::mat data, arma::mat subdata, arma::mat Y, arma::mat subY, int N, arma::mat RT_out, double predictTime, arma::vec resid_sco, double fitvar, arma::colvec cutoffs){ //create dataD arma::mat dataDuns = data.rows(find(data.col(1)==1)); arma::mat dataD = dataDuns.rows(sort_index(dataDuns.col(0))); int n = data.n_rows, nD = dataD.n_rows, np = Y.n_cols, ncuts = subdata.n_rows; //guide colvec times = data.col(0); // status= data.col(1); // Dtimes = dataD.col(0); // weights = data.col(4); // Dweights = dataD.col(4); uvec tmpind = find((data.col(0) <= predictTime)%data.col(1)); // indices of (data$times<=predict.time)&(data$status==1) mat myempty(1,1); uvec tmpindT = conv_to<uvec>::from(CSumI(times.elem(tmpind), 4, dataD.col(0), myempty, FALSE)); colvec rrk = exp(data.col(6)); //data.col(6) is data$linearY // build riskmat mat riskmat(n, nD); mat::iterator riskmat_it = riskmat.begin(); for(colvec::iterator j = dataD.begin_col(0); j != dataD.end_col(0); j++){ for( colvec::iterator i = data.begin_col(0); i != data.end_col(0); i++){ *riskmat_it = *i >= *j; riskmat_it++; } } //s0 and s1 colvec s0 = riskmat.t()*(rrk%data.col(4)); colvec s1 = riskmat.t()*trans(Vec2Mat(rrk%data.col(4), np)%Y.t()); //haz0 and cumhaz0 colvec haz0 = dataD.col(4)/sum(riskmat%trans(Vec2Mat(rrk%data.col(4), nD))).t(); colvec cumhaz0 = cumsum(haz0); colvec ptvec(1); ptvec(0) = predictTime; colvec cumhaz_t0 = CSumI(ptvec, 4, dataD.col(0), haz0, TRUE); //Wexp colvec Wexp_beta = resid_sco*fitvar*N; colvec WexpLam1(n); WexpLam1.zeros(n); WexpLam1(tmpind) = N/s0(tmpindT - 1); WexpLam1 = WexpLam1 - CSumI( myPmin(data.col(0), predictTime), 4, dataD.col(0), haz0/s0, TRUE)%rrk*N; colvec WexpLam2 = Wexp_beta*CSumI(ptvec, 4, dataD.col(0), haz0%s1/trans(Vec2Mat(s0, np)), TRUE); colvec WexpLam = WexpLam1 - WexpLam2; //Fyk = Pr(Sy < c) colvec Fyk = CSumI( cutoffs, 4, data.col(6), data.col(4), TRUE)/sum(data.col(4)); colvec dFyk(Fyk.n_elem); dFyk(0) = 0; dFyk(span(1, Fyk.n_elem - 1)) = Fyk(span(0, Fyk.n_elem-2)); dFyk = Fyk - dFyk; colvec Sy = subdata.col(5); colvec Syall = data.col(5); colvec St0_Fyk = cumsum(Sy%dFyk); double St0 = max(St0_Fyk); colvec St0_Syk = St0 - St0_Fyk; // mat Wexp_Cond_Stc = -Vec2Mat(Sy%exp(subdata.col(6)), n)%(trans(Vec2Mat(WexpLam, ncuts)) +as_scalar(cumhaz_t0)*Wexp_beta*subY.t()); mat tmpmat = conv_to<mat>::from(trans(Vec2Mat(data.col(6), ncuts)) > Vec2Mat(cutoffs, n)); mat Wexp_Stc = trans(CSumI(cutoffs, 0, subdata.col(6), Wexp_Cond_Stc.t()%Vec2Mat(dFyk, n).t(), TRUE)) + trans(Vec2Mat(Syall,ncuts))%tmpmat - Vec2Mat(St0_Syk, n); colvec Wexp_St = sum(trans(Wexp_Cond_Stc)%trans(Vec2Mat(dFyk, n))).t() + Syall - St0; mat Wexp_Fc = 1-tmpmat - Vec2Mat(Fyk, n); //assemble for classic performance measures, given linear predictor List out(8); out[0] = -Wexp_Cond_Stc; out[1] = Wexp_Fc; mat Wexp_St_mat = Vec2Mat(Wexp_St, ncuts).t(); out[2] = (-Wexp_St_mat%Vec2Mat(RT_out.col(3), n) + Wexp_Stc)/St0; out[3] = (Wexp_St_mat%Vec2Mat(RT_out.col(4), n) -Wexp_Fc - Wexp_Stc)/(1-St0); out[4] = -Wexp_St; out[5] = (Wexp_St_mat - Wexp_Stc - Vec2Mat(RT_out.col(6), n)%Wexp_Fc)/Vec2Mat(Fyk, n); out[6] = (Vec2Mat(RT_out.col(5)-1, n)%Wexp_Fc - Wexp_Stc)/Vec2Mat(1-Fyk, n); out[7] = Wexp_beta; return out; }
Rcpp::List irls_binomial_cpp_fast_br(arma::mat A, arma::vec b, double maxit, double tol) { //Def arma::vec x; x.zeros(A.n_cols,1); arma::vec xold; arma::mat varmatrix; double nobs; nobs = A.n_rows; double df; df = A.n_cols; double n; double ll; double aic; double bic; double mdl; arma::vec W(nobs); arma::vec unit(nobs); unit.ones(nobs); arma::vec eta(nobs); arma::vec g(nobs); arma::vec gprime(nobs); arma::vec z(nobs); //mod arma::vec bprime(nobs); //int k; for (int i = 0; i < maxit; ++i) { eta = A * x; for (int j=0; j < nobs; ++j) { g[j] = 1.0 / (1.0 + exp(-1.0 * eta[j])); gprime[j] = exp (-1.0 * eta[j]) / ((1.0 + exp (-1.0 * eta[j])) * (1.0 + exp (-1.0 * eta[j]))); //mod bprime[j] = (b[j]+(df/nobs)*(0.5))/(1+(df/nobs)); //bprime[j] = b[j]+(sum(b)/nobs)*(0.5); } //z = eta+(b-g)/gprime; z = eta+(bprime-g)/gprime; W = (gprime % gprime); W /= (g % (unit-g)); //W += unit; xold = x; //coefficients //x = arma::solve(A.t()*(W % A.each_col()), A.t()*(W % z), arma::solve_opts::no_approx); varmatrix = A.t()*(W % A.each_col()); x = arma::solve(varmatrix, A.t()*(W % z), arma::solve_opts::no_approx); //k = i; if(sqrt(arma::dot(x-xold,x-xold)) < tol){ break; }} n = A.n_rows; //arma::vec e; //double ssr; //e = (b - A*x); //e = (bprime - A*x); //ssr = accu(e.t()*e); //scores //ll = arma::accu(-arma::dot(b,log(unit + exp(-(A*x)))) - arma::dot((unit-b),log(unit + exp(A*x)))); ll = arma::accu(-arma::dot(b,log(unit + exp(-(A*x)))) - arma::dot((unit-b),log(unit + exp(A*x)))); aic = - 2 * ll + 2 * df; bic = - 2 * ll + log(nobs) * df; //mdl // arma::mat xz; // xz.zeros(size(x)); // // arma::vec ez; // double ssrz; // double ssrtot; // double RR; // double F; // double mdl; // arma::vec yaverage(n); // // ez = (b - A*xz); // ssrz = accu(ez.t()*ez); // F = (((ssrz - ssr)/df)/(ssr/((n-(df + 1))))); // // for (int j=0; j < n; ++j) { // yaverage[j] = b[j] - arma::mean(b); // } // // ssrtot = accu(yaverage.t()*yaverage); // // RR = 1-(ssr/ssrtot); // // if (RR > (df/n)) { // mdl = (n/2) * log(ssr/(n-df)) + (df/2) * log(F) + log(n); // } else { // mdl = (n/2) * log((accu(b.t()*b))/n) + 0.5 * log(n); // } //return return Rcpp::List::create( Rcpp::Named("loglik") = ll, Rcpp::Named("aic") = aic, Rcpp::Named("bic") = bic, Rcpp::Named("mdl") = mdl ); }
void kalmanFilter::setMeasurement(arma::mat M) { measurementMatrix = M; measurementMatrixT = M.t(); }
/// /// \brief Vespucci::Math::DimensionReduction::VCA /// Vertex Component Analysis /// \param R The dataset /// \param endmembers Number of endmembers to compute /// \param indices Row indices of pure components. /// \param endmember_spectra Spectra of pure components (note that these are in /// columns, not rows as in spectra_) /// \param projected_data Projected data /// \param fractional_abundances Purity of a given spectrum relative to endmember /// \return Convergeance (no actual test implemented...) /// bool Vespucci::Math::DimensionReduction::VCA(const arma::mat &R, arma::uword p, arma::uvec &indices, arma::mat &endmember_spectra, arma::mat &projected_data, arma::mat &fractional_abundances) { //Initializations arma::uword L = R.n_rows; arma::uword N = R.n_cols; if (L == 0 || N == 0){ std::cerr << "No data!" << std::endl; return false; } if (p > L){ std::cerr << "wrong number of endmembers (" << p << ")!"<< std::endl; std::cerr << "set to 5 or one less than number of spectra" << std::endl; p = (L < 5? 5: L-1); } //mat of SNR arma::mat r_m = mean(R, 1); arma::mat R_m = arma::repmat(r_m, 1, N); //the mean of each spectral band arma::mat R_o = R - R_m; //mean-center the data arma::mat Ud; arma::vec Sd; arma::mat Vd; //arma::svds(Ud, Sd, Vd, arma::sp_mat(R_o * R_o.t()/N), p); Vespucci::Math::DimensionReduction::svds(R_o*R_o.t()/N, p, Ud, Sd, Vd); arma::mat x_p; try{ x_p = Ud.t() * R_o; }catch(std::exception e){ std::cout << "Ud.t() * R_o" << std::endl; } double SNR = Vespucci::Math::DimensionReduction::estimate_snr(R, r_m, x_p); double SNR_th = 15 + 10*log10(p); //Choose projective projection or projection to p-1 subspace arma::mat y; if (SNR < SNR_th){ arma::uword d = p - 1; Ud = Ud.cols(0, d-1); projected_data = Ud * x_p.rows(0, d-1) + R_m; //in dimension L arma::mat x = x_p.rows(0, d-1);//x_p = trans(Ud)*R_o, p-dimensional subspace //following three lines are one in arma::matlab... arma::mat sum_squares = sum(pow(x, 2)); double c = sum_squares.max(); c = std::sqrt(c); y = arma::join_vert(x, c*arma::ones(1, N)); } else{ arma::uword d = p; Vespucci::Math::DimensionReduction::svds(R*R.t()/N, p, Ud, Sd, Vd); arma::svds(Ud, Sd, Vd, arma::sp_mat(R*R.t()/N), d);//R_o is a mean centered version... x_p = Ud.t() * R; projected_data = Ud * x_p.rows(0, d-1); arma::mat x = Ud.t() * R; arma::mat u = arma::mean(x, 1); y = x / arma::repmat(sum(x % arma::repmat(u, 1, N)), d, 1); } // The VCA algorithm arma::vec w; w.set_size(p); arma::vec f; arma::rowvec v; indices.set_size(p); //there are no fill functions for arma::uvecs for (arma::uword i = 0; i < p; ++i) indices(i) = 0; arma::mat A = arma::zeros(p, p); double v_max; double sum_squares; arma::uvec q1; A(p-1, 0) = 1; for (arma::uword i = 0; i < p; ++i){ w.randu(); f = w - A*arma::pinv(A)*w; sum_squares = sqrt(sum(square(f))); f /= sum_squares; v = f.t() * y; v_max = arma::max(abs(v)); q1 = arma::find(abs(v) == v_max, 1); indices(i) = q1(0); A.col(i) = y.col(indices(i)); //same as x.col(indices(i)); } endmember_spectra = projected_data.cols(indices); fractional_abundances = arma::trans(pinv(endmember_spectra) * projected_data); return true; }
CVXOBJ cvxObj(double t, arma::mat Postprob, arma::rowvec wght, arma::mat x, arma::mat y, arma::mat n, arma::mat ab, arma::mat F, arma::vec h, unsigned int N, unsigned int Nrep ){ unsigned int m = F.n_rows; unsigned int K = Postprob.n_cols; arma::vec d(m); arma::mat D(m,m); arma::mat J(2,K); arma::mat H_d(2,K); arma::mat H_o(2,K); arma::mat n_ab(N,Nrep*K); arma::mat x_a(N,Nrep*K); arma::mat y_b(N,Nrep*K); arma::mat dn_ab(K,K); arma::mat dx_a(K,K); arma::mat dy_b(K,K); arma::mat px(N,K); // List out(3); double f; arma::vec g(2*K); arma::mat H(2*K,2*K); J.zeros(); H_d.zeros(); H_o.zeros(); d = F * vectorise(ab) - h; D = diagmat(1 / d); n_ab = N_ab(n,sum(ab,0)); x_a = N_ab(x,ab.row(0)); y_b = N_ab(y,ab.row(1)); J =mydigamma( ones(2,1) * sum(ab,0) ) % (ones(2,1)*wght) * Nrep; cmpDgm(N_ab(n,sum(ab,0)),K).t() * Postprob; mydigamma(ab) % (ones(2,1)*wght) *Nrep; dn_ab = cmpDgm(n_ab,K).t() * Postprob; dx_a = cmpDgm(x_a,K) .t() * Postprob; dy_b = cmpDgm(y_b,K) .t() * Postprob; J =mydigamma( ones(2,1) * sum(ab,0) ) % (ones(2,1)*wght) * Nrep - mydigamma(ab) % (ones(2,1)*wght) *Nrep; for (unsigned int i=0;i<K;i++){ J(0,i) += dx_a(i,i) - dn_ab(i,i); J(1,i) += dy_b(i,i) - dn_ab(i,i); } // compute the trigamma for hessian // repeatedly use dn_ab, dx_a, dy_b; H_d represents the diagnal; H_o off diagnal of H dn_ab = cmpTgm(n_ab,K).t() * Postprob; dx_a = cmpTgm(x_a,K) .t() * Postprob; dy_b = cmpTgm(y_b,K) .t() * Postprob; H_d = mytrigamma( ones(2,1) * sum(ab,0) ) % (ones(2,1)*wght) * Nrep - mytrigamma(ab) % (ones(2,1)*wght) *Nrep; for (unsigned int i=0;i<K;i++){ H_d(0,i) += dx_a(i,i) - dn_ab(i,i); // H_d(1,i) += dy_b(i,i) - dn_ab(i,i); } H_o = ( mytrigamma( ones(2,1) * sum(ab,0) ) % (ones(2,1)*wght) * Nrep ) - ones(2,1) * dn_ab.diag().t(); H = diagmat(vectorise(H_d)); for(unsigned int i=0;i<K;i++){ H(2*i,1+2*i) = H_o(1,i); H(1+2*i,2*i) = H_o(1,i); } // likelihood computation px = Nrep*mylgamma(ones(N,1)*sum(ab,0)) - Nrep*mylgamma(ones(N,1)*ab.row(0)) - Nrep*mylgamma(ones(N,1)*ab.row(1)) - cmpLgm(n_ab,K) + cmpLgm(x_a,K) + cmpLgm(y_b,K); g = -t * vectorise(J) - F.t() * D * ones(m,1); // g first dierivatives of the function H = -t * H; // H Hessian for (unsigned int i=0;i<m;i++){ d(i) = log(-d(i)); } f = -t * accu(px % Postprob) - sum(d); // f value for output function return {g,H,f}; }
//' Matrix left-multiplied by its transpose //' //' Given matrix A, the procedure returns A'A. //' //' @param x Numeric matrix. // [[Rcpp::export]] arma::mat tmult(arma::mat x) { return(x.t()*x); }
//[[Rcpp::export]] List cmpHmm(const arma::mat x, arma::mat y, arma::mat trans, arma::mat ab, arma::mat F, arma::vec h){ unsigned int Nrep = x.n_cols; unsigned int K = ab.n_cols; unsigned int N = x.n_rows; unsigned int Nit = 30; double t_step; double mu = 1e6; double PRECISION = 1e8; double t_INITIAL = 1; double ALPHA = 0.1; double BETA = 0.7; double NTTOL = 1e-6; double s; double lambda; List out(4); CVXOBJ cvx; CVXOBJ cvx_new; arma::mat n = x + y; arma::mat Dens(N,K); arma::mat Forward(N,K); arma::mat Backward(N,K); arma::mat Postprob(N,K); arma::rowvec wght(K); arma::vec Scale(N); Backward.row(N-1).fill(0); Scale(0) = 1.0; arma::vec logl; logl.zeros(Nit+1); arma::vec v(2*K); // inverse(H)*J for(unsigned int nit=0;nit<Nit;nit++){ Dens = exp( Nrep*mylgamma(ones(N,1)*sum(ab,0)) - Nrep*mylgamma(ones(N,1)*ab.row(0)) - Nrep*mylgamma(ones(N,1)*ab.row(1)) - cmpLgm(N_ab(n,sum(ab,0)),K) + cmpLgm(N_ab(x,ab.row(0)),K) + cmpLgm(N_ab(y,ab.row(1)),K) + mylgamma(n+1.0) * ones(Nrep,K) - mylgamma(x+1.0) * ones(Nrep,K) - mylgamma(y+1.0) * ones(Nrep,K) ); Forward.row(0) = Dens.row(0)/K; for (unsigned int n=1;n<N;n++){ Forward.row(n) = ( Forward.row(n-1) * trans ) % Dens.row(n); Scale(n) = sum(Forward.row(n)); Forward.row(n) = Forward.row(n) / Scale(n); } logl(nit+1) = log(sum(Forward.row(N-1))) + sum(logvec(Scale,N)); // caculate the likelhood remember end at N-1 Backward.row(N-1) += 1; for (int n=N-2;n>=0;n--){ Backward.row(n) = ( Backward.row(n+1) % Dens.row(n+1) ) * trans.t(); Backward.row(n) = Backward.row(n) / Scale(n); } trans = trans % ( Forward.rows(0,N-2).t() * ( Dens.rows(1,N-1) % Backward.rows(1,N-1) ) ); trans = trans / ( sum(trans,1) * ones(1,K) ); Postprob = Forward % Backward; Postprob = Postprob / ( sum(Postprob,1) * ones(1,K) ); wght = sum(Postprob,0); t_step = t_INITIAL; while (t_step < PRECISION ){ // for (unsigned int i=0;i<2;i++){ cvx = cvxObj(t_step,Postprob,wght,x,y,n,ab,F,h,N,Nrep); v = -solve( cvx.H,cvx.g ); lambda = sum(v % cvx.g); s = 1; while(min(h - F * (vectorise(ab) + s*v)) < 0) { s = BETA*s; } cvx_new = cvxObj(t_step,Postprob,wght,x,y,n,ab_sv(ab,s,v,K),F,h,N,Nrep); while (cvx_new.f > cvx.f + ALPHA*s*lambda) { s = BETA * s; cvx_new = cvxObj(t_step,Postprob,wght,x,y,n,ab_sv(ab,s,v,K),F,h,N,Nrep); } if (std::abs(lambda/2) < NTTOL) {break;} ab = ab_sv(ab,s,v,K); t_step = mu * t_step; } if (std::abs( (logl(nit+1) - logl(nit)) / logl(nit+1) ) < NTTOL) {break;} } out[0] = ab; out[1] = trans; out[2] = Postprob; out[3] = logl; return out; }