4
4
# 0 d e]
5
5
#
6
6
# is the fixed point
7
- function tail_de (a:: AbstractVector{T} ; branch= findmax) where T<: Real
7
+ function tail_de (a:: AbstractVector{T} ; branch= findmax) where { T<: Real }
8
8
m = length (a)
9
- C = [view (a,m- 1 : - 1 : 1 ) Vcat (- a[end ]* Eye (m- 2 ), Zeros {T} (1 ,m - 2 ))]
9
+ C = [view (a, m- 1 : - 1 : 1 ) Vcat (- a[end ] * Eye (m - 2 ), Zeros {T} (1 , m - 2 ))]
10
10
λ, V = eigen (C)
11
11
n2, j = branch (abs2 .(λ))
12
12
isreal (λ[j]) || throw (DomainError (a, " Real-valued QL factorization does not exist. Try ql(complex(A)) to see if a complex-valued QL factorization exists." ))
13
13
n2 ≥ a[end ]^ 2 || throw (DomainError (a, " QL factorization does not exist. This could indicate that the operator is not Fredholm or that the dimension of the kernel exceeds that of the co-kernel. Try again with the adjoint." ))
14
- c = sqrt ((n2 - a[end ]^ 2 )/ real (V[1 ,j])^ 2 )
15
- c* real (V[end : - 1 : 1 ,j])
14
+ c = sqrt ((n2 - a[end ]^ 2 ) / real (V[1 , j])^ 2 )
15
+ c * real (V[end : - 1 : 1 , j])
16
16
end
17
17
18
- function tail_de (a:: AbstractVector{T} ; branch= findmax) where T
18
+ function tail_de (a:: AbstractVector{T} ; branch= findmax) where {T}
19
19
m = length (a)
20
- C = [view (a,m- 1 : - 1 : 1 ) Vcat (- a[end ]* Eye (m- 2 ), Zeros {T} (1 ,m - 2 ))]
20
+ C = [view (a, m- 1 : - 1 : 1 ) Vcat (- a[end ] * Eye (m - 2 ), Zeros {T} (1 , m - 2 ))]
21
21
λ, V = eigen (C):: Eigen{float(T),float(T),Matrix{float(T)},Vector{float(T)}}
22
22
n2, j = branch (abs2 .(λ))
23
- n2 ≥ abs2 (a[end ]) || throw (DomainError (a, " QL factorization does not exist. This could indicate that the operator is not Fredholm or that the dimension of the kernel exceeds that of the co-kernel. Try again with the adjoint." ))
24
- c_abs = sqrt ((n2 - abs2 (a[end ]))/ abs2 (V[1 ,j]))
25
- c_sgn = - sign (λ[j])/ sign (V[1 ,j] * a[end - 1 ] - V[2 ,j] * a[end ])
26
- c_sgn* c_abs* V[end : - 1 : 1 ,j]
23
+ n2 ≥ abs2 (a[end ]) || throw (DomainError (a, " QL factorization does not exist. This could indicate that the operator is not Fredholm or that the dimension of the kernel exceeds that of the co-kernel. Try again with the adjoint." ))
24
+ c_abs = sqrt ((n2 - abs2 (a[end ])) / abs2 (V[1 , j]))
25
+ c_sgn = - sign (λ[j]) / sign (V[1 , j] * a[end - 1 ] - V[2 , j] * a[end ])
26
+ c_sgn * c_abs * V[end : - 1 : 1 , j]
27
27
end
28
28
29
29
30
30
# this calculates the QL decomposition of X and corrects sign
31
31
function ql_X! (X)
32
- s = sign (real (X[2 ,end ]))
32
+ s = sign (real (X[2 , end ]))
33
33
F = ql! (X)
34
- if s ≠ sign (real (X[1 ,end - 1 ])) # we need to normalise the sign if ql! flips it
34
+ if s ≠ sign (real (X[1 , end - 1 ])) # we need to normalise the sign if ql! flips it
35
35
F. τ[1 ] = 2 - F. τ[1 ] # 1-F.τ[1] is the sign so this flips it
36
- X[1 ,1 : end - 1 ] *= - 1
36
+ X[1 , 1 : end - 1 ] *= - 1
37
37
end
38
38
F
39
39
end
40
40
41
41
42
42
43
43
44
- function ql (Op:: TriToeplitz{T} ; kwds... ) where T<: Real
45
- Z,A, B = Op. dl. value, Op. d. value, Op. du. value
46
- d,e = tail_de ([Z,A, B]; kwds... ) # fixed point of QL but with two Qs, one that changes sign
44
+ function ql (Op:: TriToeplitz{T} ; kwds... ) where { T<: Real }
45
+ Z, A, B = Op. dl. value, Op. d. value, Op. du. value
46
+ d, e = tail_de ([Z, A, B]; kwds... ) # fixed point of QL but with two Qs, one that changes sign
47
47
X = [Z A B; zero (T) d e]
48
48
F = ql_X! (X)
49
- t,ω = F. τ[2 ],X[1 ,end ]
50
- QL (_BandedMatrix (Hcat ([zero (T), e, X[2 ,2 ], X[2 ,1 ]], [ω, X[2 ,3 ], X[2 ,2 ], X[2 ,1 ]] * Ones {T} (1 ,∞)), ℵ₀, 2 , 1 ), Vcat (F. τ[1 ],Fill (t,∞)))
49
+ t, ω = F. τ[2 ], X[1 , end ]
50
+ QL (_BandedMatrix (Hcat ([zero (T), e, X[2 , 2 ], X[2 , 1 ]], [ω, X[2 , 3 ], X[2 , 2 ], X[2 , 1 ]] * Ones {T} (1 , ∞)), ℵ₀, 2 , 1 ), Vcat (F. τ[1 ], Fill (t, ∞)))
51
51
end
52
52
53
- ql (Op:: TriToeplitz{T} ) where T = ql (InfToeplitz (Op))
53
+ ql (Op:: TriToeplitz{T} ) where {T} = ql (InfToeplitz (Op))
54
54
55
55
# ql for Lower hessenberg InfToeplitz
56
- function ql_hessenberg (A:: InfToeplitz{T} ; kwds... ) where T
57
- l,u = bandwidths (A)
56
+ function ql_hessenberg (A:: InfToeplitz{T} ; kwds... ) where {T}
57
+ l, u = bandwidths (A)
58
58
@assert u == 1
59
59
a = reverse (A. data. args[1 ])
60
60
de = tail_de (a; kwds... )
61
61
X = [transpose (a); zero (T) transpose (de)]:: Matrix{float(T)}
62
62
F = ql_X! (X) # calculate data for fixed point
63
- factors = _BandedMatrix (Hcat ([zero (T); X[1 ,end - 1 ]; X[2 ,end - 1 : - 1 : 1 ]], [0 ; X[2 ,end : - 1 : 1 ]] * Ones {float(T)} (1 ,∞)), ℵ₀, l+ u, 1 )
64
- QLHessenberg (factors, Fill (F. Q,∞))
63
+ factors = _BandedMatrix (Hcat ([zero (T); X[1 , end - 1 ]; X[2 , end - 1 : - 1 : 1 ]], [0 ; X[2 , end : - 1 : 1 ]] * Ones {float(T)} (1 , ∞)), ℵ₀, l + u, 1 )
64
+ QLHessenberg (factors, Fill (F. Q, ∞))
65
65
end
66
66
67
67
68
68
# remove one band of A
69
69
function ql_pruneband (A; kwds... )
70
- l,u = bandwidths (A)
71
- A_hess = A[:,u: end ]
72
- Q,L = ql_hessenberg (A_hess; kwds... )
73
- p = size (_pertdata (bandeddata (parent (L))),2 ) + u + 1 # pert size
74
- dat = (UpperHessenbergQ ((Q' ). q[1 : (p+ l)])) * A[1 : p+ l+ 1 ,1 : p]
75
- pert = Array {eltype(dat)} (undef, l+ u + 1 , size (dat,2 ) - 1 )
70
+ l, u = bandwidths (A)
71
+ A_hess = A[:, u: end ]
72
+ Q, L = ql_hessenberg (A_hess; kwds... )
73
+ p = size (_pertdata (bandeddata (parent (L))), 2 ) + u + 1 # pert size
74
+ dat = (UpperHessenbergQ ((Q' ). q[1 : (p+ l)])) * A[1 : p+ l+ 1 , 1 : p]
75
+ pert = Array {eltype(dat)} (undef, l + u + 1 , size (dat, 2 ) - 1 )
76
76
for j = 1 : u
77
- pert[u- j+ 1 : end ,j] .= view (dat,1 : l+ j+ 1 ,j)
77
+ pert[u- j+ 1 : end , j] .= view (dat, 1 : l+ j+ 1 , j)
78
78
end
79
- for j = u+ 1 : size (pert,2 )
80
- pert[:,j] .= view (dat,j- u+ 1 : j+ l+ 1 ,j)
79
+ for j = u+ 1 : size (pert, 2 )
80
+ pert[:, j] .= view (dat, j- u+ 1 : j+ l+ 1 , j)
81
81
end
82
- H = _BandedMatrix (Hcat (pert, dat[end - l- u: end ,end ]* Ones {eltype(dat)} (1 ,∞)), ℵ₀, l+ 1 ,u - 1 )
83
- Q,H
82
+ H = _BandedMatrix (Hcat (pert, dat[end - l- u: end , end ] * Ones {eltype(dat)} (1 , ∞)), ℵ₀, l + 1 , u - 1 )
83
+ Q, H
84
84
end
85
85
86
86
# represent Q as a product of orthogonal operations
87
- struct ProductQ{T,QQ<: Tuple } <: AbstractQ {T}
87
+ struct ProductQ{T,QQ<: Tuple } <: LayoutQ {T}
88
88
Qs:: QQ
89
89
end
90
90
91
91
ArrayLayouts. @layoutmatrix ProductQ
92
92
ArrayLayouts. @_layoutlmul ProductQ
93
93
94
- ProductQ (Qs:: AbstractMatrix... ) = ProductQ {mapreduce(eltype,promote_type,Qs),typeof(Qs)} (Qs)
94
+ ProductQ (Qs:: AbstractMatrix... ) = ProductQ {mapreduce(eltype, promote_type, Qs),typeof(Qs)} (Qs)
95
95
96
- adjoint (Q:: ProductQ ) = ProductQ (reverse (map (adjoint,Q. Qs))... )
96
+ adjoint (Q:: ProductQ ) = ProductQ (reverse (map (adjoint, Q. Qs))... )
97
97
98
98
size (Q:: ProductQ , dim:: Integer ) = size (dim == 1 ? Q. Qs[1 ] : last (Q. Qs), dim == 2 ? 1 : dim)
99
+ axes (Q:: ProductQ , dim:: Integer ) = axes (dim == 1 ? Q. Qs[1 ] : last (Q. Qs), dim == 2 ? 1 : dim)
99
100
100
101
function lmul! (Q:: ProductQ , v:: AbstractVecOrMat )
101
102
for j = length (Q. Qs): - 1 : 1
@@ -104,12 +105,19 @@ function lmul!(Q::ProductQ, v::AbstractVecOrMat)
104
105
v
105
106
end
106
107
107
- getindex (Q:: ProductQ{<:Any,<:Tuple{Vararg{LowerHessenbergQ}}} , i:: Integer , j:: Integer ) = (Q' )[j,i]'
108
+ # Avoid ambiguities
109
+ getindex (Q:: ProductQ , i:: Int , j:: Int ) = Q[:, j][i]
108
110
111
+ function getindex (Q:: ProductQ , :: Colon , j:: Int )
112
+ y = zeros (eltype (Q), size (Q, 2 ))
113
+ y[j] = 1
114
+ lmul! (Q, y)
115
+ end
116
+ getindex (Q:: ProductQ{<:Any,<:Tuple{Vararg{LowerHessenbergQ}}} , i:: Int , j:: Int ) = (Q' )[j, i]'
109
117
110
118
function _productq_mul (A:: ProductQ{T} , x:: AbstractVector{S} ) where {T,S}
111
119
TS = promote_op (matprod, T, S)
112
- lmul! (A, Base. copymutable (convert (AbstractVector{TS},x)))
120
+ lmul! (A, Base. copymutable (convert (AbstractVector{TS}, x)))
113
121
end
114
122
115
123
mul (A:: ProductQ , x:: AbstractVector ) = _productq_mul (A, x)
123
131
124
132
125
133
126
- QLProduct (Qs:: Tuple , L:: AbstractMatrix{T} ) where T = QLProduct {T,typeof(Qs),typeof(L)} (Qs, L)
134
+ QLProduct (Qs:: Tuple , L:: AbstractMatrix{T} ) where {T} = QLProduct {T,typeof(Qs),typeof(L)} (Qs, L)
127
135
QLProduct (F:: QLHessenberg ) = QLProduct (tuple (F. Q), F. L)
128
136
129
137
# iteration for destructuring into components
@@ -140,7 +148,8 @@ Matrix(F::QLProduct) = Array(AbstractArray(F))
140
148
Array (F:: QLProduct ) = Matrix (F)
141
149
142
150
function show (io:: IO , mime:: MIME{Symbol("text/plain")} , F:: QLProduct )
143
- summary (io, F); println (io)
151
+ summary (io, F)
152
+ println (io)
144
153
println (io, " Q factor:" )
145
154
show (io, mime, F. Q)
146
155
println (io, " \n L factor:" )
@@ -163,11 +172,11 @@ end
163
172
Base. propertynames (F:: QLProduct , private:: Bool = false ) =
164
173
(:L , :Q , (private ? fieldnames (typeof (F)) : ()). .. )
165
174
166
- function _inf_ql (A:: AbstractMatrix{T} ; kwds... ) where T
167
- _,u = bandwidths (A)
175
+ function _inf_ql (A:: AbstractMatrix{T} ; kwds... ) where {T}
176
+ _, u = bandwidths (A)
168
177
u ≤ 0 && return QLProduct (tuple (Eye {float(T)} (∞)), A)
169
178
u == 1 && return QLProduct (ql_hessenberg (A; kwds... ))
170
- Q1,H1 = ql_pruneband (A; kwds... )
179
+ Q1, H1 = ql_pruneband (A; kwds... )
171
180
F̃ = ql (H1; kwds... )
172
181
QLProduct (tuple (Q1, F̃. Qs... ), F̃. L)
173
182
end
0 commit comments