@@ -3,7 +3,7 @@ using LinearAlgebra
33using LinearAlgebra: givensAlgorithm
44
55# # EigenQ
6- struct EigenQ{T} <: AbstractMatrix{T}
6+ struct EigenQ{T}
77 uplo:: Char
88 factors:: Matrix{T}
99 τ:: Vector{T}
2323function LinearAlgebra. lmul! (Q:: EigenQ , B:: StridedVecOrMat )
2424 m, n = size (B)
2525 if size (Q, 1 ) != m
26- throw (DimensionMismatch (" " ))
26+ throw (DimensionMismatch (" first dimension of second argument matrix doesn't match the size of the first argument reflectors " ))
2727 end
2828 if Q. uplo == ' L'
29- @inbounds for k = length (Q. τ): - 1 : 1
30- for j = 1 : size (B, 2 )
31- vb = B[k+ 1 , j]
32- for i = (k+ 2 ): m
33- vb += Q. factors[i, k]' B[i, j]
34- end
35- τkvb = Q. τ[k]' vb
36- B[k+ 1 , j] -= τkvb
37- for i = (k+ 2 ): m
38- B[i, j] -= Q. factors[i, k] * τkvb
39- end
40- end
29+ for k = length (Q. τ): - 1 : 1
30+ h = view (Q. factors, (k + 1 ): m, k)
31+ τ = Q. τ[k]
32+ tmp = h[1 ]
33+ h[1 ] = 1
34+ B[(k + 1 ): m, :] .- = h* τ* h' * view (B, (k + 1 ): m, :)
35+ h[1 ] = tmp
4136 end
4237 elseif Q. uplo == ' U'
43- @inbounds for k = length (Q. τ): - 1 : 1
44- for j = 1 : size (B, 2 )
45- vb = B[k+ 1 , j]
46- for i = (k+ 2 ): m
47- vb += Q. factors[k, i] * B[i, j]
48- end
49- τkvb = Q. τ[k]' vb
50- B[k+ 1 , j] -= τkvb
51- for i = (k+ 2 ): m
52- B[i, j] -= Q. factors[k, i]' * τkvb
53- end
54- end
38+ for k = length (Q. τ): - 1 : 1
39+ h = view (Q. factors, 1 : (m - k), m - k + 1 )
40+ τ = Q. τ[k]
41+ tmp = h[end ]
42+ h[end ] = 1
43+ B[1 : (n - k), :] .- = h* τ* h' * view (B, 1 : (n - k), :)
44+ h[end ] = tmp
5545 end
5646 else
5747 throw (ArgumentError (" Q.uplo is neither 'L' or 'U'. This should never happen." ))
6252function LinearAlgebra. rmul! (A:: StridedMatrix , Q:: EigenQ )
6353 m, n = size (A)
6454 if size (Q, 1 ) != n
65- throw (DimensionMismatch (" " ))
55+ throw (DimensionMismatch (" second dimension of first argument matrix doesn't match the size of the second argument reflectors " ))
6656 end
6757 if Q. uplo == ' L'
6858 for k = 1 : length (Q. τ)
69- for i = 1 : size (A, 1 )
70- a = view (A, i, :)
71- va = A[i, k+ 1 ]
72- for j = (k+ 2 ): n
73- va += A[i, j] * Q. factors[j, k]
74- end
75- τkva = va * Q. τ[k]'
76- A[i, k+ 1 ] -= τkva
77- for j = (k+ 2 ): n
78- A[i, j] -= τkva * Q. factors[j, k]'
79- end
80- end
59+ h = view (Q. factors, (k + 1 ): n, k)
60+ τ = Q. τ[k]
61+ tmp = h[1 ]
62+ h[1 ] = 1
63+ A[:, (k + 1 ): n] .- = view (A, :, (k + 1 ): n)* h* τ* h'
64+ h[1 ] = tmp
8165 end
82- elseif Q. uplo == ' U' # FixMe! Should consider reordering loops
66+ elseif Q. uplo == ' U'
8367 for k = 1 : length (Q. τ)
84- for i = 1 : size (A, 1 )
85- a = view (A, i, :)
86- va = A[i, k+ 1 ]
87- for j = (k+ 2 ): n
88- va += A[i, j] * Q. factors[k, j]'
89- end
90- τkva = va * Q. τ[k]'
91- A[i, k+ 1 ] -= τkva
92- for j = (k+ 2 ): n
93- A[i, j] -= τkva * Q. factors[k, j]
94- end
95- end
68+ h = view (Q. factors, 1 : (n - k), n - k + 1 )
69+ τ = Q. τ[k]
70+ tmp = h[end ]
71+ h[end ] = 1
72+ A[:, 1 : (n - k)] .- = view (A, :, 1 : (n - k))* h* τ* h'
73+ h[end ] = tmp
9674 end
9775 else
9876 throw (ArgumentError (" Q.uplo is neither 'L' or 'U'. This should never happen." ))
9977 end
10078 return A
10179end
10280
103- Base. Array (Q:: EigenQ ) = lmul! (Q, Matrix {eltype(Q) } (I, size (Q, 1 ), size (Q, 1 )))
81+ Base. Array (Q:: EigenQ{T} ) where T = lmul! (Q, Matrix {T } (I, size (Q, 1 ), size (Q, 1 )))
10482
10583
10684# # SymmetricTridiagonalFactorization
@@ -463,49 +441,37 @@ function symtriLower!(
463441
464442 @inbounds for k = 1 : (n- 2 + ! (T <: Real ))
465443
466- τk = LinearAlgebra. reflector! (view (AS, (k+ 1 ): n, k))
444+ x = view (AS, (k + 1 ): n, k)
445+
446+ τk = LinearAlgebra. reflector! (x)
467447 τ[k] = τk
468448
469- for i = (k+ 1 ): n
470- u[i] = AS[i, k+ 1 ]
471- end
472- for j = (k+ 2 ): n
473- ASjk = AS[j, k]
474- for i = j: n
475- u[i] += AS[i, j] * ASjk
476- end
477- end
478- for j = (k+ 1 ): (n- 1 )
479- tmp = zero (T)
480- for i = j+ 1 : n
481- tmp += AS[i, j]' AS[i, k]
482- end
483- u[j] += tmp
484- end
449+ # Temporarily store the implicit 1
450+ tmp = x[1 ]
451+ x[1 ] = 1
485452
486- vcAv = u[k+ 1 ]
487- for i = (k+ 2 ): n
488- vcAv += AS[i, k]' u[i]
489- end
490- ξτ2 = real (vcAv) * abs2 (τk) / 2
453+ Ã = view (AS, (k + 1 ): n, (k + 1 ): n)
454+ ũ = view (u, (k + 1 ): n)
491455
492- u[k+ 1 ] = u[k+ 1 ] * τk - ξτ2
493- for i = (k+ 2 ): n
494- u[i] = u[i] * τk - ξτ2 * AS[i, k]
495- end
456+ # Form Ãvτ
457+ mul! (ũ, Hermitian (Ã, :L ), x, τk, zero (τk))
496458
497- AS[k+ 1 , k+ 1 ] -= 2 real (u[k+ 1 ])
498- for i = (k+ 2 ): n
499- AS[i, k+ 1 ] -= u[i] + AS[i, k] * u[k+ 1 ]'
500- end
501- for j = (k+ 2 ): n
502- ASjk = AS[j, k]
503- uj = u[j]
504- AS[j, j] -= 2 real (uj * ASjk' )
505- for i = (j+ 1 ): n
506- AS[i, j] -= u[i] * ASjk' + AS[i, k] * uj'
459+ # Form τx'Ãvτ (which is real except for rounding)
460+ ξ = real (τk' * (x' * ũ))
461+
462+ # Compute the rank up and down grade
463+ # Ã = Ã + τx'Ãvτ - τx'Ã - Ãvτ
464+ for j in 1 : (n - k)
465+ xⱼ = x[j]
466+ ũⱼ = ũ[j]
467+ ξxⱼ = ξ * xⱼ
468+ for i in j: (n - k)
469+ AS[k + i, k + j] += x[i] * ξxⱼ' - x[i] * ũⱼ' - ũ[i] * xⱼ'
507470 end
508471 end
472+
473+ # Restore element
474+ x[1 ] = tmp
509475 end
510476 SymmetricTridiagonalFactorization (
511477 EigenQ (
@@ -531,37 +497,41 @@ function symtriUpper!(
531497 end
532498
533499 @inbounds for k = 1 : (n- 2 + ! (T <: Real ))
534- # This is a bit convoluted method to get the conjugated vector but conjugation is required for correctness of arrays of quaternions. Eventually, it should be sufficient to write vec(x') but it currently (July 10, 2018) hits a bug in LinearAlgebra
535- τk = LinearAlgebra. reflector! (vec (transpose (view (AS, k, (k+ 1 ): n)' )))
536- τ[k] = τk'
537-
538- for j = (k+ 1 ): n
539- tmp = AS[k+ 1 , j]
540- for i = (k+ 2 ): j
541- tmp += AS[k, i] * AS[i, j]
542- end
543- for i = (j+ 1 ): n
544- tmp += AS[k, i] * AS[j, i]'
545- end
546- u[j] = τk' * tmp
547- end
500+ # LAPACK allows the reflection element to be chosen freely whereas
501+ # LinearAlgebra's reflector! assumes it is the first element in the vector
502+ # Maybe we should implement a method similar to the LAPACK version
503+ x = view (AS, 1 : (n - k), n - k + 1 )
504+ xᵣ = view (AS, (n - k): - 1 : 1 , n - k + 1 )
548505
549- vcAv = u[k+ 1 ]
550- for i = (k+ 2 ): n
551- vcAv += u[i] * AS[k, i]'
552- end
553- ξ = real (vcAv * τk)
554-
555- for j = (k+ 1 ): n
556- ujt = u[j]
557- hjt = j > (k + 1 ) ? AS[k, j] : one (ujt)
558- ξhjt = ξ * hjt
559- for i = (k+ 1 ): (j- 1 )
560- hit = i > (k + 1 ) ? AS[k, i] : one (ujt)
561- AS[i, j] -= hit' * ujt + u[i]' * hjt - hit' * ξhjt
506+ τk = LinearAlgebra. reflector! (xᵣ)
507+ τ[k] = τk
508+
509+ # Temporarily store the implicit 1
510+ tmp = x[end ]
511+ x[end ] = 1
512+
513+ Ã = view (AS, 1 : (n - k), 1 : (n - k))
514+ ũ = view (u, 1 : (n - k))
515+
516+ # Form Ãvτ
517+ mul! (ũ, Hermitian (Ã, :U ), x, τk, zero (τk))
518+
519+ # Form τx'Ãvτ (which is real except for rounding)
520+ ξ = real (τk' * (x' * ũ))
521+
522+ # Compute the rank up and down grade
523+ # Ã = Ã + τx'Ãvτ - τx'Ã - Ãvτ
524+ for j in 1 : (n - k)
525+ xⱼ = x[j]
526+ ũⱼ = ũ[j]
527+ ξxⱼ = ξ * xⱼ
528+ for i in 1 : j
529+ AS[i, j] += x[i] * ξxⱼ' - x[i] * ũⱼ' - ũ[i] * xⱼ'
562530 end
563- AS[j, j] -= 2 * real (hjt' * ujt) - abs2 (hjt) * ξ
564531 end
532+
533+ # Restore element
534+ x[end ] = tmp
565535 end
566536 SymmetricTridiagonalFactorization (
567537 EigenQ (
0 commit comments