Testing for quad.form() et seq

In versions prior to 1.2-19, the emulator package included a serious bug in the quad.form() family of functions in which the complex conjugate of the correct answer was returned (which did not matter in my usual use-case because my matrices were Hermitian). This short vignette demonstrates that the bug has been fixed. Note that the fix was considerably more complicated than simply returning the complex conjugate of the old functions' value, which would have been terribly inefficient. The actual fix avoids taking more conjugates than absolutely necessary. The vignette checks all the functions in the series, including the ones that have not been changed such as quad.form.inv(). First load the package:

library("emulator")

We need a helper function to create random complex matrices (NB: we cannot use the cmvnorm package because that depends on the emulator package):

rcm <- function(row,col){
   matrix(rnorm(row*col)+1i*rnorm(row*col),row,col)
}

Then use this function to define a square matrix M with complex entries (NB: not Hermitian!), and a couple of rectangular matrices, also complex:

rcm <- function(row,col){matrix(rnorm(row*col)+1i*rnorm(row*col),row,col)}
M <- rcm(2,2)
x <- rcm(2,3)
y <- rcm(3,2)
x1 <- rcm(2,3)
y1 <- rcm(3,2)

Set up a numerical tester function:

tester <- function(a,b,TOL=1e-13){stopifnot(all(abs(a-b)< TOL))}

(previous versions used a tolerance of 1e-15, which was occasionally not met). Now test each function:

Test of ht(x) = \(x^*\) = \(\overline{x'}\) (Hermitian transpose):

ht(x)=t(Conj(x))

(jj1 <- Conj(t(x)))
#>                     [,1]                  [,2]
#> [1,] -2.468206-0.855669i -0.1818301+0.3434475i
#> [2,] -1.194290+0.392891i  1.9428635+1.3378658i
#> [3,] -0.372715-1.911333i  0.9444275+0.5298293i
(jj2 <- t(Conj(x)))
#>                     [,1]                  [,2]
#> [1,] -2.468206-0.855669i -0.1818301+0.3434475i
#> [2,] -1.194290+0.392891i  1.9428635+1.3378658i
#> [3,] -0.372715-1.911333i  0.9444275+0.5298293i
(jj3 <- ht(x))
#>                     [,1]                  [,2]
#> [1,] -2.468206-0.855669i -0.1818301+0.3434475i
#> [2,] -1.194290+0.392891i  1.9428635+1.3378658i
#> [3,] -0.372715-1.911333i  0.9444275+0.5298293i
tester(jj1,jj3)
tester(jj2,jj3)

Test of cprod() = \(x^*y\):

cprod(x,y)=crossprod(Conj(x),y)

(jj1 <- ht(x) %*% x1)
#>                     [,1]                [,2]                 [,3]
#> [1,] -1.818997+4.010817i -0.191943-2.018843i -0.6041243+0.750570i
#> [2,] -0.650899+1.957839i -0.207241+2.435977i  1.8993967+3.233713i
#> [3,] -3.943099+0.362861i  1.772448+0.950467i  0.6634689+1.368974i
(jj2 <- cprod(x,x1))
#>                     [,1]                [,2]                 [,3]
#> [1,] -1.818997+4.010817i -0.191943-2.018843i -0.6041243+0.750570i
#> [2,] -0.650899+1.957839i -0.207241+2.435977i  1.8993967+3.233713i
#> [3,] -3.943099+0.362861i  1.772448+0.950467i  0.6634689+1.368974i
tester(jj1,jj2)

Test of tcprod() = \(x y^*\):

tcprod(x,y)=crossprod(x,Conj(y))

(jj1 <- ht(x1) %*% x)
#>                      [,1]                [,2]                [,3]
#> [1,] -1.8189966-4.010817i -0.650899-1.957839i -3.943099-0.362861i
#> [2,] -0.1919432+2.018843i -0.207241-2.435977i  1.772448-0.950467i
#> [3,] -0.6041243-0.750570i  1.899397-3.233713i  0.663469-1.368974i
(jj2 <- cprod(x1,x))
#>                      [,1]                [,2]                [,3]
#> [1,] -1.8189966-4.010817i -0.650899-1.957839i -3.943099-0.362861i
#> [2,] -0.1919432+2.018843i -0.207241-2.435977i  1.772448-0.950467i
#> [3,] -0.6041243-0.750570i  1.899397-3.233713i  0.663469-1.368974i
tester(jj1,jj2)

Test of quad.form() = \(x^*Mx\):

quad.form(M,x)=crossprod(crossprod(M,Conj(x)),x))

(jj1 <- ht(x) %*% M %*% x)
#>                    [,1]              [,2]               [,3]
#> [1,] 2.784951-1.597373i 11.21020-2.55140i 5.991212-3.187814i
#> [2,] 7.010709-4.670598i 11.45065-5.96691i 4.545029-9.318720i
#> [3,] 5.593436-1.283508i 10.38164+4.56648i 5.635809-1.373520i
(jj2 <- quad.form(M,x))
#>                    [,1]              [,2]               [,3]
#> [1,] 2.784951-1.597373i 11.21020-2.55140i 5.991212-3.187814i
#> [2,] 7.010709-4.670598i 11.45065-5.96691i 4.545029-9.318720i
#> [3,] 5.593436-1.283508i 10.38164+4.56648i 5.635809-1.373520i
tester(jj1,jj2)

Test of quad.form.inv() = \(x^*M^{-1}x\):

quad.form.inv(M,x)=cprod(x,solve(M,x))

(jj1 <- ht(x) %*% solve(M) %*% x)
#>                     [,1]               [,2]                [,3]
#> [1,] -3.965853-1.049173i 4.488170+0.032828i  1.081002+3.600879i
#> [2,]  2.193495+2.351678i 1.594571+0.110596i  3.315826-1.256206i
#> [3,]  1.711859-2.350627i 1.702759+3.751640i -1.019127+0.509763i
(jj2 <- quad.form(solve(M),x))
#>                     [,1]               [,2]                [,3]
#> [1,] -3.965853-1.049173i 4.488170+0.032828i  1.081002+3.600879i
#> [2,]  2.193495+2.351678i 1.594571+0.110596i  3.315826-1.256206i
#> [3,]  1.711859-2.350627i 1.702759+3.751640i -1.019127+0.509763i
max(abs(jj1-jj2))
#> [1] 0

Test of quad.3form() = \(x^*My\):

quad.3form(M,l,r)=crossprod(crossprod(M,Conj(l)),r)

(jj1 <- ht(x) %*% M %*% x1)
#>                     [,1]                [,2]               [,3]
#> [1,] -3.160440+2.336024i  2.821974+4.884121i 5.167047+4.500542i
#> [2,] -1.903654+7.079293i  3.988212+1.439608i 6.321161+2.255877i
#> [3,] -3.049480+2.077931i -1.177906+3.753180i 1.007834+5.964129i
(jj2 <- quad.3form(M,x,x1))
#>                     [,1]                [,2]               [,3]
#> [1,] -3.160440+2.336024i  2.821974+4.884121i 5.167047+4.500542i
#> [2,] -1.903654+7.079293i  3.988212+1.439608i 6.321161+2.255877i
#> [3,] -3.049480+2.077931i -1.177906+3.753180i 1.007834+5.964129i
tester(jj1,jj2)

Test of quad.3tform() = \(xMy^*\):

quad.3tform(M,l,r)=tcrossprod(left,tcrossprod(Conj(right),M))

(jj1 <- y %*% M %*% ht(y1))
#>                       [,1]                  [,2]                [,3]
#> [1,] -2.1207892+0.8865676i -2.3012937-1.6581178i -2.272445-8.151799i
#> [2,]  1.9979587+0.2224808i -0.2855776+1.3640664i -0.111242+7.384327i
#> [3,] -0.5692226+0.1949883i -0.1587727-0.9333159i -0.617605-1.564315i
(jj2 <- quad.3tform(M,y,y1))
#>                       [,1]                  [,2]                [,3]
#> [1,] -2.1207892+0.8865676i -2.3012937-1.6581178i -2.272445-8.151799i
#> [2,]  1.9979587+0.2224808i -0.2855776+1.3640664i -0.111242+7.384327i
#> [3,] -0.5692226+0.1949883i -0.1587727-0.9333159i -0.617605-1.564315i
tester(jj1,jj2)

Test of quad.tform() = \(xMx^*\):

quad.tform(M,x)=tcrossprod(x,tcrossprod(Conj(x),M))

(jj1 <- y %*% M %*% ht(y))
#>                     [,1]                  [,2]                  [,3]
#> [1,]  8.590772-5.280196i -1.9836793+7.6291231i  1.9958321-2.4179135i
#> [2,] -5.363671+1.298791i -2.3192342-3.0679220i -0.9611445+2.6586804i
#> [3,]  1.788495+0.031003i -0.9731213-0.8516903i -0.1614053-0.0861763i
(jj2 <- quad.tform(M,y))
#>                     [,1]                  [,2]                  [,3]
#> [1,]  8.590772-5.280196i -1.9836793+7.6291231i  1.9958321-2.4179135i
#> [2,] -5.363671+1.298791i -2.3192342-3.0679220i -0.9611445+2.6586804i
#> [3,]  1.788495+0.031003i -0.9731213-0.8516903i -0.1614053-0.0861763i
tester(jj1,jj2)

Test of quad.tform.inv() = \(xM^{-1}x^*\):

quad.tform.inv(M,x)=quad.form.inv(M,ht(x))

(jj1 <- y %*% solve(M) %*% ht(y))
#>                     [,1]                 [,2]                  [,3]
#> [1,] -1.330045-0.940348i   4.411260+5.355743i  1.4467746-1.6666806i
#> [2,]  5.473554-0.103888i -12.195526-5.109049i -0.9706514+3.3863232i
#> [3,] -0.083434+1.664103i   1.375579-2.807452i -0.6821308-0.2468173i
(jj2 <- quad.tform.inv(M,y))
#>                     [,1]                 [,2]                  [,3]
#> [1,] -1.330045-0.940348i   4.411260+5.355743i  1.4467746-1.6666806i
#> [2,]  5.473554-0.103888i -12.195526-5.109049i -0.9706514+3.3863232i
#> [3,] -0.083434+1.664103i   1.375579-2.807452i -0.6821308-0.2468173i
tester(jj1,jj2)

Test of quad.diag() = \(\operatorname{diag}(x^*Mx)\) = diag(quad.form()):

quad.diag(M,x)=colSums(crossprod(M,Conj(x)) * x)

(jj1 <- diag(ht(x) %*% M %*% x))
#> [1]  2.784951-1.597373i 11.450645-5.966910i  5.635809-1.373520i
(jj2 <- diag(quad.form(M,x)))
#> [1]  2.784951-1.597373i 11.450645-5.966910i  5.635809-1.373520i
(jj3 <- quad.diag(M,x))
#> [1]  2.784951-1.597373i 11.450645-5.966910i  5.635809-1.373520i
tester(jj1,jj3)
tester(jj2,jj3)

Test of quad.tdiag() = \(\operatorname{diag}(xMx^*)\) = diag(quad.tform()):

quad.tdiag(M,x)=rowSums(tcrossprod(Conj(x), M) * x)

(jj1 <- diag(y %*% M %*% ht(y)))
#> [1]  8.5907721-5.2801959i -2.3192342-3.0679220i -0.1614053-0.0861763i
(jj2 <- diag(quad.tform(M,y)))
#> [1]  8.5907721-5.2801959i -2.3192342-3.0679220i -0.1614053-0.0861763i
(jj3 <- quad.tdiag(M,y))
#> [1]  8.5907721-5.2801959i -2.3192342-3.0679220i -0.1614053-0.0861763i
tester(jj1,jj3)
tester(jj2,jj3)

Test of quad.3diag() = \(\operatorname{diag}(x^*My)\)

quad.3diag(M,l,r)=colSums(crossprod(M, Conj(left)) * right)

(jj1 <- diag(ht(x) %*% M %*% x1))
#> [1] -3.160440+2.336024i  3.988212+1.439608i  1.007834+5.964129i
(jj2 <- diag(quad.3form(M,x,x1)))
#> [1] -3.160440+2.336024i  3.988212+1.439608i  1.007834+5.964129i
(jj3 <- quad.3diag(M,x,x1))
#> [1] -3.160440+2.336024i  3.988212+1.439608i  1.007834+5.964129i
tester(jj1,jj3)
tester(jj2,jj3)

Test of quad.3tdiag() = \(\operatorname{diag}(xMy^*)\)

quad.3tdiag(M,l,r)=colSums(t(left) * tcprod(M, right))

(jj1 <- diag(y %*% M %*% ht(y1)))
#> [1] -2.120789+0.886568i -0.285578+1.364066i -0.617605-1.564315i
(jj2 <- diag(quad.3tform(M,y,y1)))
#> [1] -2.120789+0.886568i -0.285578+1.364066i -0.617605-1.564315i
(jj3 <- quad.3tdiag(M,y,y1))
#> [1] -2.120789+0.886568i -0.285578+1.364066i -0.617605-1.564315i
tester(jj1,jj3)
tester(jj2,jj3)