SEXP returnRealIfPossible(Eigen::MatrixBase<Derived> &matvec) { SEXP result; if(matvec.imag().isZero()) result = wrap(matvec.real()); else result = wrap(matvec); return result; }
List fastLm(Rcpp::NumericMatrix Xs, Rcpp::NumericVector ys, int type) { const Map<MatrixXd> X(as<Map<MatrixXd> >(Xs)); const Map<VectorXd> y(as<Map<VectorXd> >(ys)); Index n = X.rows(); if ((Index)y.size() != n) throw invalid_argument("size mismatch"); // Select and apply the least squares method lm ans(do_lm(X, y, type)); // Copy coefficients and install names, if any NumericVector coef(wrap(ans.coef())); List dimnames(NumericMatrix(Xs).attr("dimnames")); if (dimnames.size() > 1) { RObject colnames = dimnames[1]; if (!(colnames).isNULL()) coef.attr("names") = clone(CharacterVector(colnames)); } VectorXd resid = y - ans.fitted(); int rank = ans.rank(); int df = (rank == ::NA_INTEGER) ? n - X.cols() : n - rank; double s = resid.norm() / std::sqrt(double(df)); // Create the standard errors VectorXd se = s * ans.se(); return List::create(_["coefficients"] = coef, _["se"] = se, _["rank"] = rank, _["df.residual"] = df, _["residuals"] = resid, _["s"] = s, _["fitted.values"] = ans.fitted()); }
extern "C" SEXP fastLm(SEXP Xs, SEXP ys, SEXP type) { try { const Map<MatrixXd> X(as<Map<MatrixXd> >(Xs)); const Map<VectorXd> y(as<Map<VectorXd> >(ys)); Index n = X.rows(); if ((Index)y.size() != n) throw invalid_argument("size mismatch"); // Select and apply the least squares method lm ans(do_lm(X, y, ::Rf_asInteger(type))); // Copy coefficients and install names, if any NumericVector coef(wrap(ans.coef())); List dimnames(NumericMatrix(Xs).attr("dimnames")); if (dimnames.size() > 1) { RObject colnames = dimnames[1]; if (!(colnames).isNULL()) coef.attr("names") = clone(CharacterVector(colnames)); } VectorXd resid = y - ans.fitted(); int rank = ans.rank(); int df = (rank == ::NA_INTEGER) ? n - X.cols() : n - rank; double s = resid.norm() / std::sqrt(double(df)); // Create the standard errors VectorXd se = s * ans.se(); return List::create(_["coefficients"] = coef, _["se"] = se, _["rank"] = rank, _["df.residual"] = df, _["residuals"] = resid, _["s"] = s, _["fitted.values"] = ans.fitted()); } catch( std::exception &ex ) { forward_exception_to_r( ex ); } catch(...) { ::Rf_error( "c++ exception (unknown reason)" ); } return R_NilValue; // -Wall }
Rcpp::List EigsGen::extract() { int nconv = iparam[5 - 1]; int niter = iparam[9 - 1]; // Sometimes there are nconv = nev + 1 converged eigenvalues, // mainly due to pairs of complex eigenvalues. // We will truncate at nev. int truenconv = nconv > nev ? nev : nconv; // Converged eigenvalues from aupd() VectorXcd evalsConverged(nconv); evalsConverged.real() = MapVec(workl + ncv * ncv, nconv); evalsConverged.imag() = MapVec(workl + ncv * ncv + ncv, nconv); // If only eigenvalues are requested if(!retvec) { if(nconv < nev) ::Rf_warning("only %d eigenvalues converged, less than k", nconv); sortDesc(evalsConverged); if(evalsConverged.size() > truenconv) evalsConverged.conservativeResize(truenconv); return returnResult(returnRealIfPossible(evalsConverged), R_NilValue, wrap(truenconv), wrap(niter)); } // Recompute the Hessenburg matrix, since occasionally // aupd() will give us the incorrect one recomputeH(); MapMat Hm(workl, ncv, ncv); MapMat Vm(V, n, ncv); RealSchur<MatrixXd> schur(Hm); MatrixXd Qm = schur.matrixU(); MatrixXd Rm = schur.matrixT(); VectorXcd evalsRm(ncv); VectorXi selectInd(nconv); eigenvalueSchur(Rm, evalsRm); findMatchedIndex(evalsConverged.head(nconv), evalsRm, selectInd); //Rcpp::Rcout << evalsRm << "\n\n"; //Rcpp::Rcout << evalsConverged << "\n\n"; truenconv = selectInd.size(); if(truenconv < 1) { ::Rf_warning("no converged eigenvalues found"); return returnResult(R_NilValue, R_NilValue, wrap(0L), wrap(niter)); } // Shrink Qm and Rm to the dimension given by the largest value // in selectInd. Since selectInd is strictly increasing, // we can just use its last value. int lastInd = selectInd[selectInd.size() - 1]; Qm.conservativeResize(Eigen::NoChange, lastInd + 1); Rm.conservativeResize(lastInd + 1, lastInd + 1); // Eigen decomposition of Rm EigenSolver<MatrixXd> es(Rm); evalsRm = es.eigenvalues(); MatrixXcd evecsA = Vm * (Qm * es.eigenvectors()); // Order and select eigenvalues/eigenvectors for(int i = 0; i < truenconv; i++) { // Since selectInd[i] >= i for all i, it is safe to // overwrite the elements and columns. evalsRm[i] = evalsRm[selectInd[i]]; } if(evalsRm.size() > truenconv) evalsRm.conservativeResize(truenconv); transformEigenvalues(evalsRm); // Now (evalsRm, selectInd) gives the pair of (value, location) sortDescPair(evalsRm, selectInd); if(truenconv > nev) { truenconv = nev; evalsRm.conservativeResize(truenconv); } MatrixXcd evecsConverged(n, truenconv); for(int i = 0; i < truenconv; i++) { evecsConverged.col(i) = evecsA.col(selectInd[i]); } if(truenconv < nev) ::Rf_warning("only %d eigenvalues converged, less than k", truenconv); return returnResult(returnRealIfPossible(evalsRm), returnRealIfPossible(evecsConverged), wrap(truenconv), wrap(niter)); }