44# 0 d e]
55#
66# 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 }
88 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 ))]
1010 λ, V = eigen (C)
1111 n2, j = branch (abs2 .(λ))
1212 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." ))
1313 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])
1616end
1717
18- function tail_de (a:: AbstractVector{T} ; branch= findmax) where T
18+ function tail_de (a:: AbstractVector{T} ; branch= findmax) where {T}
1919 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 ))]
2121 λ, V = eigen (C):: Eigen{float(T),float(T),Matrix{float(T)},Vector{float(T)}}
2222 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]
2727end
2828
2929
3030# this calculates the QL decomposition of X and corrects sign
3131function ql_X! (X)
32- s = sign (real (X[2 ,end ]))
32+ s = sign (real (X[2 , end ]))
3333 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
3535 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
3737 end
3838 F
3939end
4040
4141
4242
4343
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
4747 X = [Z A B; zero (T) d e]
4848 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, ∞)))
5151end
5252
53- ql (Op:: TriToeplitz{T} ) where T = ql (InfToeplitz (Op))
53+ ql (Op:: TriToeplitz{T} ) where {T} = ql (InfToeplitz (Op))
5454
5555# 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)
5858 @assert u == 1
5959 a = reverse (A. data. args[1 ])
6060 de = tail_de (a; kwds... )
6161 X = [transpose (a); zero (T) transpose (de)]:: Matrix{float(T)}
6262 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, ∞))
6565end
6666
6767
6868# remove one band of A
6969function 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 )
7676 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)
7878 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)
8181 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
8484end
8585
8686# represent Q as a product of orthogonal operations
87- struct ProductQ{T,QQ<: Tuple } <: AbstractQ {T}
87+ struct ProductQ{T,QQ<: Tuple } <: LayoutQ {T}
8888 Qs:: QQ
8989end
9090
9191ArrayLayouts. @layoutmatrix ProductQ
9292ArrayLayouts. @_layoutlmul ProductQ
9393
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)
9595
96- adjoint (Q:: ProductQ ) = ProductQ (reverse (map (adjoint,Q. Qs))... )
96+ adjoint (Q:: ProductQ ) = ProductQ (reverse (map (adjoint, Q. Qs))... )
9797
9898size (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)
99100
100101function lmul! (Q:: ProductQ , v:: AbstractVecOrMat )
101102 for j = length (Q. Qs): - 1 : 1
@@ -104,12 +105,19 @@ function lmul!(Q::ProductQ, v::AbstractVecOrMat)
104105 v
105106end
106107
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]
108110
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]'
109117
110118function _productq_mul (A:: ProductQ{T} , x:: AbstractVector{S} ) where {T,S}
111119 TS = promote_op (matprod, T, S)
112- lmul! (A, Base. copymutable (convert (AbstractVector{TS},x)))
120+ lmul! (A, Base. copymutable (convert (AbstractVector{TS}, x)))
113121end
114122
115123mul (A:: ProductQ , x:: AbstractVector ) = _productq_mul (A, x)
123131
124132
125133
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)
127135QLProduct (F:: QLHessenberg ) = QLProduct (tuple (F. Q), F. L)
128136
129137# iteration for destructuring into components
@@ -140,7 +148,8 @@ Matrix(F::QLProduct) = Array(AbstractArray(F))
140148Array (F:: QLProduct ) = Matrix (F)
141149
142150function show (io:: IO , mime:: MIME{Symbol("text/plain")} , F:: QLProduct )
143- summary (io, F); println (io)
151+ summary (io, F)
152+ println (io)
144153 println (io, " Q factor:" )
145154 show (io, mime, F. Q)
146155 println (io, " \n L factor:" )
@@ -163,11 +172,11 @@ end
163172Base. propertynames (F:: QLProduct , private:: Bool = false ) =
164173 (:L , :Q , (private ? fieldnames (typeof (F)) : ()). .. )
165174
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)
168177 u ≤ 0 && return QLProduct (tuple (Eye {float(T)} (∞)), A)
169178 u == 1 && return QLProduct (ql_hessenberg (A; kwds... ))
170- Q1,H1 = ql_pruneband (A; kwds... )
179+ Q1, H1 = ql_pruneband (A; kwds... )
171180 F̃ = ql (H1; kwds... )
172181 QLProduct (tuple (Q1, F̃. Qs... ), F̃. L)
173182end
0 commit comments