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));
}
