Implementing the Bartels–Stewart algorithm in Eigen3 -- real matrices only? - c++

Based off this question and solution -- Implementing the Bartels–Stewart algorithm in Eigen3? -- I am trying to solve Lyapunov equations (AX + XA^T = C) using the Eigen library, but am limited to real matrices.
The R (with c++) code below works, but involves complex numbers. It can definitely be simplified (since in this framing, there is no B matrix), but the main difficulty is the reliance on complex numbers. The real schur form seems to be the standard alternative in this case, but the Eigen function matrix_function_solve_triangular_sylvester then does not work because the input matrix is not upper triangular, but is upper block triangular. I would be happy to see suggestions to a) remove the need for complex numbers, and then if that is possible, b) any efficiency improvements.
library(expm)
library(Rcpp)
library(RcppEigen)
library(inline)
# R -----------------------------------------------------------------------
d<-6 #dimensions
A<-matrix(rnorm(d^2),d,d) #continuous time transition
G <- matrix(rnorm(d^2),d,d)
C<-G %*% t(G) #continuous time pos def error
AHATCH<-A %x% diag(d) + diag(d) %x% A
Xtrue<-matrix(-solve(AHATCH,c(C)), d) #asymptotic error from continuous time
# c++ in R ---------------------------------------------------------------------
sylcpp <- '
using Eigen::Map;
using Eigen::MatrixXd;
// Map the double matrix A from Ar
const Map<MatrixXd> A(as<Map<MatrixXd> >(Ar));
// Map the double matrix Q from Qr
const Map<MatrixXd> Q(as<Map<MatrixXd> >(Qr));
Eigen::MatrixXd B = A.transpose();
Eigen::ComplexSchur<Eigen::MatrixXd> SchurA(A);
Eigen::MatrixXcd R = SchurA.matrixT();
Eigen::MatrixXcd U = SchurA.matrixU();
Eigen::ComplexSchur<Eigen::MatrixXd> SchurB(B);
Eigen::MatrixXcd S = SchurB.matrixT();
Eigen::MatrixXcd V = SchurB.matrixU();
Eigen::MatrixXcd F = (U.adjoint() * Q) * V;
Eigen::MatrixXcd Y = Eigen::internal::matrix_function_solve_triangular_sylvester(R, S, F);
Eigen::MatrixXd X = ((U * Y) * V.adjoint()).real();
return wrap(X);
'
syl <- cxxfunction(signature(Ar = "matrix",Qr='matrix'), sylcpp, plugin = "RcppEigen")
X=syl(A,-C)
X-Xtrue #approx zero

In principle, you could use RealSchur insted.
That will produce a quasi-triangular real R.

Related

Eigen c++ triangular from

I use C++ 14 and Eigen. For n x n matrix A how can I extract Q and R matrices using QR decomposition in Eigen, I tried to read the documentation but I'm disorientated
I've obtain only R:
HouseholderQR<MatrixXd> qr(A);
qr.compute(A);
MatrixXd R = qr.matrixQR().template triangularView<Upper>();
Anyway, I just want to convert matrix A into a triangular matrix (in a efficient way, around O(n^3) I think), which have the determinant equal to determinant of A, in this way accept any other methods to do this in Eigen. (or another Linear Algebra library, if you know some good libraries I waiting for suggestions )
You can get Q and R as follows:
Eigen::MatrixXd Q = qr.householderQ();
Eigen::MatrixXd QR = qr.matrixQR();
The R matrix is in the upper triangular portion of matrix QR. You can compute the determinant of R as R.diagonal().prod() which is equal in magnitude to A.determinant(). If you want to isolate the upper triangular
portion you can do this:
Eigen::MatrixXd T = R.triangularView<Eigen::UnitUpper>();

Eigen LLT Module Giving incorrect result?

First off, I assume the problem is with me and not with Eigen's LLT module. That said, here is the code (I will explain the problem briefly) but sourcing the code in Rstudio should recreate the bug.
#include <RcppEigen.h>
using namespace Rcpp;
using Eigen::MatrixXd;
using Eigen::VectorXd;
// [[Rcpp::depends(RcppEigen)]]
template <typename T>
void fillUnitNormal(Eigen::PlainObjectBase<T>& Z){
int m = Z.rows();
int n = Z.cols();
Rcpp::NumericVector r(m*n);
r = Rcpp::rnorm(m*n, 0, 1); // using vectorization from Rcpp sugar
std::copy(std::begin(r), std::end(r), Z.data());
}
template <typename T1, typename T2, typename T3>
// #param z is object derived from class MatrixBase to overwrite with sample
// #param m MAP estimate
// #param S the hessian of the NEGATIVE log-likelihood evaluated at m
// #param pars structure of type pars
// #return int 0 success, 1 failure
int cholesky_lap(Eigen::MatrixBase<T1>& z, Eigen::MatrixBase<T2>& m,
Eigen::MatrixBase<T3>& S){
int nc=z.cols();
int nr=z.rows();
Eigen::LLT<MatrixXd> hesssqrt;
hesssqrt.compute(-S);
if (hesssqrt.info() == Eigen::NumericalIssue){
Rcpp::warning("Cholesky of Hessian failed with status status Eigen::NumericalIssue");
return 1;
}
typename T1::PlainObject samp(nr, nc);
fillUnitNormal(samp);
z = hesssqrt.matrixL().solve(samp);
z.template colwise() += m;
return 0;
}
// #param z an object derived from class MatrixBase to overwrite with samples
// #param m MAP estimate (as a vector)
// #param S the hessian of the NEGATIVE log-likelihood evaluated at m
// block forms should be given as blocks row bound together, blocks
// must be square and of the same size!
// [[Rcpp::export]]
Eigen::MatrixXd LaplaceApproximation(int n_samples, Eigen::VectorXd m,
Eigen::MatrixXd S){
int p=m.rows();
MatrixXd z = MatrixXd::Zero(p, n_samples);
int status = cholesky_lap(z, m, S);
if (status==1) Rcpp::stop("decomposition failed");
return z;
}
/*** R
library(testthat)
n_samples <- 1000000
m <- 1:3
S <- diag(1:3)
S[1,2] <- S[2,1] <- -1
S <- -S # Pretending this is the negative precision matrix
# e.g., hessian of negative log likelihood
z <- LaplaceApproximation(n_samples, m, S)
expect_equal(var(t(z)), solve(-S), tolerance=0.005)
expect_equal(rowMeans(z), m, tolerance=.01)
*/
Here is the (key) output:
> expect_equal(var(t(z)), solve(-S), tolerance=0.005)
Error: var(t(z)) not equal to solve(-S).
2/9 mismatches (average diff: 1)
[1] 0.998 - 2 == -1
[5] 2.003 - 1 == 1
In Words:
I am trying to write a function to perform a Laplace approximation. This means essentially sampling from a multivariate normal with mean m and covariance inverse(-S) where S is the Hessian of the negative log-liklihood.
My code works perfectly for an eigen decomposition I coded but for some reason, it is failing with the Cholesky. (I have tried to just give a minimal reproducible example and for space am not showing the eigen decomposition).
The best thought I have now is that some aliasing issue is happening but I can't figure out where that would be...
Thank you in advance!
It turned out to be a simple math error. Not a code error. Issue was that cholesky of matrix inverse has a transpose compared to just the inverse of the cholesky of the original matrix. Changing
z = hesssqrt.matrixL().solve(samp);
to
z = hesssqrt.matrixU().solve(samp);
Solved the problem.

Multiplying complex matrices in R using C++

Suppose that A is a complex matrix. I am interested in computing the product A%*%Conj(t(A)) in R efficiently. As far as I understand, using C++ would speed up things significantly, so that is what I am trying to do.
I have the following code for real matrices that I can use in R.
library(Rcpp);
library(inline);
library(RcppEigen);
crossprodCpp <- '
using Eigen::Map;
using Eigen::MatrixXd;
using Eigen::Lower;
const Map<MatrixXd> A(as<Map<MatrixXd> >(AA));
const int m(A.rows());
MatrixXd AAt(MatrixXd(m, m).setZero().selfadjointView<Lower>().rankUpdate(A));
return wrap(AAt);
'
fcprd <- cxxfunction(signature(AA = "matrix"), crossprodCpp, "RcppEigen")
A<-matrix(rnorm(100^2),100)
all.equal(fcprd(A),tcrossprod(A))
fcprd(A) runs much faster on my laptop than tcrossprod(A). This is what I get for A<-matrix(rnorm(1000^2),1000):
microbenchmark::microbenchmark('tcrossprod(A)'=tcrossprod(A),'A%*%t(A)'=A%*%t(A),fcprd=fcprd(A))
Unit: milliseconds
expr min lq mean median uq max neval
tcrossprod(A) 428.06452 435.9700 468.9323 448.8168 504.2628 618.7681 100
A%*%t(A) 722.24053 736.6197 775.4814 767.7668 809.8356 903.8592 100
fcprd 95.04678 100.0733 111.5021 103.6616 107.2551 197.4479 100
However, this code only works for matrices with double precision entries. How could I modify this code so that it works for complex matrices?
I have a very limited knowledge of programming, but I am trying to learn.
Any help is much appreciated!
The Eigen library supports also complex entries via Eigen::MatrixXcd. So in principle it should work if you replace MatrixXd with MatrixXcd. However, this does not compile probably because there is no as-function for complex matrices using Map (c.f. https://github.com/RcppCore/RcppEigen/blob/master/inst/unitTests/runit.RcppEigen.R#L205). The as-function are needed to convert between R data types and C++/Eigen data types (c.f. http://dirk.eddelbuettel.com/code/rcpp/Rcpp-extending.pdf). If you do not use Map, then you can use this:
crossprodCpp <- '
using Eigen::MatrixXcd;
using Eigen::Lower;
const MatrixXcd A(as<MatrixXcd>(AA));
const int m(A.rows());
MatrixXcd AAt(MatrixXcd(m, m).setZero().selfadjointView<Lower>().rankUpdate(A));
return wrap(AAt);
'
fcprd <- inline::cxxfunction(signature(AA = "matrix"), crossprodCpp, "RcppEigen")
N <- 100
A <- matrix(complex(real = rnorm(N), imaginary = rnorm(N)), N)
all.equal(fcprd(A), A %*% Conj(t(A)))
However, this is slower than the base R version in my tests:
N <- 1000
A <- matrix(complex(real = rnorm(N * N), imaginary = rnorm(N * N)), N)
all.equal(fcprd(A), A %*% Conj(t(A)))
#> [1] TRUE
microbenchmark::microbenchmark(base = A %*% Conj(t(A)), eigen = fcprd(A))
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> base 111.6512 124.4490 145.7583 140.9199 160.3420 241.8986 100
#> eigen 453.6702 501.5419 535.0192 537.2925 564.8746 628.4999 100
Note that matrix multiplication in R is done via BLAS. However, the default BLAS implementation used by R is not very fast. One way to improve R's performance is to use an optimized BLAS library, c.f. https://csgillespie.github.io/efficientR/set-up.html#blas-and-alternative-r-interpreters.
Alternatively you can use the BLAS function zherk if you have a full BLAS available. Very rough:
dyn.load("/usr/lib/libblas.so")
zherk <- function(a, uplo = 'u', trans = 'n') {
n <- nrow(a)
k <- ncol(a)
c <- matrix(complex(real = 0, imaginary = 0), nrow = n, ncol = n)
z <- .Fortran("zherk",
uplo = as.character(uplo),
trans = as.character(trans),
n = as.integer(n),
k = as.integer(k),
alpha = as.double(1),
a = as.complex(a),
lda = as.integer(n),
beta = as.double(0),
c = as.complex(c),
ldc = as.integer(n))
matrix(z$c, nrow = n, ncol = n)
}
N <- 2
A <- matrix(complex(real = rnorm(N * N), imaginary = rnorm(N * N)), N)
zherk(A, uplo = "l") - A %*% Conj(t(A))
Note that this fills only the upper (or lower) triangular part but is quite fast:
microbenchmark::microbenchmark(base = A %*% Conj(t(A)), blas = zherk(A))
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> base 112.5588 117.12531 146.10026 138.37565 167.6811 282.3564 100
#> blas 66.9541 70.12438 91.44617 82.74522 108.4979 188.3728 100
Here is a way to bind an Eigen::Map<Eigen::MatrixXcd> object in Rcpp. The solution works in a R package setup, but I'm not sure about an easy way to put it together using the inline library.
First, you need to provide the following specialization in your inst/include/mylib.h such that this header get included in the RcppExports.cpp:
#include <complex>
#include <Eigen/Core>
#include <Eigen/Dense>
#include <Rcpp.h>
namespace Rcpp {
namespace traits {
template<>
class Exporter<Eigen::Map<Eigen::Matrix<std::complex<double>, Eigen::Dynamic, Eigen::Dynamic> > > {
using OUT = typename Eigen::Map<Eigen::Matrix<std::complex<double>, Eigen::Dynamic, Eigen::Dynamic> >;
const static int RTYPE = ::Rcpp::traits::r_sexptype_traits<std::complex<double>>::rtype;
Rcpp::Vector<RTYPE> vec;
int d_ncol, d_nrow;
public:
Exporter(SEXP x)
: vec(x), d_ncol(1)
, d_nrow(Rf_xlength(x)) {
if (TYPEOF(x) != RTYPE)
throw std::invalid_argument("Wrong R type for mapped matrix");
if (::Rf_isMatrix(x)) {
int* dims = INTEGER(::Rf_getAttrib(x, R_DimSymbol));
d_nrow = dims[0];
d_ncol = dims[1];
}
}
OUT get() { return OUT(reinterpret_cast<std::complex<double>*>(vec.begin()), d_nrow, d_ncol); }
};
}}
The only difference with the unspecialized Exporter available in RcppEigenWrap.h being the reinterpret_cast on the last line. Both std::complex and Rcomplex having C99 complex compatible types, they are supposed to have identical memory layouts regardless of the implementation.
Wrapping it up, you can now create your function as:
// [[Rcpp::export]]
Eigen::MatrixXd selfadj_mult(const Eigen::Map<Eigen::MatrixXcd>& mat) {
Eigen::MatrixXd result = (mat * mat.adjoint()).real();
return result;
}
and then invoke the function in R as:
library(mylib)
library(microbenchmark)
N <- 1000
A <- matrix(complex(real = rnorm(N * N), imaginary = rnorm(N * N)), N)
microbenchmark::microbenchmark(
base = A %*% Conj(t(A))
, eigen = mylib::selfadj_mult(A)
, times = 100L
)
the code is compiled on centos7/gcc83 with -O3 -DNDEBUG -flto -march=generic. R has been build from source with the exact same compiler/flags (using the default BLAS binding). Results are:
Unit: seconds
expr min lq mean median uq max neval
base 2.9030320 2.9045865 2.9097162 2.9053835 2.9093232 2.9614318 100
eigen 1.1978697 1.2004888 1.2134219 1.2031046 1.2057647 1.3035751 100

What is the best way to apply a function to a subset of a vector?

Say I have a vector<int> positions that represents positions that I would like to subset from, and two Rcpp::NumericVector vectors A and B that I want to subset (both can be treated also as vector<double>).
What would be the best way to calculate what in R I would write as
sum(A[positions]) (a double), or A[positions] / B[positions] (a vector[double])?
Basically, I would like to access the elements of the vectors at certain positions without making copies (or a for loop) if I do not have to.
Example in R:
positions = c(2,4,5) # just a vector with positions
A = rnorm(100) # a vector with 100 random numbers
B = rnorm(100)
mysum <- sum(A[positions])
mysmallvector <- A[positions] / B[positions] # or (A/B)[positions]
Right now I just loop through all the values of positions and and subset the vectors by position one by one, but I can't help thinking there is a more elegant solution.
So, replicating R's functionality in Rcpp is not necessarily ideal. For one, you should definitely check out the caveats to subsetting in Rcpp using Rcpp sugar expressions. Secondly, you are using a for loop even within R due to the vectorization structure R has.
You may wish to consider using RcppArmadillo instead of Rcpp data types. The downside to this is you will incur a copy hit when the data is ported into C++ and then back to R. With Rcpp data types, you will avoid that but you will have to define your own operations (see divide_subset() below).
With this being said, we can replicate the functionality requested via Rcpp:
#include <Rcpp.h>
using namespace Rcpp;
// Uses sugar index subsets
// [[Rcpp::export]]
NumericVector subset(NumericVector x, IntegerVector idx) {
return x[idx];
}
// Uses sugar summation function (e.g. a nice for loop)
// [[Rcpp::export]]
double sum_subset(NumericVector x, IntegerVector idx) {
return sum(subset(x,idx));
}
// No sugar for element-wise division
// [[Rcpp::export]]
NumericVector divide_subset(NumericVector x, NumericVector y, IntegerVector idx) {
unsigned int n = idx.size();
NumericVector a(n);
for(unsigned int i = 0; i < idx.size(); i++){
a[i] = x[idx[i]]/y[idx[i]];
}
return a;
}
/*** R
set.seed(1334)
positions = c(2,4,5)
# Subtract one from indexes for C++
pos_cpp = positions - 1
A = rnorm(100) # a vector with 100 random numbers
B = rnorm(100)
mysum = sum(A[positions])
cppsum = sum_subset(A, pos_cpp)
all.equal(cppsum, mysum)
mysmallvector = A[positions] / B[positions] # or (A/B)[positions]
cppdivide = divide_subset(A,B, pos_cpp)
all.equal(cppdivide, mysmallvector)
*/

Simulating matlab's mldivide with OpenCV

I asked this question yesterday: Simulating matlab's mrdivide with 2 square matrices
And thats got mrdivide working. However now I'm having problems with mldivide, which is currently implemented as follows:
cv::Mat mldivide(const cv::Mat& A, const cv::Mat& B )
{
//return b * A.inv();
cv::Mat a;
cv::Mat b;
A.convertTo( a, CV_64FC1 );
B.convertTo( b, CV_64FC1 );
cv::Mat ret;
cv::solve( a, b, ret, cv::DECOMP_NORMAL );
cv::Mat ret2;
ret.convertTo( ret2, A.type() );
return ret2;
}
By my understanding the fact that mrdivide is working should mean that mldivide is working but I can't get it to give me the same results as matlab. Again the results are nothing alike.
Its worth noting I am trying to do a [19x19] \ [19x200] so not square matrices this time.
Like I've previously mentioned in your other question, I am using MATLAB along with mexopencv, that way I can easily compare the output of both MATLAB and OpenCV.
That said, I can't reproduce your problem: I generated randomly matrices, and repeated the comparison N=100 times. I'm running MATLAB R2015a with mexopencv compiled against OpenCV 3.0.0:
N = 100;
r = zeros(N,2);
d = zeros(N,1);
for i=1:N
% double precision, i.e CV_64F
A = randn(19,19);
B = randn(19,200);
x1 = A\B;
x2 = cv.solve(A,B); % this a MEX function that calls cv::solve
r(i,:) = [norm(A*x1-B), norm(A*x2-B)];
d(i) = norm(x1-x2);
end
All results agreed and the errors were very small in the order of 1e-11:
>> mean(r)
ans =
1.0e-12 *
0.2282 0.2698
>> mean(d)
ans =
6.5457e-12
(btw I also tried x2 = cv.solve(A,B, 'IsNormal',true); which sets the cv::DECOMP_NORMAL flag, and the results were not that different either).
This leads me to believe that either your matrices happen to accentuate some edge case in the OpenCV solver, where it failed to give a proper solution, or more likely you have a bug somewhere else in your code.
I'd start by double checking how you load your data, and especially watch out for how the matrices are laid out (obviously MATLAB is column-major, while OpenCV is row-major)...
Also you never told us anything about your matrices; do they exhibit a certain characteristic, are there any symmetries, are they mostly zeros, their rank, etc..
In OpenCV, the default solver method is LU factorization, and you have to explicitly change it yourself if appropriate. MATLAB on the hand will automatically choose a method that best suits the matrix A, and LU is just one of the possible decompositions.
EDIT (response to comments)
When using SVD decompositition in MATLAB, the sign of the left and right eigenvectors U and V is arbitrary (this really comes from the DGESVD LAPACK routine). In order to get consistent results, one convention is to require that the first element of each eigenvector be a certain sign, and multiplying each vector by +1 or -1 to flip the sign as appropriate. I would also suggest checking out eigenshuffle.
One more time, here is a test I did to confirm that I get similar results for SVD in MATLAB and OpenCV:
N = 100;
r = zeros(N,2);
d = zeros(N,3);
for i=1:N
% double precision, i.e CV_64F
A = rand(19);
% compute SVD in MATLAB, and apply sign convention
[U1,S1,V1] = svd(A);
sn = sign(U1(1,:));
U1 = bsxfun(#times, sn, U1);
V1 = bsxfun(#times, sn, V1);
r(i,1) = norm(U1*S1*V1' - A);
% compute SVD in OpenCV, and apply sign convention
[S2,U2,V2] = cv.SVD.Compute(A);
S2 = diag(S2);
sn = sign(U2(1,:));
U2 = bsxfun(#times, sn, U2);
V2 = bsxfun(#times, sn', V2)'; % Note: V2 was transposed w.r.t V1
r(i,2) = norm(U2*S2*V2' - A);
% compare
d(i,:) = [norm(V1-V2), norm(U1-U2), norm(S1-S2)];
end
Again, all results were very similar and the errors close to machine epsilon and negligible:
>> mean(r)
ans =
1.0e-13 *
0.3381 0.1215
>> mean(d)
ans =
1.0e-13 *
0.3113 0.3009 0.0578
One thing I'm not sure about in OpenCV, but MATLAB's svd function returns the singular values sorted in decreasing order (unlike the eig function), with the columns of the eigenvectors in corresponding order.
Now if the singular values in OpenCV are not guaranteed to be sorted for some reason, you have to do it manually as well if you want to compare the results against MATLAB, as in:
% not needed in MATLAB
[U,S,V] = svd(A);
[S, ord] = sort(diag(S), 'descend');
S = diag(S);
U = U(:,ord)
V = V(:,ord);