//Function to generate a single list of two matrices (train or test), given an index // [[Rcpp::export]] Rcpp::List MatSplit( const arma::mat & A, const arma::mat & B, const arma::uvec & splitind){ arma::mat tA = A.rows(splitind); arma::mat tB = B.rows(splitind); return Rcpp::List::create(Rcpp::Named("A")=tA, Rcpp::Named("B")=tB); }
// this function sample the loading parameters considering constant // observational variance. // [[Rcpp::export]] arma::mat SampleDfmLoads(arma::mat y, arma::mat factors, arma::vec psi, int s, double c0) { /** * The data matrix 'y' is (T \times q). * Note that the factors matrix is (T+h \times k). In the models considered * in the dissertation, h > s. This means that we always have the * VAR order, 'h', greater than the number of dynamic factors, 's', in the * observational equation. * The argument 's' is the order of the dynamic factors present in the * observational equation. * The prior mean is set to zero. */ int T = y.n_rows; int q = y.n_cols;; int k = factors.n_cols; int TpH = factors.n_rows; int h = TpH - T; if (h < s+1){ throw std::range_error( "Argument 's' greater than or equal to factors' VAR order in SampleDfmLoads.cpp" ); } arma::mat I_q = eye(q, q); // std::cout << "\nh = " << h << "\n"; arma::mat Xlambda; Xlambda = factors.rows(h, TpH-1); // std::cout << "\nNumber of rows in Xlambda is " << Xlambda.n_rows << "\n"; if (s > 0){ for (int i = 1; i <= s; i++){ Xlambda = arma::join_rows(Xlambda, factors.rows(h-i, TpH-i-1)); } } // posterior variance arma::mat Eigvec; arma::vec eigval; arma::eig_sym(eigval, Eigvec, arma::symmatu(Xlambda.t() * Xlambda)); arma::mat kronEig = kron(I_q, Eigvec); arma::vec L1eigval = 1.0/(arma::kron((1.0/psi), eigval) + 1/c0); arma::mat L1 = kronEig * diagmat(L1eigval) * kronEig.t(); // posterior mean arma::vec yStar(y.begin(), T*q); arma::vec l1 = L1 * (arma::kron(arma::diagmat(1.0/psi), Xlambda.t()) * yStar); arma::mat l1Mat(l1.begin(), k*(s+1), q); // mean in matrix form // random generation arma::vec vecnorm = sqrt(L1eigval) % randn(q*k*(s+1), 1); arma::mat LambdaBar(vecnorm.begin(), k*(s+1), q, false); LambdaBar = l1Mat + Eigvec * LambdaBar; return LambdaBar.t(); }
// [[Rcpp::export]] arma::mat BeQTL2(const arma::mat & A, const arma::mat & B, const arma::umat & Bootmat){ int bsi= Bootmat.n_rows; arma::mat C(A.n_cols*B.n_cols,Bootmat.n_rows); arma::mat tC(A.n_rows,B.n_rows); for(int i=0; i<bsi; i++){ tC = cor(A.rows(Bootmat.row(i)),B.rows(Bootmat.row(i))); C.col(i) = vectorise(tC,0); } C.elem(find_nonfinite(C)).zeros(); return reshape(median(C,1),A.n_cols,B.n_cols); }
/****************************************************************** * 函数功能:几何校正需要调用的函数 * * */ arma::mat centering(arma::mat &x){ arma::mat tmp = -mean(x.rows(0, 1), 1); arma::mat tmp2(2,2); tmp2.eye(); arma::mat tmp1 = join_horiz(tmp2, tmp); arma::mat v; v << 0 << 0 << 1 << arma::endr; arma::mat T = join_vert(tmp1, v); //T.print("T ="); arma::mat xm = T * x; //xm.print("xm ="); //at least one pixel apart to avoid numerical problems //xm.print("xm ="); double std11 = arma::stddev(xm.row(0)); //cout << "std11:" << std11 << endl; double std22 = stddev(xm.row(1)); //cout << "std22:" << std22 << endl; double std1 = std::max(std11, 1.0); double std2 = std::max(std22, 1.0); arma::mat S; S << 1/std1 << 0 << 0 << arma::endr << 0 << 1/std2 << 0 << arma::endr << 0 << 0 << 1 << arma::endr; arma::mat C = S * T ; //C.print("C ="); return C; }
// **********************************************************// // Calculate Dyadic statistics // // **********************************************************// // [[Rcpp::export]] arma::cube degreestat (arma::cube cache, arma::mat intervals_d, int a, int A, arma::mat pd) { int nIP = pd.n_cols; arma::cube out = arma::zeros<arma::cube>(A, nIP, 6); for (unsigned int i = 0; i < 3; i++) { int mins = intervals_d(i, 0)-1; int maxs = intervals_d(i, 1)-1; arma::rowvec sendr = arma::zeros<arma::rowvec>(nIP); arma::mat receiver = arma::zeros<arma::mat>(A, nIP); arma::mat pdnew = pd.rows(mins, maxs); for (int r = 0; r < A; r++) { arma::colvec docsar = cache(arma::span(a), arma::span(r), arma::span(mins, maxs)); sendr += docsar.t() * pdnew; for (int h = 0; h < A; h++) { arma::colvec docsra = cache(arma::span(h), arma::span(r), arma::span(mins, maxs)); receiver.row(r) += docsra.t() * pdnew; } } for (int IP = 0; IP < nIP; IP++) { for (int r = 0; r < A; r++) { out(r, IP, i) = sendr[IP]; out(r, IP, i+3) = receiver(r,IP); } } } return out; }
//Script that takes two matrices, performs bootstrapped correlation, and returns the median // [[Rcpp::export]] arma::mat BeQTL(const arma::mat & A, const arma::mat & B, const arma::umat & Bootmat){ int bsi= Bootmat.n_rows; Rcpp::Rcout<<"Starting Bootstrap!"<<std::endl; arma::mat C(A.n_cols*B.n_cols,Bootmat.n_rows); arma::mat tA(A.n_rows,A.n_cols); arma::mat tB(B.n_rows,B.n_cols); arma::mat tC(A.n_rows,B.n_rows); for(int i=0; i<bsi; i++){ tA = A.rows(Bootmat.row(i)); tB = B.rows(Bootmat.row(i)); tC = cor(tA,tB); C.col(i) = vectorise(tC,0); } C.elem(find_nonfinite(C)).zeros(); return reshape(median(C,1),A.n_cols,B.n_cols); }
arma::colvec computeBetaJ_cpp(arma::colvec y, arma::mat X, int j, int m, int adjFinSample) { int bigT = X.n_rows; int numThrow = ceil((double)m / 2); if (adjFinSample == 0) numThrow = m ; mat XSparse; colvec ySparse; XSparse.zeros(bigT - numThrow, X.n_cols); ySparse.zeros(bigT - numThrow); if (j < 2) { XSparse.rows(0, bigT - numThrow - 1) = X.rows(numThrow, bigT - 1); ySparse.rows(0, bigT - numThrow - 1) = y.rows(numThrow, bigT - 1); } else { XSparse.rows(0, j - 2) = X.rows(0, j - 2); ySparse.rows(0, j - 2) = y.rows(0, j - 2); XSparse.rows(j - 1, bigT - numThrow - 1) = X.rows(j + numThrow - 1, bigT - 1); ySparse.rows(j - 1, bigT - numThrow - 1) = y.rows(j + numThrow - 1, bigT - 1); } colvec beta = runOLSFast_cpp(ySparse, XSparse); return(beta); }
void HMM::computeXiCached() { arma::mat temp = B_.rows(1,T_-1) % beta_.cols(1,T_-1).t(); for(unsigned int i = 0; i < N_; ++i) { xi_.slice(i) = temp % (alpha_(i,arma::span(0, T_-2)).t() * A_.row(i)); } }
static arma::vec s_recall(arma::mat &runMatrix, Qrels &qrels, int rank){ // Use a greedy approach to find the max subtopics at rank k // Initialize working variables int numOfSubtopics = int(*qrels.subtopics.rbegin()); int numOfRows = min(rank, qrels.numOfRelDocs); arma::vec maxSubtopics = arma::zeros(rank); arma::rowvec seenSubtopics = arma::zeros<arma::rowvec>(numOfSubtopics); arma::vec tmpVector; set<int> idealRankList; set<int>::iterator it; // Greedy approach searches for the best document at each rank for(int i = 0; i < numOfRows; i++){ int maxNewSubtopics = 0; int pickedDoc = -1; // Iterate through the set of relevant documents to find // the best document for(int j = 0; j < qrels.matrix.n_rows; j++){ // Ignore the document already picked it = idealRankList.find(j); if(it != idealRankList.end() ) continue; // Compute the number of new subtopics the document contains int numOfNewSubtopics = arma::sum((qrels.matrix.row(j) + seenSubtopics) > arma::zeros<arma::vec>(numOfSubtopics)); // Keep track of the best document/ max number of subtopics if(numOfNewSubtopics > maxNewSubtopics){ maxNewSubtopics = numOfNewSubtopics; pickedDoc = j; } } // Add the best document to the ideal rank list // and keep track of subtopics seen seenSubtopics += qrels.matrix.row(pickedDoc); idealRankList.insert(pickedDoc); maxSubtopics(i) = arma::sum(seenSubtopics > arma::zeros<arma::vec>(numOfSubtopics)); } if(numOfRows < rank){ for(int i=numOfRows; i < rank; i++) maxSubtopics(i) = maxSubtopics(numOfRows - 1); } // Consider only the top 'rank' number of documents arma::vec s_recall = arma::zeros(rank); for(int i=0; i < rank; i++){ arma::mat matrix = runMatrix.rows(0,i); double retSubtopics = arma::sum(arma::sum(matrix) > arma::zeros<arma::vec>(numOfSubtopics)); s_recall(i) = (retSubtopics/maxSubtopics(i)); } return s_recall; }
//[[Rcpp::export]] double computeSStat_cpp(arma::colvec beta, arma::mat invS, arma::colvec y, arma::mat X, int j, int m) { mat newX = X.rows(j - 1, j + m - 2); colvec newY = y.rows(j - 1, j + m - 2); mat A = trans(newX) * invS * (newY - newX * beta); mat V = trans(newX) * invS * newX; mat S = trans(A) * inv(V) * A; double s = S(0, 0); return(s); }
/******************************************************************* * 函数功能:几何校正需要调用的函数 * * */ arma::mat toAffinity(arma::mat &f){ arma::mat A; arma::mat v; v << 0 << 0 << 1 << arma::endr; int flag = f.n_rows; switch(flag){ case 6:{ // oriented ellipses arma::mat T = f.rows(0, 1); arma::mat tmp = join_horiz(f.rows(2, 3), f.rows(4, 5)); arma::mat tmp1 = join_horiz(tmp, T); A = join_vert(tmp1, v); break;} case 4:{ // oriented discs arma::mat T = f.rows(0, 1); double s = f.at(2,0); double th = f.at(3,0); arma::mat S = arma::randu<arma::mat>(2,2); /*S.at(0, 0) = s*cos(th); S.at(0, 1) = -s*sin(th); S.at(1, 0) = s*sin(th); S.at(1, 1) = s*cos(th);*/ S << s*cos(th) << -s*sin(th) << arma::endr << s*sin(th) << s*cos(th) << arma::endr; arma::mat tmp1 = join_horiz(S, T); A = join_vert(tmp1, v); //A.print("A ="); break;} /*case 3:{ // discs mat T = f.rows(0, 1); mat s = f.row(2); int th = 0 ; A = [s*[cos(th) -sin(th) ; sin(th) cos(th)], T ; 0 0 1] ; } case 5:{ // ellipses mat T = f.rows(0, 1); A = [mapFromS(f(3:5)), T ; 0 0 1] ; }*/ default: std::cout << "出错啦!" << std::endl; break; } return A; }
// **********************************************************// // Calculate Triadic statistics // // **********************************************************// // [[Rcpp::export]] arma::cube triadicstat (arma::cube cache, arma::mat intervals_d, int a, int A, arma::mat pd) { int nIP = pd.n_cols; arma::cube out = arma::zeros<arma::cube>(A, nIP, 36); int it = 0; for (unsigned int i = 0; i < 3; i++) { for (unsigned int j = 0; j < 3; j++) { int mins1 = intervals_d(i, 0)-1; int maxs1 = intervals_d(i, 1)-1; int mins2 = intervals_d(j, 0)-1; int maxs2 = intervals_d(j, 1)-1; arma::mat tsend = arma::zeros<arma::mat>(A, nIP); arma::mat treceive = arma::zeros<arma::mat>(A, nIP); arma::mat sibling = arma::zeros<arma::mat>(A, nIP); arma::mat cosibling = arma::zeros<arma::mat>(A, nIP); arma::mat pdnew1 = pd.rows(mins1, maxs1); arma::mat pdnew2 = pd.rows(mins2, maxs2); for (int r = 0; r < A; r++) { for (int h = 0; h < A; h++) { arma::colvec docsah = cache(arma::span(a), arma::span(h), arma::span(mins1, maxs1)); arma::colvec docsrh = cache(arma::span(r), arma::span(h), arma::span(mins2, maxs2)); arma::colvec docsha = cache(arma::span(h), arma::span(a), arma::span(mins1, maxs1)); arma::colvec docshr = cache(arma::span(h), arma::span(r), arma::span(mins2, maxs2)); tsend.row(r) += (docsah.t() * pdnew1) % (docshr.t() * pdnew2); treceive.row(r) += (docsha.t() * pdnew1) % (docsrh.t() * pdnew2); sibling.row(r) += (docsha.t() * pdnew1) % (docshr.t() * pdnew2); cosibling.row(r) += (docsah.t() * pdnew1) % (docsrh.t() * pdnew2); } } for (int IP = 0; IP < nIP; IP++) { for (int r = 0; r < A; r++) { out(r, IP, it) = tsend(r, IP); out(r, IP, it+9) = treceive(r,IP); out(r, IP, it+18) = sibling(r, IP); out(r, IP, it+27) = cosibling(r,IP); } } it +=1; } } arma::cube out2 = arma::zeros<arma::cube>(A, nIP, 12); for (int t = 0; t < 4; t++) { int add = 9*t; for (int IP = 0; IP < nIP; IP++) { for (int r = 0; r < A; r++) { out2(r, IP, 3*t+0) = out(r, IP, add+0); out2(r, IP, 3*t+1) = out(r, IP, add+1) + out(r, IP, add+3)+ out(r, IP, add+4); out2(r, IP, 3*t+2) = out(r, IP, add+2) + out(r, IP, add+5)+ out(r, IP, add+6)+ out(r, IP, add+7)+ out(r, IP, add+8); } } } return out2 / 10; }
// This piece of code computes the flowlength before taking into account // the dimensions of pixels/slope. //[[Rcpp::export]] double fl_internal(arma::mat m) { uword ny = m.n_cols; uword nx = m.n_rows; rowvec flcol = zeros(1, ny); for ( uword r=0; r<nx; r++ ) { rowvec a = sum(cumprod(m.rows(r, nx - 1), 0), 0); flcol += a; } return( accu(flcol)/((double)nx * (double)ny) ); }
void RNN< LayerTypes, OutputLayerType, InitializationRuleType, PerformanceFunction >::Gradient(const arma::mat& /* unused */, const size_t i, arma::mat& gradient) { if (gradient.is_empty()) { gradient = arma::zeros<arma::mat>(parameter.n_rows, parameter.n_cols); } else { gradient.zeros(); } Evaluate(parameter, i, false); arma::mat currentGradient = arma::mat(gradient.n_rows, gradient.n_cols); NetworkGradients(currentGradient, network); const arma::mat input = arma::mat(predictors.colptr(i), predictors.n_rows, 1, false, true); // Iterate through the input sequence and perform the feed backward pass. for (seqNum = seqLen - 1; seqNum >= 0; seqNum--) { // Load the network activation for the upcoming backward pass. LoadActivations(input.rows(seqNum * inputSize, (seqNum + 1) * inputSize - 1), network); // Perform the backward pass. if (seqOutput) { arma::mat seqError = error.unsafe_col(seqNum); Backward(seqError, network); } else { Backward(error, network); } // Link the parameters and update the gradients. LinkParameter(network); UpdateGradients<>(network); // Update the overall gradient. gradient += currentGradient; if (seqNum == 0) break; } }
arma::colvec computeTestStatDistribution_cpp(arma::colvec y, arma::mat X, int breakDate, int m, int adjFinSample, arma::mat invS) { int bigT = X.n_rows; colvec sJ = zeros(breakDate - m + 1); for (int j = 0; j < (breakDate - m + 1); j++) { colvec betaJ = computeBetaJ_cpp(y.rows(0, bigT - 1 - m), X.rows(0, bigT - 1 - m), j + 1, m, adjFinSample); sJ(j) = computeSStat_cpp(betaJ, invS, y, X, j + 1, m); // if (j == 44) { // Rcout << "betaJ = "<< betaJ << "sJ(j) = " << sJ(j) << endl; // } } return(sJ); }
/** * Remove a certain set of rows in a matrix while copying to a second matrix. * * @param input Input matrix to copy. * @param rowsToRemove Vector containing indices of rows to be removed. * @param output Matrix to copy non-removed rows into. */ void mlpack::math::RemoveRows(const arma::mat& input, const std::vector<size_t>& rowsToRemove, arma::mat& output) { const size_t nRemove = rowsToRemove.size(); const size_t nKeep = input.n_rows - nRemove; if (nRemove == 0) { output = input; // Copy everything. } else { output.set_size(nKeep, input.n_cols); size_t curRow = 0; size_t removeInd = 0; // First, check 0 to first row to remove. if (rowsToRemove[0] > 0) { // Note that this implies that n_rows > 1. output.rows(0, rowsToRemove[0] - 1) = input.rows(0, rowsToRemove[0] - 1); curRow += rowsToRemove[0]; } // Now, check i'th row to remove to (i + 1)'th row to remove, until i is the // penultimate row. while (removeInd < nRemove - 1) { const size_t height = rowsToRemove[removeInd + 1] - rowsToRemove[removeInd] - 1; if (height > 0) { output.rows(curRow, curRow + height - 1) = input.rows(rowsToRemove[removeInd] + 1, rowsToRemove[removeInd + 1] - 1); curRow += height; } removeInd++; } // Now that i is the last row to remove, check last row to remove to last // row. if (rowsToRemove[removeInd] < input.n_rows - 1) { output.rows(curRow, nKeep - 1) = input.rows(rowsToRemove[removeInd] + 1, input.n_rows - 1); } } }
// gradients ------------------------------------------------------------------- //' @title Gradient step for Latent Factors //' @param x Either a single row or single column of X, the ratings matrix. //' @param z A single matrix from the covariates array, associated with the //' either a single row or column of X. //' @param p_i The latent factors associated with a single user or track. //' @param Q The latent factors associated with either all tracks or all users, //' depending on the type of latent factor in p_i. //' @param beta The learned regression coefficients. //' @param lambda The regularization parameter for the current latent factor. //' @param batch_samples The proportion of the observed entries to sample in the //' gradient for each factor in the gradient descent. //' @param gamma The step-size in the gradient descent. //' @return The update latent factor for the current user / track. //' @export // [[Rcpp::export]] arma::vec update_factor(arma::vec x, arma::mat z, arma::vec p_i, arma::mat Q, arma::vec beta, double lambda, double batch_samples, double gamma) { // subset to SGD rows with observed entries arma::uvec obs_ix = arma::conv_to<arma::uvec>::from(arma::find_finite(x)); arma::mat Q_obs = Q.rows(obs_ix); arma::vec x_obs = x(obs_ix); arma::uvec batch_ix = get_batch_ix(x_obs.n_elem, batch_samples); if(batch_ix.n_elem > 0) { x_obs = x_obs(batch_ix); Q_obs = Q_obs.rows(batch_ix); } arma::vec resid = x_obs - Q_obs * p_i; arma::vec p_i_grad = 2 * (lambda * p_i - Q_obs.t() * resid); return p_i - gamma * p_i_grad; }
// [[Rcpp::export]] List PCspatregMCMC(const arma::vec& y, const arma::mat& X, const arma::mat& K, const arma::uvec& sampleIndex, const arma::vec& betaMean, const arma::mat& betaSig, const double& phiScale, const int& burn, const int& iter) { int na = K.n_cols; int nsite = X.n_rows; int nb = X.n_cols; int ns = y.n_elem; arma::uvec idx = sampleIndex-1; arma::mat Xsmp = X.rows(idx); arma::mat Ksmp = K.rows(idx); arma::mat betaStor(iter, nb, fill::zeros); arma::mat alphaStor(iter, na, fill::zeros); arma::vec phiStor(iter, fill::zeros); arma::vec sigStor(iter, fill::zeros); arma::mat predStor(iter, nsite); // Beta items arma::mat betaPrec = betaSig.i(); arma::mat V_beta_inv(nb, nb); arma::vec v_beta(nb); // Alpha items arma::mat I(na,na, fill::eye); arma::mat V_alpha_inv(na, na); arma::vec v_alpha(na); // phi items arma::vec Kbar(ns); double V_phi_inv; double v_phi; // Initial values arma::vec beta(nb); beta = solve(Xsmp.t() * Xsmp, Xsmp.t()*y); double tau = (ns-1)/as_scalar((y - Xsmp*beta).t()*(y - Xsmp*beta)); double phi = 0; arma::vec alpha(na, fill::zeros); for(int i=0; i<iter+burn; i++){ // update beta V_beta_inv = tau*Xsmp.t()*Xsmp + betaPrec; v_beta = tau * Xsmp.t() * (y - phi*Ksmp*alpha) + betaPrec*betaMean; beta = GCN(V_beta_inv, v_beta); if(i>=burn){betaStor.row(i-burn) = beta.t();} // update alpha V_alpha_inv = phi*phi*tau*Ksmp.t()*Ksmp + I; v_alpha = phi*tau*Ksmp.t()*(y-Xsmp*beta); alpha = GCN(V_alpha_inv, v_alpha); if(i>=burn){alphaStor.row(i-burn) = phi*alpha.t();} // update phi Kbar = Ksmp*alpha; V_phi_inv = tau*as_scalar(Kbar.t()*Kbar) + 1/(phiScale*phiScale); v_phi = tau*dot(Kbar, y-Xsmp*beta); phi = as<double>(rnorm(1, v_phi/V_phi_inv, 1/sqrt(V_phi_inv))); if(i>=burn) phiStor(i-burn) = phi; // update tau tau = as<double>(rgamma(1, ns/2, as_scalar((y-Xsmp*beta-phi*Ksmp*alpha).t()*(y-Xsmp*beta-phi*Ksmp*alpha))/2)); if(i>=burn) sigStor(i-burn) = 1/sqrt(tau); // make prediction if(i>=burn){ predStor.row(i-burn) = (X*beta + phi*K*alpha).t(); } } return Rcpp::List::create( Rcpp::Named("beta") = betaStor, Rcpp::Named("alpha") = alphaStor, Rcpp::Named("phi")=phiStor, Rcpp::Named("sigma")=sigStor, Rcpp::Named("pred")=predStor ); }
// [[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; }
//' @export // [[Rcpp::export]] Rcpp::List affineObservationStateHandler_affineContracts(const arma::mat& stateMat, const Rcpp::List& modelParameters, const int iterCount){ // In state mat, additionally, to state values, we carry the past filtered state // because it is necessary to calculate effects of stock return observation int Nf = stateMat.n_rows/2; // Evaluate divergence prices arma::cube cfCoeffs = Rcpp::as<arma::cube>(modelParameters["cfCoeffs"]); arma::vec pVecUnique = Rcpp::as<arma::vec>(modelParameters["pVecUnique"]); arma::vec tVecUnique = Rcpp::as<arma::vec>(modelParameters["tVecUnique"]); arma::vec pVec = Rcpp::as<arma::vec>(modelParameters["pVec"]); arma::vec tVec = Rcpp::as<arma::vec>(modelParameters["tVec"]); arma::cube divPrices = divergenceSwapRateCpp(pVecUnique, cfCoeffs, stateMat.rows(0,Nf-1).t()); arma::cube skewPrices = skewnessSwapRateCpp(pVecUnique, cfCoeffs, stateMat.rows(0,Nf-1).t()); // create return matrix arma::mat yhat(pVec.n_elem,stateMat.n_cols); // Cycle over state variable columns for(unsigned int kcol=0; kcol < stateMat.n_cols; kcol++){ // Cycle through the representation of the contract specification matrix and construct final prices from priced single instruments for(unsigned int prow=0; prow < pVec.n_elem; prow++){ // find p and t values in the unique vectors to know what to pick double loc_p = pVec(prow); double loc_t = tVec(prow); arma::vec loc_p_vec(pVecUnique.n_elem); loc_p_vec.fill(loc_p); arma::vec loc_t_vec(tVecUnique.n_elem); loc_t_vec.fill(loc_t); arma::uvec which_p = find(loc_p_vec == pVecUnique); arma::uvec which_t = find(loc_t_vec == tVecUnique); // Rcout << "loc_p= " << loc_p << ", loc_t= " << loc_t << "\n"; // pVecUnique.print("pVecUnique"); // which_p.print("which_p"); // tVecUnique.print("tVecUnique"); // which_t.print("which_t"); // pick and calculate necessary affine swap rate double loc_div_price = divPrices(which_p(0L),which_t(0L),kcol); double loc_skew_price = skewPrices(which_p(0L),which_t(0L),kcol); if(loc_p == 0.0){ yhat(prow, kcol) = loc_div_price; } else if(loc_p == 1.0){ yhat(prow, kcol) = loc_skew_price/loc_div_price; } else { yhat(prow, kcol) = (loc_skew_price - (1.0 - 2.0*loc_p)/(loc_p*(loc_p-1.0))*loc_div_price) / (loc_div_price + 1.0/(loc_p*(loc_p-1.0))); } } } // Handle the noise covariance matrix. The stock ``observation'' noise is // uncorrelated with portfolio observation noise. arma::mat obsNoiseMat(pVec.n_elem,pVec.n_elem,arma::fill::zeros); // // // extract observation noise params // arma::vec bVec = Rcpp::as<arma::vec>(modelParameters["bVec"]); // arma::vec cVec = Rcpp::as<arma::vec>(modelParameters["cVec"]); // // double spotVol = arma::accu(stateMat.col(0)); // double spotVol = arma::accu(stateMat.submat(0,0,Nf-1,0)); // obsNoiseMat(arma::span(1,obsNoiseMat.n_rows-1),arma::span(1,obsNoiseMat.n_cols-1)) = divModelObsNoiseMat(cVec,bVec,spotVol,tVecUnique,U); SEXP divBigMat_SEXP(modelParameters["divNoiseCube"]); arma::cube divBigMat = as<arma::cube>(divBigMat_SEXP); // var-cov matrix scaling arma::vec errSdParVec = as<arma::vec>(modelParameters["errSdParVec"]); obsNoiseMat(arma::span(0,obsNoiseMat.n_rows-1),arma::span(0,obsNoiseMat.n_cols-1)) = errSdParVec(0) * divBigMat.slice(iterCount); // Initialize return list Rcpp::List res = Rcpp::List::create(Rcpp::Named("yhat") = yhat, Rcpp::Named("obsNoiseMat") = obsNoiseMat); return res; }